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