@@ -0,0 +1,148 @@
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.IO.Class
20+import Control.Applicative
21+import Control.Monad.Trans.Class
22+
23+import Data.List (nub, isPrefixOf)
24+import Data.Maybe (mapMaybe)
25+
26+import System.Process
27+import System.Console.Haskeline
28+
29+import qualified Language.PureScript as P
30+import qualified Paths_purescript as Paths
31+import qualified System.IO.UTF8 as U (readFile)
32+import qualified Text.Parsec as Parsec (eof)
33+
34+getPreludeFilename :: IO FilePath
35+getPreludeFilename = Paths.getDataFileName "libraries/prelude/prelude.purs"
36+
37+options :: P.Options
38+options = P.Options True False True True
39+
40+completion :: [P.Module] -> CompletionFunc IO
41+completion ms = completeWord Nothing " \t\n\r" findCompletions
42+ where
43+ findCompletions :: String -> IO [Completion]
44+ findCompletions str = do
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+ ]
52+ let matches = filter (isPrefixOf str) names
53+ return $ map simpleCompletion matches ++ files
54+ getDeclName :: P.Declaration -> Maybe P.Ident
55+ getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
56+ getDeclName _ = Nothing
57+
58+createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
59+createTemporaryModule imports value =
60+ let
61+ moduleName = P.ProperName "Main"
62+ importDecl m = P.ImportDeclaration m Nothing
63+ effModule = P.ModuleName (P.ProperName "Eff")
64+ traceModule = P.ModuleName (P.ProperName "Trace")
65+ effMonad = P.Var (P.Qualified (Just effModule) (P.Ident "eff"))
66+ trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
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+ ])
71+ in
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
78+ Left err -> outputStrLn err
79+ Right (js, _, _) -> do
80+ output <- liftIO $ readProcess "nodejs" [] js
81+ outputStrLn output
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
112+
113+main :: IO ()
114+main = do
115+ preludeFilename <- getPreludeFilename
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+
148+