@@ -9,6 +9,7 @@
99-- Portability :
1010--
1111-- |
12+-- PureScript Compiler Interactive.
1213--
1314-----------------------------------------------------------------------------
1415
@@ -16,31 +17,143 @@
1617
1718module Main where
1819
20+import Commands
21+
1922import Control.Applicative
2023import Control.Monad
2124import Control.Monad.Trans.Class
2225import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26+import Control.Monad.Trans.State
2327
24−import Data.List (nub, isPrefixOf)
28+import Data.List (intercalate, isPrefixOf, nub, sort)
2529import Data.Maybe (mapMaybe)
2630import Data.Traversable (traverse)
2731
2832import System.Console.Haskeline
2933import System.Directory (findExecutable)
3034import System.Exit
35+import System.Environment.XDG.BaseDir
3136import System.Process
3237
3338import qualified Language.PureScript as P
3439import qualified Paths_purescript as Paths
3540import qualified System.IO.UTF8 as U (readFile)
36−import qualified Text.Parsec as Parsec (eof)
41+import qualified Text.Parsec as Parsec (Parsec, eof)
42+
43+-- |
44+-- The PSCI state.
45+-- Holds a list of imported modules, loaded files, and partial let bindings.
46+-- The let bindings are partial,
47+-- because it makes more sense to apply the binding to the final evaluated expression.
48+--
49+data PSCI = PSCI [P.ProperName] [P.Module] [P.Value -> P.Value]
50+
51+-- State helpers
52+
53+-- |
54+-- Synonym to be more descriptive.
55+-- This is just @lift@
56+--
57+inputTToState :: InputT IO a -> StateT PSCI (InputT IO) a
58+inputTToState = lift
59+
60+-- |
61+-- Synonym to be more descriptive.
62+-- This is just @lift . lift@
63+--
64+ioToState :: IO a -> StateT PSCI (InputT IO) a
65+ioToState = lift . lift
66+
67+-- |
68+-- Updates the state to have more imported modules.
69+--
70+updateImports :: String -> PSCI -> PSCI
71+updateImports name (PSCI i m b) = PSCI (i ++ [P.ProperName name]) m b
72+
73+-- |
74+-- Updates the state to have more loaded files.
75+--
76+updateModules :: [P.Module] -> PSCI -> PSCI
77+updateModules modules (PSCI i m b) = PSCI i (m ++ modules) b
78+
79+-- |
80+-- Updates the state to have more let bindings.
81+--
82+updateLets :: (P.Value -> P.Value) -> PSCI -> PSCI
83+updateLets name (PSCI i m b) = PSCI i m (b ++ [name])
84+
85+-- File helpers
86+-- |
87+-- Load the necessary modules.
88+--
89+defaultImports :: [P.ProperName]
90+defaultImports = [P.ProperName "Prelude"]
91+
92+-- |
93+-- Locates the node executable.
94+-- Checks for either @nodejs@ or @node@.
95+--
96+findNodeProcess :: IO (Maybe String)
97+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
98+ where names = ["nodejs", "node"]
99+
100+-- |
101+-- Grabs the filename where the history is stored.
102+--
103+getHistoryFilename :: IO FilePath
104+getHistoryFilename = getUserConfigFile "purescript" "psci_history"
37105
106+-- |
107+-- Grabs the filename where prelude is.
108+--
38109getPreludeFilename :: IO FilePath
39110getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
40111
41−options :: P.Options
42−options = P.Options True False True (Just "Main") True "PS" []
112+-- |
113+-- Loads a file for use with imports.
114+--
115+loadModule :: FilePath -> IO (Either String [P.Module])
116+loadModule moduleFile = do
117+ moduleText <- U.readFile moduleFile
118+ return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
43119
120+-- Messages
121+
122+-- |
123+-- The help message.
124+--
125+helpMessage :: String
126+helpMessage = "The following commands are available:\n\n " ++
127+ intercalate "\n " (map (intercalate " ") help)
128+
129+-- |
130+-- The welcome prologue.
131+--
132+prologueMessage :: String
133+prologueMessage = intercalate "\n"
134+ [ " ____ ____ _ _ "
135+ , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
136+ , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
137+ , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
138+ , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
139+ , " |_| "
140+ , ""
141+ , ":? shows help"
142+ , ""
143+ , "Expressions are terminated using Ctrl+D"
144+ ]
145+
146+-- |
147+-- The quit message.
148+--
149+quitMessage :: String
150+quitMessage = "See ya!"
151+
152+-- Haskeline completions
153+
154+-- |
155+-- Loads module, function, and file completions.
156+--
44157completion :: [P.Module] -> CompletionFunc IO
45158completion ms = completeWord Nothing " \t\n\r" findCompletions
46159 where
@@ -53,29 +166,40 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
53166 , qual <- [ P.Qualified Nothing ident
54167 , P.Qualified (Just moduleName) ident]
55168 ]
56− let matches = filter (isPrefixOf str) names
169+ let matches = sort $ filter (isPrefixOf str) names
57170 return $ map simpleCompletion matches ++ files
58171 getDeclName :: P.Declaration -> Maybe P.Ident
59172 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
60173 getDeclName _ = Nothing
61174
62−createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
63−createTemporaryModule imports value =
175+-- Compilation
176+
177+-- | Compilation options.
178+--
179+options :: P.Options
180+options = P.Options True False True (Just "Main") True "PS" []
181+
182+-- |
183+-- Makes a volatile module to execute the current expression.
184+--
185+createTemporaryModule :: [P.ProperName] -> [P.Value -> P.Value] -> P.Value -> P.Module
186+createTemporaryModule imports lets value =
64187 let
65188 moduleName = P.ModuleName [P.ProperName "Main"]
66189 importDecl m = P.ImportDeclaration m Nothing
67190 traceModule = P.ModuleName [P.ProperName "Trace"]
68191 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
69− mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
70− (P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
71− , P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
72− ])
192+ value' = foldr ($) value lets
193+ mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing (P.App trace value')
73194 in
74195 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
75196
76−handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
77−handleDeclaration loadedModules imports value = do
78− let m = createTemporaryModule imports value
197+-- |
198+-- Takes a value declaration and evaluates it with the current state.
199+--
200+handleDeclaration :: P.Value -> PSCI -> InputT IO ()
201+handleDeclaration value (PSCI imports loadedModules lets) = do
202+ let m = createTemporaryModule imports lets value
79203 case P.compile options (loadedModules ++ [m]) of
80204 Left err -> outputStrLn err
81205 Right (js, _, _) -> do
@@ -86,73 +210,65 @@ handleDeclaration loadedModules imports value = do
86210 Just (ExitFailure _, _, err) -> outputStrLn err
87211 Nothing -> outputStrLn "Couldn't find node.js"
88212
89−data Command
90− = Empty
91− | Expression [String]
92− | Import String
93− | LoadModule FilePath
94− | Reload deriving (Show, Eq)
95−
96−getCommand :: InputT IO Command
97−getCommand = do
98− firstLine <- getInputLine "> "
99− case firstLine of
100− Nothing -> return Empty
101− Just (':':'i':' ':moduleName) -> return $ Import moduleName
102− Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
103− Just ":r" -> return Reload
104− Just (':':_) -> outputStrLn "Unknown command" >> getCommand
105− Just other -> Expression <$> go [other]
106− where
107− go ls = do
108− l <- getInputLine " "
109− case l of
110− Nothing -> return $ reverse ls
111− Just l' -> go (l' : ls)
213+-- Parser helpers
112214
113−loadModule :: FilePath -> IO (Either String [P.Module])
114−loadModule moduleFile = do
115− print moduleFile
116− moduleText <- U.readFile moduleFile
117− return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
215+-- |
216+-- Parser for our PSCI version of @let@.
217+-- This is essentially let from do-notation.
218+-- However, since we don't support the @Eff@ monad, we actually want the normal @let@.
219+--
220+parseLet :: Parsec.Parsec String P.ParseState (P.Value -> P.Value)
221+parseLet = P.Let <$> (P.reserved "let" *> P.indented *> P.parseBinder)
222+ <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
118223
119−findNodeProcess :: IO (Maybe String)
120−findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
121− where names = ["nodejs", "node"]
224+-- |
225+-- Parser for any other valid expression.
226+--
227+parseExpression :: Parsec.Parsec String P.ParseState P.Value
228+parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof
229+
230+-- Commands
231+
232+-- |
233+-- Performs an action for each meta-command given, and also for expressions..
234+--
235+handleCommand :: Command -> StateT PSCI (InputT IO) ()
236+handleCommand Empty = return ()
237+handleCommand (Expression ls) =
238+ case P.runIndentParser "" parseLet (unlines ls) of
239+ Left _ ->
240+ case P.runIndentParser "" parseExpression (unlines ls) of
241+ Left err -> inputTToState $ outputStrLn (show err)
242+ Right decl -> get >>= inputTToState . handleDeclaration decl
243+ Right l -> modify (updateLets l)
244+handleCommand Help = inputTToState $ outputStrLn helpMessage
245+handleCommand (Import moduleName) = modify (updateImports moduleName)
246+handleCommand (LoadFile filePath) = do
247+ mf <- ioToState $ loadModule filePath
248+ case mf of
249+ Left err -> inputTToState $ outputStrLn err
250+ Right mf' -> modify (updateModules mf')
251+handleCommand Reload = do
252+ (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule
253+ put (PSCI defaultImports prelude [])
254+handleCommand Unknown = inputTToState $ outputStrLn "Unknown command"
122255
256+-- |
257+-- The PSCI main loop.
258+--
123259main :: IO ()
124260main = do
125261 preludeFilename <- getPreludeFilename
126262 (Right prelude) <- loadModule preludeFilename
127− runInputT (setComplete (completion prelude) defaultSettings) $ do
128− outputStrLn " ____ ____ _ _ "
129− outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
130− outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
131− outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
132− outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
133− outputStrLn " |_| "
134− outputStrLn ""
135− outputStrLn "Expressions are terminated using Ctrl+D"
136− go [P.ProperName "Prelude", P.ProperName "Eff"] prelude
263+ historyFilename <- getHistoryFilename
264+ let settings = defaultSettings {historyFile = Just historyFilename}
265+ runInputT (setComplete (completion prelude) settings) $ do
266+ outputStrLn prologueMessage
267+ evalStateT go (PSCI defaultImports prelude [])
137268 where
138− go imports loadedModules = do
139− cmd <- getCommand
140− case cmd of
141− Empty -> go imports loadedModules
142− Expression ls -> do
143− case P.runIndentParser "" (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
144− Left err -> outputStrLn (show err)
145− Right decl -> handleDeclaration loadedModules imports decl
146− go imports loadedModules
147− Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules
148− LoadModule moduleFile -> do
149− ms <- lift $ loadModule moduleFile
150− case ms of
151− Left err -> outputStrLn err
152− Right ms' -> go imports (loadedModules ++ ms')
153− Reload -> do
154− preludeFilename <- lift getPreludeFilename
155− (Right prelude) <- lift $ loadModule preludeFilename
156− go [P.ProperName "Prelude"] prelude
157−
158−
269+ go :: StateT PSCI (InputT IO) ()
270+ go = do
271+ c <- inputTToState getCommand
272+ case c of
273+ Quit -> inputTToState $ outputStrLn quitMessage
274+ _ -> handleCommand c >> go