git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Some improvements to the REPL
25e5c05Phil Freeman
psci/Main.hs+93−56
compare with golang
unifiedsplit
@@ -16,20 +16,20 @@
16
16
17module Main where
17module Main where
18
18
19−import Control.Monad (forever)
20−import Control.Monad.Trans.Class
21import Control.Monad.IO.Class
19import Control.Monad.IO.Class
20+import Control.Applicative
21+import Control.Monad.Trans.Class
22
22
23−import Data.Generics
24−import Data.List (isPrefixOf)
23+import Data.List (nub, isPrefixOf)
24+import Data.Maybe (mapMaybe)
25
25
26import System.Process
26import System.Process
27import System.Console.Haskeline
27import System.Console.Haskeline
28
28
29import qualified Language.PureScript as P
29import qualified Language.PureScript as P
30−import qualified Control.Monad.State.Strict as S
31import qualified Paths_purescript as Paths
30import qualified Paths_purescript as Paths
32import qualified System.IO.UTF8 as U (readFile)
31import qualified System.IO.UTF8 as U (readFile)
32+import qualified Text.Parsec as Parsec (eof)
33
33
34getPreludeFilename :: IO FilePath
34getPreludeFilename :: IO FilePath
35getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
35getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
@@ -37,75 +37,112 @@ getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
37options :: P.Options
37options :: P.Options
38options = P.Options True False True True
38options = P.Options True False True True
39
39
40−data InterpreterState = InterpreterState { interpEnv :: [P.DoNotationElement] } deriving (Show)
40+completion :: [P.Module] -> CompletionFunc IO
41−
42−defaultState :: InterpreterState
43−defaultState = InterpreterState []
44−
45−completion :: (S.MonadState InterpreterState m) => CompletionFunc m
46−completion = completeWord Nothing " \t\n\r" findCompletions
41+completion ms = completeWord Nothing " \t\n\r" findCompletions
47 where
42 where
48− findCompletions :: (S.MonadState InterpreterState m) => String -> m [Completion]
43+ findCompletions :: String -> IO [Completion]
49 findCompletions str = do
44 findCompletions str = do
50− st <- S.get
45+ files <- listFiles str
51− let names = map show . concatMap findAllNames . interpEnv $ st
46+ let names = nub $ [ show qual
47+ | P.Module moduleName ds <- ms
48+ , ident <- mapMaybe getDeclName ds
49+ , qual <- [ P.Qualified Nothing ident
50+ , P.Qualified (Just (P.ModuleName moduleName)) ident]
51+ ]
52 let matches = filter (isPrefixOf str) names
52 let matches = filter (isPrefixOf str) names
53− return $ map simpleCompletion matches
53+ return $ map simpleCompletion matches ++ files
54−
54+ getDeclName :: P.Declaration -> Maybe P.Ident
55−findAllNames :: P.DoNotationElement -> [P.Ident]
55+ getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
56−findAllNames (P.DoNotationLet binder _) = binderToNames binder
56+ getDeclName _ = Nothing
57−findAllNames (P.DoNotationBind binder _) = binderToNames binder
58−findAllNames _ = []
59−
60−binderToNames :: P.Binder -> [P.Ident]
61−binderToNames = everything (++) (mkQ [] find)
62− where
63− find (P.VarBinder ident) = [ident]
64− find _ = []
65
57
66−createTemporaryModule :: [P.DoNotationElement] -> P.DoNotationElement -> P.Module
58+createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
67−createTemporaryModule decls decl =
59+createTemporaryModule imports value =
68 let
60 let
69 moduleName = P.ProperName "Main"
61 moduleName = P.ProperName "Main"
70 importDecl m = P.ImportDeclaration m Nothing
62 importDecl m = P.ImportDeclaration m Nothing
71− prelude = P.ModuleName (P.ProperName "Prelude")
72 effModule = P.ModuleName (P.ProperName "Eff")
63 effModule = P.ModuleName (P.ProperName "Eff")
73 traceModule = P.ModuleName (P.ProperName "Trace")
64 traceModule = P.ModuleName (P.ProperName "Trace")
74 effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
65 effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
75 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
66 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
76− varsIntroduced = findAllNames decl
77− traceVars | null varsIntroduced = [P.DoNotationValue (P.App trace [P.StringLiteral "Done"])]
78− | otherwise = map (\ident -> P.DoNotationValue (P.App trace [P.Var (P.Qualified Nothing ident)])) varsIntroduced
79− itDecl = P.ValueDeclaration (P.Ident "main") [] Nothing (P.Do effMonad (decls ++ decl : traceVars))
67+ mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
68+ (P.Do effMonad [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
69+ , P.DoNotationValue (P.App trace [ P.Var (P.Qualified Nothing (P.Ident "it")) ] )
70+ ])
80 in
71 in
81− P.Module moduleName [importDecl prelude, itDecl]
72+ P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]
82−
73+
83−handleDeclaration :: (S.MonadState InterpreterState m, S.MonadIO m) => [P.Module] -> P.DoNotationElement -> InputT m ()
74+handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
84−handleDeclaration _ (P.DoNotationReturn _) = outputStrLn "return statements are not supported in interactive mode"
75+handleDeclaration loadedModules imports value = do
85−handleDeclaration prelude (P.DoNotationValue val) = handleDeclaration prelude (P.DoNotationBind (P.VarBinder (P.Ident "it")) val)
86−handleDeclaration prelude decl = do
87− st <- lift S.get
88− let m = createTemporaryModule (interpEnv st) decl
76+ let m = createTemporaryModule imports value
89− case P.compile options (prelude ++ [m]) of
77+ case P.compile options (loadedModules ++ [m]) of
90 Left err -> outputStrLn err
78 Left err -> outputStrLn err
91 Right (js, _, _) -> do
79 Right (js, _, _) -> do
92 output <- liftIO $ readProcess "nodejs" [] js
80 output <- liftIO $ readProcess "nodejs" [] js
93 outputStrLn output
81 outputStrLn output
94− lift . S.put $ st { interpEnv = interpEnv st ++ [decl] }
82+
83+data Command
84+ = Empty
85+ | Expression [String]
86+ | Import String
87+ | LoadModule FilePath
88+ | Reload deriving (Show, Eq)
89+
90+getCommand :: InputT IO Command
91+getCommand = do
92+ firstLine <- getInputLine "> "
93+ case firstLine of
94+ Nothing -> return Empty
95+ Just (':':'i':' ':moduleName) -> return $ Import moduleName
96+ Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
97+ Just ":r" -> return Reload
98+ Just (':':_) -> outputStrLn "Unknown command" >> getCommand
99+ Just other -> Expression <$> go [other]
100+ where
101+ go ls = do
102+ l <- getInputLine " "
103+ case l of
104+ Nothing -> return $ reverse ls
105+ Just l' -> go (l' : ls)
106+
107+loadModule :: FilePath -> IO (Either String [P.Module])
108+loadModule moduleFile = do
109+ print moduleFile
110+ moduleText <- U.readFile moduleFile
111+ return . either (Left . show) Right $ P.runIndentParser P.parseModules moduleText
95
112
96main :: IO ()
113main :: IO ()
97main = do
114main = do
98 preludeFilename <- getPreludeFilename
115 preludeFilename <- getPreludeFilename
99− preludeText <- U.readFile preludeFilename
116+ (Right prelude) <- loadModule preludeFilename
100− let (Right prelude) = P.runIndentParser P.parseModules preludeText
101− flip S.evalStateT defaultState . runInputT (setComplete completion defaultSettings) $ do
117+ runInputT (setComplete (completion prelude) defaultSettings) $ do
102− outputStrLn "PureScript Compiler (Interactive Mode)"
118+ outputStrLn " ____ ____ _ _ "
103− forever $ do
119+ outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
104− line <- getInputLine "> "
120+ outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
121+ outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
122+ outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
123+ outputStrLn " |_| "
124+ outputStrLn ""
125+ outputStrLn "Expressions are terminated using Ctrl+D"
126+ go [P.ProperName "Prelude"] prelude
127+ where
128+ go imports loadedModules = do
129+ cmd <- getCommand
105− case line of
130+ case cmd of
106− Nothing -> return ()
131+ Empty -> go imports loadedModules
107− Just line' ->
132+ Expression ls -> do
108− case P.runIndentParser P.parseDoNotationElement line' of
133+ case P.runIndentParser (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
109− Left err -> outputStrLn (show err)
134+ Left err -> outputStrLn (show err)
110− Right decl -> handleDeclaration prelude decl
135+ Right decl -> handleDeclaration loadedModules imports decl
136+ go imports loadedModules
137+ Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules
138+ LoadModule moduleFile -> do
139+ ms <- lift $ loadModule moduleFile
140+ case ms of
141+ Left err -> outputStrLn err
142+ Right ms' -> go imports (loadedModules ++ ms')
143+ Reload -> do
144+ preludeFilename <- lift getPreludeFilename
145+ (Right prelude) <- lift $ loadModule preludeFilename
146+ go [P.ProperName "Prelude"] prelude
147+
111
148