@@ -22,6 +22,7 @@ import Control.Applicative
2222import Control.Monad
2323import Control.Monad.Trans.Class
2424import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25+import Control.Monad.Trans.State
2526
2627import Data.List (intercalate, isPrefixOf, nub, sort)
2728import Data.Maybe (mapMaybe)
@@ -38,6 +39,25 @@ import qualified Paths_purescript as Paths
3839import qualified System.IO.UTF8 as U (readFile)
3940import qualified Text.Parsec as Parsec (Parsec, eof)
4041
42+data PSCI = PSCI [P.ProperName] [P.Module] [P.DoNotationElement]
43+
44+-- State helpers
45+inputTToState :: InputT IO a -> StateT PSCI (InputT IO) a
46+inputTToState = lift
47+
48+ioToState :: IO a -> StateT PSCI (InputT IO) a
49+ioToState = lift . lift
50+
51+updateImports :: String -> PSCI -> PSCI
52+updateImports name (PSCI i m b) = PSCI (i ++ [P.ProperName name]) m b
53+
54+updateModules :: [P.Module] -> PSCI -> PSCI
55+updateModules modules (PSCI i m b) = PSCI i (m ++ modules) b
56+
57+updateBinders :: P.DoNotationElement -> PSCI -> PSCI
58+updateBinders name (PSCI i m b) = PSCI i m (b ++ [name])
59+
60+-- File helpers
4161getHistoryFilename :: IO FilePath
4262getHistoryFilename = getUserConfigFile "purescript" "psci_history"
4363
@@ -51,6 +71,33 @@ findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
5171defaultImports :: [P.ProperName]
5272defaultImports = [P.ProperName "Prelude", P.ProperName "Eff"]
5373
74+loadModule :: FilePath -> IO (Either String [P.Module])
75+loadModule moduleFile = do
76+ moduleText <- U.readFile moduleFile
77+ return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
78+
79+-- Messages
80+helpMessage :: String
81+helpMessage = "The following commands are available:\n\n " ++
82+ intercalate "\n " (map (intercalate " ") help)
83+
84+prologueMessage :: String
85+prologueMessage = intercalate "\n"
86+ [ " ____ ____ _ _ "
87+ , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
88+ , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
89+ , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
90+ , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
91+ , " |_| "
92+ , ""
93+ , ":? shows help"
94+ , ""
95+ , "Expressions are terminated using Ctrl+D"
96+ ]
97+
98+quitMessage :: String
99+quitMessage = "See ya!"
100+
54101options :: P.Options
55102options = P.Options True False True (Just "Main") True "PS" []
56103
@@ -87,8 +134,8 @@ createTemporaryModule imports binders value =
87134 in
88135 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
89136
90−handleDeclaration :: [P.Module] -> [P.ProperName] -> [P.DoNotationElement] -> P.Value -> InputT IO ()
91−handleDeclaration loadedModules imports binders value = do
137+handleDeclaration :: P.Value -> PSCI -> InputT IO ()
138+handleDeclaration value (PSCI imports loadedModules binders) = do
92139 let m = createTemporaryModule imports binders value
93140 case P.compile options (loadedModules ++ [m]) of
94141 Left err -> outputStrLn err
@@ -100,12 +147,6 @@ handleDeclaration loadedModules imports binders value = do
100147 Just (ExitFailure _, _, err) -> outputStrLn err
101148 Nothing -> outputStrLn "Couldn't find node.js"
102149
103−loadModule :: FilePath -> IO (Either String [P.Module])
104−loadModule moduleFile = do
105− print moduleFile
106− moduleText <- U.readFile moduleFile
107− return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
108−
109150parseDoNotationLet :: Parsec.Parsec String P.ParseState P.DoNotationElement
110151parseDoNotationLet = P.DoNotationLet <$> (P.reserved "let" *> P.indented *> P.parseBinder)
111152 <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
@@ -116,9 +157,30 @@ parseDoNotationBind = P.DoNotationBind <$> P.parseBinder <*> (P.indented *> P.re
116157parseExpression :: Parsec.Parsec String P.ParseState P.Value
117158parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof
118159
119−helpMessage :: String
120−helpMessage = "The following commands are available:\n\n " ++
121− intercalate "\n " (map (intercalate " ") help)
160+handleCommand :: Command -> StateT PSCI (InputT IO) ()
161+handleCommand Empty = return ()
162+handleCommand (Expression ls) =
163+ case P.runIndentParser "" parseDoNotationBind (unlines ls) of
164+ Left _ ->
165+ case P.runIndentParser "" parseExpression (unlines ls) of
166+ Left err -> inputTToState $ outputStrLn (show err)
167+ Right decl -> get >>= inputTToState . handleDeclaration decl
168+ Right binder -> modify (updateBinders binder)
169+handleCommand Help = inputTToState $ outputStrLn helpMessage
170+handleCommand (Import moduleName) = modify (updateImports moduleName)
171+handleCommand (Let line) =
172+ case P.runIndentParser "" parseDoNotationLet line of
173+ Left err -> inputTToState $ outputStrLn (show err)
174+ Right binder -> modify (updateBinders binder)
175+handleCommand (LoadFile filePath) = do
176+ mf <- ioToState $ loadModule filePath
177+ case mf of
178+ Left err -> inputTToState $ outputStrLn err
179+ Right mf' -> modify (updateModules mf')
180+handleCommand Reload = do
181+ (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule
182+ put (PSCI defaultImports prelude [])
183+handleCommand Unknown = inputTToState $ outputStrLn "Unknown command"
122184
123185main :: IO ()
124186main = do
@@ -127,51 +189,12 @@ main = do
127189 historyFilename <- getHistoryFilename
128190 let settings = defaultSettings {historyFile = Just historyFilename}
129191 runInputT (setComplete (completion prelude) settings) $ do
130− outputStrLn " ____ ____ _ _ "
131− outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
132− outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
133− outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
134− outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
135− outputStrLn " |_| "
136− outputStrLn ""
137− outputStrLn "Expressions are terminated using Ctrl+D"
138− go defaultImports prelude []
192+ outputStrLn prologueMessage
193+ evalStateT go (PSCI defaultImports prelude [])
139194 where
140− go :: [P.ProperName] -> [P.Module] -> [P.DoNotationElement] -> InputT IO ()
141− go imports loadedModules binders = do
142− cmd <- getCommand
143− case cmd of
144− Empty -> go imports loadedModules binders
145− Expression ls -> do
146− binders' <- case P.runIndentParser "" parseDoNotationBind (unlines ls) of
147− Left _ ->
148− case P.runIndentParser "" parseExpression (unlines ls) of
149− Left err -> outputStrLn (show err) >> return binders
150− Right decl -> do
151− handleDeclaration loadedModules imports (reverse binders) decl
152− return binders
153− Right binder -> return $ binder:binders
154− go imports loadedModules binders'
155− Help -> do
156− outputStrLn helpMessage
157− go imports loadedModules binders
158− Import moduleName ->
159− go (imports ++ [P.ProperName moduleName]) loadedModules binders
160− Let line -> do
161− binders' <- case P.runIndentParser "" parseDoNotationLet line of
162− Left err -> outputStrLn (show err) >> return binders
163− Right binder -> return $ binder:binders
164− go imports loadedModules binders'
165− LoadModule moduleFile -> do
166− ms <- lift $ loadModule moduleFile
167− loadedModules' <- case ms of
168− Left err -> outputStrLn err >> return loadedModules
169− Right ms' -> return $ loadedModules ++ ms'
170− go imports loadedModules' binders
171− Reload -> do
172− preludeFilename <- lift getPreludeFilename
173− (Right prelude) <- lift $ loadModule preludeFilename
174− go defaultImports prelude binders
175− Unknown -> do
176− outputStrLn "Unknown command"
177− go imports loadedModules binders
195+ go :: StateT PSCI (InputT IO) ()
196+ go = do
197+ c <- inputTToState getCommand
198+ case c of
199+ Quit -> inputTToState $ outputStrLn quitMessage
200+ _ -> handleCommand c >> go