git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
First pass at let bindings.
2410dadjoneshf
psci/Commands.hsnew file+30
@@ -0,0 +1,30 @@
1+module Commands where
2+
3+import Control.Applicative
4+import System.Console.Haskeline
5+
6+data Command
7+ = Empty
8+ | Expression [String]
9+ | Import String
10+ | Let String
11+ | LoadModule FilePath
12+ | Reload deriving (Show, Eq)
13+
14+getCommand :: InputT IO Command
15+getCommand = do
16+ firstLine <- getInputLine "> "
17+ case firstLine of
18+ Nothing -> return Empty
19+ Just (':':'i':' ':moduleName) -> return $ Import moduleName
20+ Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
21+ Just ":r" -> return Reload
22+ Just (':':_) -> outputStrLn "Unknown command" >> getCommand
23+ Just l@('l':'e':'t':_) -> return $ Let l
24+ Just other -> Expression <$> go [other]
25+ where
26+ go ls = do
27+ l <- getInputLine " "
28+ case l of
29+ Nothing -> return $ reverse ls
30+ Just l' -> go (l' : ls)
psci/Main.hs+35−40
@@ -16,6 +16,8 @@
16
16
17module Main where
17module Main where
18
18
19+import Commands
20+
19import Control.Applicative
21import Control.Applicative
20import Control.Monad
22import Control.Monad
21import Control.Monad.Trans.Class
23import Control.Monad.Trans.Class
@@ -34,7 +36,7 @@ import System.Process
34import qualified Language.PureScript as P
36import qualified Language.PureScript as P
35import qualified Paths_purescript as Paths
37import qualified Paths_purescript as Paths
36import qualified System.IO.UTF8 as U (readFile)
38import qualified System.IO.UTF8 as U (readFile)
37−import qualified Text.Parsec as Parsec (eof)
39+import qualified Text.Parsec as Parsec (Parsec, eof)
38
40
39getHistoryFilename :: IO FilePath
41getHistoryFilename :: IO FilePath
40getHistoryFilename = getUserConfigFile "purescript" "psci_history"
42getHistoryFilename = getUserConfigFile "purescript" "psci_history"
@@ -46,6 +48,9 @@ findNodeProcess :: IO (Maybe String)
46findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
48findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
47 where names = ["nodejs", "node"]
49 where names = ["nodejs", "node"]
48
50
51+defaultImports :: [P.ProperName]
52+defaultImports = [P.ProperName "Prelude", P.ProperName "Eff"]
53+
49options :: P.Options
54options :: P.Options
50options = P.Options True False True (Just "Main") True "PS" []
55options = P.Options True False True (Just "Main") True "PS" []
51
56
@@ -67,23 +72,24 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
67 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
72 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
68 getDeclName _ = Nothing
73 getDeclName _ = Nothing
69
74
70−createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
75+createTemporaryModule :: [P.ProperName] -> [P.DoNotationElement] -> P.Value -> P.Module
71−createTemporaryModule imports value =
76+createTemporaryModule imports lets value =
72 let
77 let
73 moduleName = P.ModuleName [P.ProperName "Main"]
78 moduleName = P.ModuleName [P.ProperName "Main"]
74 importDecl m = P.ImportDeclaration m Nothing
79 importDecl m = P.ImportDeclaration m Nothing
75 traceModule = P.ModuleName [P.ProperName "Trace"]
80 traceModule = P.ModuleName [P.ProperName "Trace"]
76 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
81 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
77 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
82 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
83+ (P.Do (lets ++
78− (P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
84+ [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
79 , P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
85 , P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
80− ])
86+ ]))
81 in
87 in
82 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
88 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
83
89
84−handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
90+handleDeclaration :: [P.Module] -> [P.ProperName] -> [P.DoNotationElement] -> P.Value -> InputT IO ()
85−handleDeclaration loadedModules imports value = do
91+handleDeclaration loadedModules imports lets value = do
86− let m = createTemporaryModule imports value
92+ let m = createTemporaryModule imports lets value
87 case P.compile options (loadedModules ++ [m]) of
93 case P.compile options (loadedModules ++ [m]) of
88 Left err -> outputStrLn err
94 Left err -> outputStrLn err
89 Right (js, _, _) -> do
95 Right (js, _, _) -> do
@@ -94,36 +100,19 @@ handleDeclaration loadedModules imports value = do
94 Just (ExitFailure _, _, err) -> outputStrLn err
100 Just (ExitFailure _, _, err) -> outputStrLn err
95 Nothing -> outputStrLn "Couldn't find node.js"
101 Nothing -> outputStrLn "Couldn't find node.js"
96
102
97−data Command
98− = Empty
99− | Expression [String]
100− | Import String
101− | LoadModule FilePath
102− | Reload deriving (Show, Eq)
103−
104−getCommand :: InputT IO Command
105−getCommand = do
106− firstLine <- getInputLine "> "
107− case firstLine of
108− Nothing -> return Empty
109− Just (':':'i':' ':moduleName) -> return $ Import moduleName
110− Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
111− Just ":r" -> return Reload
112− Just (':':_) -> outputStrLn "Unknown command" >> getCommand
113− Just other -> Expression <$> go [other]
114− where
115− go ls = do
116− l <- getInputLine " "
117− case l of
118− Nothing -> return $ reverse ls
119− Just l' -> go (l' : ls)
120−
121loadModule :: FilePath -> IO (Either String [P.Module])
103loadModule :: FilePath -> IO (Either String [P.Module])
122loadModule moduleFile = do
104loadModule moduleFile = do
123 print moduleFile
105 print moduleFile
124 moduleText <- U.readFile moduleFile
106 moduleText <- U.readFile moduleFile
125 return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
107 return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
126
108
109+parseDoNotationLet :: Parsec.Parsec String P.ParseState P.DoNotationElement
110+parseDoNotationLet = P.DoNotationLet <$> (P.reserved "let" *> P.indented *> P.parseBinder)
111+ <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
112+
113+parseDoNotationBind :: Parsec.Parsec String P.ParseState P.DoNotationElement
114+parseDoNotationBind = P.DoNotationBind <$> P.parseBinder <*> (P.indented *> P.reservedOp "<-" *> P.parseValue)
115+
127main :: IO ()
116main :: IO ()
128main = do
117main = do
129 preludeFilename <- getPreludeFilename
118 preludeFilename <- getPreludeFilename
@@ -139,26 +128,32 @@ main = do
139 outputStrLn " |_| "
128 outputStrLn " |_| "
140 outputStrLn ""
129 outputStrLn ""
141 outputStrLn "Expressions are terminated using Ctrl+D"
130 outputStrLn "Expressions are terminated using Ctrl+D"
142− go [P.ProperName "Prelude", P.ProperName "Eff"] prelude
131+ go defaultImports prelude []
143 where
132 where
133+ go :: [P.ProperName] -> [P.Module] -> [P.DoNotationElement] -> InputT IO ()
144− go imports loadedModules = do
134+ go imports loadedModules lets = do
145 cmd <- getCommand
135 cmd <- getCommand
146 case cmd of
136 case cmd of
147− Empty -> go imports loadedModules
137+ Empty -> go imports loadedModules lets
148 Expression ls -> do
138 Expression ls -> do
149 case P.runIndentParser "" (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
139 case P.runIndentParser "" (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
150 Left err -> outputStrLn (show err)
140 Left err -> outputStrLn (show err)
151− Right decl -> handleDeclaration loadedModules imports decl
141+ Right decl -> handleDeclaration loadedModules imports lets decl
152− go imports loadedModules
142+ go imports loadedModules lets
153− Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules
143+ Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules lets
144+ Let line -> do
145+ moreLets <- case P.runIndentParser "" parseDoNotationLet line of
146+ Left err -> outputStrLn (show err) >> return lets
147+ Right l -> return $ lets ++ [l]
148+ go imports loadedModules moreLets
154 LoadModule moduleFile -> do
149 LoadModule moduleFile -> do
155 ms <- lift $ loadModule moduleFile
150 ms <- lift $ loadModule moduleFile
156 case ms of
151 case ms of
157 Left err -> outputStrLn err
152 Left err -> outputStrLn err
158− Right ms' -> go imports (loadedModules ++ ms')
153+ Right ms' -> go imports (loadedModules ++ ms') lets
159 Reload -> do
154 Reload -> do
160 preludeFilename <- lift getPreludeFilename
155 preludeFilename <- lift getPreludeFilename
161 (Right prelude) <- lift $ loadModule preludeFilename
156 (Right prelude) <- lift $ loadModule preludeFilename
162− go [P.ProperName "Prelude"] prelude
157+ go defaultImports prelude lets
163
158
164
159