git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Added quit command and use StateT.
94d6913joneshf
psci/Commands.hs+7−5
compare with golang
unifiedsplit
@@ -9,18 +9,20 @@ data Command
9 | Help
9 | Help
10 | Import String
10 | Import String
11 | Let String
11 | Let String
12− | LoadModule FilePath
12+ | LoadFile FilePath
13+ | Quit
13 | Reload
14 | Reload
14 | Unknown deriving (Show, Eq)
15 | Unknown deriving (Show, Eq)
15
16
16getCommand :: InputT IO Command
17getCommand :: InputT IO Command
17getCommand = do
18getCommand = do
18− firstLine <- getInputLine "> "
19+ firstLine <- getInputLine "> "
19 case firstLine of
20 case firstLine of
20 Nothing -> return Empty
21 Nothing -> return Empty
21 Just ":?" -> return Help
22 Just ":?" -> return Help
22 Just (':':'i':' ':moduleName) -> return $ Import moduleName
23 Just (':':'i':' ':moduleName) -> return $ Import moduleName
23− Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
24+ Just (':':'m':' ':filePath) -> return $ LoadFile filePath
25+ Just ":q" -> return Quit
24 Just ":r" -> return Reload
26 Just ":r" -> return Reload
25 Just (':':_) -> return Unknown
27 Just (':':_) -> return Unknown
26 Just l@('l':'e':'t':_) -> return $ Let l
28 Just l@('l':'e':'t':_) -> return $ Let l
@@ -36,7 +38,7 @@ help :: [[String]]
36help =
38help =
37 [ [":? ", "Show this help menu"]
39 [ [":? ", "Show this help menu"]
38 , [":i <module>", "Import <module> for use in PSCI"]
40 , [":i <module>", "Import <module> for use in PSCI"]
39− , [":m <module>", "Load <module> for importing"]
41+ , [":m <file> ", "Load <file> for importing"]
40− , [":q ", "Quit PSCI"]
42+ , [":q ", "Quit PSCi"]
41 , [":r ", "Reload all modules."]
43 , [":r ", "Reload all modules."]
42 ]
44 ]
psci/Main.hs+81−58
@@ -22,6 +22,7 @@ import Control.Applicative
22import Control.Monad
22import Control.Monad
23import Control.Monad.Trans.Class
23import Control.Monad.Trans.Class
24import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
24import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25+import Control.Monad.Trans.State
25
26
26import Data.List (intercalate, isPrefixOf, nub, sort)
27import Data.List (intercalate, isPrefixOf, nub, sort)
27import Data.Maybe (mapMaybe)
28import Data.Maybe (mapMaybe)
@@ -38,6 +39,25 @@ import qualified Paths_purescript as Paths
38import qualified System.IO.UTF8 as U (readFile)
39import qualified System.IO.UTF8 as U (readFile)
39import qualified Text.Parsec as Parsec (Parsec, eof)
40import qualified Text.Parsec as Parsec (Parsec, eof)
40
41
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
41getHistoryFilename :: IO FilePath
61getHistoryFilename :: IO FilePath
42getHistoryFilename = getUserConfigFile "purescript" "psci_history"
62getHistoryFilename = getUserConfigFile "purescript" "psci_history"
43
63
@@ -51,6 +71,33 @@ findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
51defaultImports :: [P.ProperName]
71defaultImports :: [P.ProperName]
52defaultImports = [P.ProperName "Prelude", P.ProperName "Eff"]
72defaultImports = [P.ProperName "Prelude", P.ProperName "Eff"]
53
73
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+
54options :: P.Options
101options :: P.Options
55options = P.Options True False True (Just "Main") True "PS" []
102options = P.Options True False True (Just "Main") True "PS" []
56
103
@@ -87,8 +134,8 @@ createTemporaryModule imports binders value =
87 in
134 in
88 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
135 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
89
136
90−handleDeclaration :: [P.Module] -> [P.ProperName] -> [P.DoNotationElement] -> P.Value -> InputT IO ()
137+handleDeclaration :: P.Value -> PSCI -> InputT IO ()
91−handleDeclaration loadedModules imports binders value = do
138+handleDeclaration value (PSCI imports loadedModules binders) = do
92 let m = createTemporaryModule imports binders value
139 let m = createTemporaryModule imports binders value
93 case P.compile options (loadedModules ++ [m]) of
140 case P.compile options (loadedModules ++ [m]) of
94 Left err -> outputStrLn err
141 Left err -> outputStrLn err
@@ -100,12 +147,6 @@ handleDeclaration loadedModules imports binders value = do
100 Just (ExitFailure _, _, err) -> outputStrLn err
147 Just (ExitFailure _, _, err) -> outputStrLn err
101 Nothing -> outputStrLn "Couldn't find node.js"
148 Nothing -> outputStrLn "Couldn't find node.js"
102
149
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−
109parseDoNotationLet :: Parsec.Parsec String P.ParseState P.DoNotationElement
150parseDoNotationLet :: Parsec.Parsec String P.ParseState P.DoNotationElement
110parseDoNotationLet = P.DoNotationLet <$> (P.reserved "let" *> P.indented *> P.parseBinder)
151parseDoNotationLet = P.DoNotationLet <$> (P.reserved "let" *> P.indented *> P.parseBinder)
111 <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
152 <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
@@ -116,9 +157,30 @@ parseDoNotationBind = P.DoNotationBind <$> P.parseBinder <*> (P.indented *> P.re
116parseExpression :: Parsec.Parsec String P.ParseState P.Value
157parseExpression :: Parsec.Parsec String P.ParseState P.Value
117parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof
158parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof
118
159
119−helpMessage :: String
160+handleCommand :: Command -> StateT PSCI (InputT IO) ()
120−helpMessage = "The following commands are available:\n\n " ++
161+handleCommand Empty = return ()
121− intercalate "\n " (map (intercalate " ") help)
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"
122
184
123main :: IO ()
185main :: IO ()
124main = do
186main = do
@@ -127,51 +189,12 @@ main = do
127 historyFilename <- getHistoryFilename
189 historyFilename <- getHistoryFilename
128 let settings = defaultSettings {historyFile = Just historyFilename}
190 let settings = defaultSettings {historyFile = Just historyFilename}
129 runInputT (setComplete (completion prelude) settings) $ do
191 runInputT (setComplete (completion prelude) settings) $ do
130− outputStrLn " ____ ____ _ _ "
192+ outputStrLn prologueMessage
131− outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
132− outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
133− outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
134− outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
135− outputStrLn " |_| "
136− outputStrLn ""
137− outputStrLn "Expressions are terminated using Ctrl+D"
138− go defaultImports prelude []
193+ evalStateT go (PSCI defaultImports prelude [])
139 where
194 where
140− go :: [P.ProperName] -> [P.Module] -> [P.DoNotationElement] -> InputT IO ()
195+ go :: StateT PSCI (InputT IO) ()
141− go imports loadedModules binders = do
196+ go = do
142− cmd <- getCommand
197+ c <- inputTToState getCommand
143− case cmd of
198+ case c of
144− Empty -> go imports loadedModules binders
199+ Quit -> inputTToState $ outputStrLn quitMessage
145− Expression ls -> do
200+ _ -> handleCommand c >> go
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