@@ -16,20 +16,20 @@
1616
1717module Main where
1818
19−import Control.Monad (forever)
20−import Control.Monad.Trans.Class
2119import Control.Monad.IO.Class
20+import Control.Applicative
21+import Control.Monad.Trans.Class
2222
23−import Data.Generics
24−import Data.List (isPrefixOf)
23+import Data.List (nub, isPrefixOf)
24+import Data.Maybe (mapMaybe)
2525
2626import System.Process
2727import System.Console.Haskeline
2828
2929import qualified Language.PureScript as P
30−import qualified Control.Monad.State.Strict as S
3130import qualified Paths_purescript as Paths
3231import qualified System.IO.UTF8 as U (readFile)
32+import qualified Text.Parsec as Parsec (eof)
3333
3434getPreludeFilename :: IO FilePath
3535getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
@@ -37,75 +37,112 @@ getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
3737options :: P.Options
3838options = P.Options True False True True
3939
40−data InterpreterState = InterpreterState { interpEnv :: [P.DoNotationElement] } deriving (Show)
41−
42−defaultState :: InterpreterState
43−defaultState = InterpreterState []
44−
45−completion :: (S.MonadState InterpreterState m) => CompletionFunc m
46−completion = completeWord Nothing " \t\n\r" findCompletions
40+completion :: [P.Module] -> CompletionFunc IO
41+completion ms = completeWord Nothing " \t\n\r" findCompletions
4742 where
48− findCompletions :: (S.MonadState InterpreterState m) => String -> m [Completion]
43+ findCompletions :: String -> IO [Completion]
4944 findCompletions str = do
50− st <- S.get
51− let names = map show . concatMap findAllNames . interpEnv $ st
45+ files <- listFiles str
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+ ]
5252 let matches = filter (isPrefixOf str) names
53− return $ map simpleCompletion matches
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 _ = []
53+ return $ map simpleCompletion matches ++ files
54+ getDeclName :: P.Declaration -> Maybe P.Ident
55+ getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
56+ getDeclName _ = Nothing
6557
66−createTemporaryModule :: [P.DoNotationElement] -> P.DoNotationElement -> P.Module
67−createTemporaryModule decls decl =
58+createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
59+createTemporaryModule imports value =
6860 let
6961 moduleName = P.ProperName "Main"
7062 importDecl m = P.ImportDeclaration m Nothing
71− prelude = P.ModuleName (P.ProperName "Prelude")
7263 effModule = P.ModuleName (P.ProperName "Eff")
7364 traceModule = P.ModuleName (P.ProperName "Trace")
7465 effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
7566 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+ ])
8071 in
81− P.Module moduleName [importDecl prelude, itDecl]
82−
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
72+ P.Module moduleName $ map (importDecl . P.ModuleName) imports ++ [mainDecl]
73+
74+handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
75+handleDeclaration loadedModules imports value = do
76+ let m = createTemporaryModule imports value
77+ case P.compile options (loadedModules ++ [m]) of
9078 Left err -> outputStrLn err
9179 Right (js, _, _) -> do
9280 output <- liftIO $ readProcess "nodejs" [] js
9381 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
95112
96113main :: IO ()
97114main = do
98115 preludeFilename <- getPreludeFilename
99− preludeText <- U.readFile preludeFilename
100− let (Right prelude) = P.runIndentParser P.parseModules preludeText
101− flip S.evalStateT defaultState . runInputT (setComplete completion defaultSettings) $ do
102− outputStrLn "PureScript Compiler (Interactive Mode)"
103− forever $ do
104− line <- getInputLine "> "
105− case line of
106− Nothing -> return ()
107− Just line' ->
108− case P.runIndentParser P.parseDoNotationElement line' of
109− Left err -> outputStrLn (show err)
110− Right decl -> handleDeclaration prelude decl
116+ (Right prelude) <- loadModule preludeFilename
117+ runInputT (setComplete (completion prelude) defaultSettings) $ do
118+ outputStrLn " ____ ____ _ _ "
119+ outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
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
130+ case cmd of
131+ Empty -> go imports loadedModules
132+ Expression ls -> do
133+ case P.runIndentParser (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
134+ Left err -> outputStrLn (show err)
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+
111148