@@ -18,10 +18,12 @@ module Main where
1818
1919import Control.Monad (forever)
2020import Control.Monad.Trans.Class
21+import Control.Monad.IO.Class
2122
2223import Data.Generics
2324import Data.List (isPrefixOf)
2425
26+import System.Process
2527import System.Console.Haskeline
2628
2729import qualified Language.PureScript as P
@@ -33,7 +35,7 @@ getPreludeFilename :: IO FilePath
3335getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
3436
3537options :: P.Options
36−options = P.Options True False True False
38+options = P.Options True False True True
3739
3840data InterpreterState = InterpreterState { interpEnv :: [P.DoNotationElement] } deriving (Show)
3941
@@ -46,31 +48,51 @@ completion = completeWord Nothing " \t\n\r" findCompletions
4648 findCompletions :: (S.MonadState InterpreterState m) => String -> m [Completion]
4749 findCompletions str = do
4850 st <- S.get
49− let names = map show . concatMap toNames . interpEnv $ st
51+ let names = map show . concatMap findAllNames . interpEnv $ st
5052 let matches = filter (isPrefixOf str) names
5153 return $ map simpleCompletion matches
52− toNames :: P.DoNotationElement -> [P.Ident]
53− toNames (P.DoNotationLet binder _) = binderToNames binder
54− toNames (P.DoNotationBind binder _) = binderToNames binder
55− toNames _ = []
56− binderToNames :: P.Binder -> [P.Ident]
57− binderToNames = everything (++) (mkQ [] find)
58− where
59− find (P.VarBinder ident) = [ident]
60− find _ = []
61−
62−createTemporaryModule :: [P.DoNotationElement] -> P.Module
63−createTemporaryModule decls =
54+
55+findAllNames :: P.DoNotationElement -> [P.Ident]
56+findAllNames (P.DoNotationLet binder _) = binderToNames binder
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+
66+createTemporaryModule :: [P.DoNotationElement] -> P.DoNotationElement -> P.Module
67+createTemporaryModule decls decl =
6468 let
65− moduleName = P.ProperName "Temp"
69+ moduleName = P.ProperName "Main"
6670 importDecl m = P.ImportDeclaration m Nothing
6771 prelude = P.ModuleName (P.ProperName "Prelude")
6872 effModule = P.ModuleName (P.ProperName "Eff")
73+ traceModule = P.ModuleName (P.ProperName "Trace")
6974 effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
70− itDecl = P.ValueDeclaration (P.Ident "it") [] Nothing (P.Do effMonad decls)
75+ 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))
7180 in
7281 P.Module moduleName [importDecl prelude, itDecl]
7382
83+handleDeclaration :: (S.MonadState InterpreterState m, S.MonadIO m) => [P.Module] -> P.DoNotationElement -> InputT m ()
84+handleDeclaration _ (P.DoNotationReturn _) = outputStrLn "return statements are not supported in interactive mode"
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
89+ case P.compile options (prelude ++ [m]) of
90+ Left err -> outputStrLn err
91+ Right (js, _, _) -> do
92+ output <- liftIO $ readProcess "nodejs" [] js
93+ outputStrLn output
94+ lift . S.put $ st { interpEnv = interpEnv st ++ [decl] }
95+
7496main :: IO ()
7597main = do
7698 preludeFilename <- getPreludeFilename
@@ -85,12 +107,5 @@ main = do
85107 Just line' ->
86108 case P.runIndentParser P.parseDoNotationElement line' of
87109 Left err -> outputStrLn (show err)
88− Right decl -> do
89− st <- lift S.get
90− let m = createTemporaryModule (interpEnv st ++ [decl])
91− case P.compile options (prelude ++ [m]) of
92− Left err -> outputStrLn err
93− Right (js, _, _) -> do
94− outputStrLn js
95− lift . S.put $ st { interpEnv = interpEnv st ++ [decl] }
110+ Right decl -> handleDeclaration prelude decl
96111