1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE OverloadedStrings #-} 3 4module Stack.Ghci.Script 5 ( GhciScript 6 , ModuleName 7 8 , cmdAdd 9 , cmdCdGhc 10 , cmdModule 11 12 , scriptToLazyByteString 13 , scriptToBuilder 14 , scriptToFile 15 ) where 16 17import Data.ByteString.Builder (toLazyByteString) 18import Data.List 19import qualified Data.Set as S 20import Path 21import Stack.Prelude 22import System.IO (hSetBinaryMode) 23 24import Distribution.ModuleName hiding (toFilePath) 25 26newtype GhciScript = GhciScript { unGhciScript :: [GhciCommand] } 27 28instance Semigroup GhciScript where 29 GhciScript xs <> GhciScript ys = GhciScript (ys <> xs) 30instance Monoid GhciScript where 31 mempty = GhciScript [] 32 mappend = (<>) 33 34data GhciCommand 35 = Add (Set (Either ModuleName (Path Abs File))) 36 | CdGhc (Path Abs Dir) 37 | Module (Set ModuleName) 38 deriving (Show) 39 40cmdAdd :: Set (Either ModuleName (Path Abs File)) -> GhciScript 41cmdAdd = GhciScript . (:[]) . Add 42 43cmdCdGhc :: Path Abs Dir -> GhciScript 44cmdCdGhc = GhciScript . (:[]) . CdGhc 45 46cmdModule :: Set ModuleName -> GhciScript 47cmdModule = GhciScript . (:[]) . Module 48 49scriptToLazyByteString :: GhciScript -> LByteString 50scriptToLazyByteString = toLazyByteString . scriptToBuilder 51 52scriptToBuilder :: GhciScript -> Builder 53scriptToBuilder backwardScript = mconcat $ fmap commandToBuilder script 54 where 55 script = reverse $ unGhciScript backwardScript 56 57scriptToFile :: Path Abs File -> GhciScript -> IO () 58scriptToFile path script = 59 withFile filepath WriteMode 60 $ \hdl -> do hSetBuffering hdl (BlockBuffering Nothing) 61 hSetBinaryMode hdl True 62 hPutBuilder hdl (scriptToBuilder script) 63 where 64 filepath = toFilePath path 65 66-- Command conversion 67 68commandToBuilder :: GhciCommand -> Builder 69 70commandToBuilder (Add modules) 71 | S.null modules = mempty 72 | otherwise = 73 ":add " 74 <> mconcat (intersperse " " $ 75 fmap (fromString . quoteFileName . either (mconcat . intersperse "." . components) toFilePath) 76 (S.toAscList modules)) 77 <> "\n" 78 79commandToBuilder (CdGhc path) = 80 ":cd-ghc " <> fromString (quoteFileName (toFilePath path)) <> "\n" 81 82commandToBuilder (Module modules) 83 | S.null modules = ":module +\n" 84 | otherwise = 85 ":module + " 86 <> mconcat (intersperse " " 87 $ fromString . quoteFileName . mconcat . intersperse "." . components <$> S.toAscList modules) 88 <> "\n" 89 90-- | Make sure that a filename with spaces in it gets the proper quotes. 91quoteFileName :: String -> String 92quoteFileName x = if ' ' `elem` x then show x else x 93