@@ -0,0 +1,96 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Main
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE FlexibleContexts #-}
16+
17+module Main where
18+
19+import Control.Monad (forever)
20+import Control.Monad.Trans.Class
21+
22+import Data.Generics
23+import Data.List (isPrefixOf)
24+
25+import System.Console.Haskeline
26+
27+import qualified Language.PureScript as P
28+import qualified Control.Monad.State.Strict as S
29+import qualified Paths_purescript as Paths
30+import qualified System.IO.UTF8 as U (readFile)
31+
32+getPreludeFilename :: IO FilePath
33+getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
34+
35+options :: P.Options
36+options = P.Options True False True False
37+
38+data InterpreterState = InterpreterState { interpEnv :: [P.DoNotationElement] } deriving (Show)
39+
40+defaultState :: InterpreterState
41+defaultState = InterpreterState []
42+
43+completion :: (S.MonadState InterpreterState m) => CompletionFunc m
44+completion = completeWord Nothing " \t\n\r" findCompletions
45+ where
46+ findCompletions :: (S.MonadState InterpreterState m) => String -> m [Completion]
47+ findCompletions str = do
48+ st <- S.get
49+ let names = map show . concatMap toNames . interpEnv $ st
50+ let matches = filter (isPrefixOf str) names
51+ 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 =
64+ let
65+ moduleName = P.ProperName "Temp"
66+ importDecl m = P.ImportDeclaration m Nothing
67+ prelude = P.ModuleName (P.ProperName "Prelude")
68+ effModule = P.ModuleName (P.ProperName "Eff")
69+ effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
70+ itDecl = P.ValueDeclaration (P.Ident "it") [] Nothing (P.Do effMonad decls)
71+ in
72+ P.Module moduleName [importDecl prelude, itDecl]
73+
74+main :: IO ()
75+main = do
76+ preludeFilename <- getPreludeFilename
77+ preludeText <- U.readFile preludeFilename
78+ let (Right prelude) = P.runIndentParser P.parseModules preludeText
79+ flip S.evalStateT defaultState . runInputT (setComplete completion defaultSettings) $ do
80+ outputStrLn "PureScript Compiler (Interactive Mode)"
81+ forever $ do
82+ line <- getInputLine "> "
83+ case line of
84+ Nothing -> return ()
85+ Just line' ->
86+ case P.runIndentParser P.parseDoNotationElement line' of
87+ 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] }
96+