git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #208 from joneshf/psci-fixes
db58188Phil Freeman
Setup.hsnew file+25
compare with golang
unifiedsplit
@@ -0,0 +1,25 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Main where
4+
5+import Distribution.PackageDescription
6+import Distribution.Simple
7+import Distribution.Simple.LocalBuildInfo
8+import Distribution.Simple.Setup
9+
10+import System.Directory
11+import System.Environment.XDG.BaseDir
12+#if !defined(mingw32_HOST_OS) || !defined(__MINGW32__)
13+import System.Posix.Files
14+#endif
15+
16+main :: IO ()
17+main = defaultMainWithHooks $ simpleUserHooks {postInst = setupXDG}
18+
19+setupXDG :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
20+setupXDG _ _ _ _ = do
21+ configDir <- getUserConfigDir "purescript"
22+ createDirectoryIfMissing True configDir
23+#if !defined(mingw32_HOST_OS) || !defined(__MINGW32__)
24+ setFileMode configDir ownerModes
25+#endif
Setup.lhsdeleted−6
@@ -1,6 +0,0 @@
1−#!/usr/bin/runhaskell
2−> module Main where
3−> import Distribution.Simple
4−> main :: IO ()
5−> main = defaultMain
6−
psci/Commands.hsnew file+90
@@ -0,0 +1,90 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Main
4+-- Copyright : (c) Phil Freeman 2014
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- Commands for PSCI.
13+--
14+-----------------------------------------------------------------------------
15+
16+module Commands where
17+
18+import Control.Applicative
19+import System.Console.Haskeline
20+
21+-- |
22+-- Valid Meta-commands for PSCI
23+--
24+data Command
25+ -- |
26+ -- And empty line
27+ --
28+ = Empty
29+ -- |
30+ -- A purescript expression
31+ --
32+ | Expression [String]
33+ -- |
34+ -- Show the help command
35+ --
36+ | Help
37+ -- |
38+ -- Import a module from a loaded file
39+ --
40+ | Import String
41+ -- |
42+ -- Load a file for use with importing
43+ --
44+ | LoadFile FilePath
45+ -- |
46+ -- Exit PSCI
47+ --
48+ | Quit
49+ -- |
50+ -- Reload the current modules
51+ --
52+ | Reload
53+ -- |
54+ -- An attempt at a meta command that wasn't recognized.
55+ --
56+ | Unknown deriving (Show, Eq)
57+
58+-- |
59+-- Parses the input and returns either a Metacommand or an expression.
60+--
61+getCommand :: InputT IO Command
62+getCommand = do
63+ firstLine <- getInputLine "> "
64+ case firstLine of
65+ Nothing -> return Empty
66+ Just ":?" -> return Help
67+ Just (':':'i':' ':moduleName) -> return $ Import moduleName
68+ Just (':':'m':' ':filePath) -> return $ LoadFile filePath
69+ Just ":q" -> return Quit
70+ Just ":r" -> return Reload
71+ Just (':':_) -> return Unknown
72+ Just other -> Expression <$> go [other]
73+ where
74+ go ls = do
75+ l <- getInputLine " "
76+ case l of
77+ Nothing -> return $ reverse ls
78+ Just l' -> go (l' : ls)
79+
80+-- |
81+-- The help menu.
82+--
83+help :: [[String]]
84+help =
85+ [ [":? ", "Show this help menu"]
86+ , [":i <module>", "Import <module> for use in PSCI"]
87+ , [":m <file> ", "Load <file> for importing"]
88+ , [":q ", "Quit PSCi"]
89+ , [":r ", "Reload all modules."]
90+ ]
psci/Main.hs+192−76
@@ -9,6 +9,7 @@
9-- Portability :
9-- Portability :
10--
10--
11-- |
11-- |
12+-- PureScript Compiler Interactive.
12--
13--
13-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
14
15
@@ -16,31 +17,143 @@
16
17
17module Main where
18module Main where
18
19
20+import Commands
21+
19import Control.Applicative
22import Control.Applicative
20import Control.Monad
23import Control.Monad
21import Control.Monad.Trans.Class
24import Control.Monad.Trans.Class
22import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26+import Control.Monad.Trans.State
23
27
24−import Data.List (nub, isPrefixOf)
28+import Data.List (intercalate, isPrefixOf, nub, sort)
25import Data.Maybe (mapMaybe)
29import Data.Maybe (mapMaybe)
26import Data.Traversable (traverse)
30import Data.Traversable (traverse)
27
31
28import System.Console.Haskeline
32import System.Console.Haskeline
29import System.Directory (findExecutable)
33import System.Directory (findExecutable)
30import System.Exit
34import System.Exit
35+import System.Environment.XDG.BaseDir
31import System.Process
36import System.Process
32
37
33import qualified Language.PureScript as P
38import qualified Language.PureScript as P
34import qualified Paths_purescript as Paths
39import qualified Paths_purescript as Paths
35import qualified System.IO.UTF8 as U (readFile)
40import qualified System.IO.UTF8 as U (readFile)
36−import qualified Text.Parsec as Parsec (eof)
41+import qualified Text.Parsec as Parsec (Parsec, eof)
42+
43+-- |
44+-- The PSCI state.
45+-- Holds a list of imported modules, loaded files, and partial let bindings.
46+-- The let bindings are partial,
47+-- because it makes more sense to apply the binding to the final evaluated expression.
48+--
49+data PSCI = PSCI [P.ProperName] [P.Module] [P.Value -> P.Value]
50+
51+-- State helpers
52+
53+-- |
54+-- Synonym to be more descriptive.
55+-- This is just @lift@
56+--
57+inputTToState :: InputT IO a -> StateT PSCI (InputT IO) a
58+inputTToState = lift
59+
60+-- |
61+-- Synonym to be more descriptive.
62+-- This is just @lift . lift@
63+--
64+ioToState :: IO a -> StateT PSCI (InputT IO) a
65+ioToState = lift . lift
66+
67+-- |
68+-- Updates the state to have more imported modules.
69+--
70+updateImports :: String -> PSCI -> PSCI
71+updateImports name (PSCI i m b) = PSCI (i ++ [P.ProperName name]) m b
72+
73+-- |
74+-- Updates the state to have more loaded files.
75+--
76+updateModules :: [P.Module] -> PSCI -> PSCI
77+updateModules modules (PSCI i m b) = PSCI i (m ++ modules) b
78+
79+-- |
80+-- Updates the state to have more let bindings.
81+--
82+updateLets :: (P.Value -> P.Value) -> PSCI -> PSCI
83+updateLets name (PSCI i m b) = PSCI i m (b ++ [name])
84+
85+-- File helpers
86+-- |
87+-- Load the necessary modules.
88+--
89+defaultImports :: [P.ProperName]
90+defaultImports = [P.ProperName "Prelude"]
91+
92+-- |
93+-- Locates the node executable.
94+-- Checks for either @nodejs@ or @node@.
95+--
96+findNodeProcess :: IO (Maybe String)
97+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
98+ where names = ["nodejs", "node"]
99+
100+-- |
101+-- Grabs the filename where the history is stored.
102+--
103+getHistoryFilename :: IO FilePath
104+getHistoryFilename = getUserConfigFile "purescript" "psci_history"
37
105
106+-- |
107+-- Grabs the filename where prelude is.
108+--
38getPreludeFilename :: IO FilePath
109getPreludeFilename :: IO FilePath
39getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
110getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
40
111
41−options :: P.Options
112+-- |
42−options = P.Options True False True (Just "Main") True "PS" []
113+-- Loads a file for use with imports.
114+--
115+loadModule :: FilePath -> IO (Either String [P.Module])
116+loadModule moduleFile = do
117+ moduleText <- U.readFile moduleFile
118+ return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
43
119
120+-- Messages
121+
122+-- |
123+-- The help message.
124+--
125+helpMessage :: String
126+helpMessage = "The following commands are available:\n\n " ++
127+ intercalate "\n " (map (intercalate " ") help)
128+
129+-- |
130+-- The welcome prologue.
131+--
132+prologueMessage :: String
133+prologueMessage = intercalate "\n"
134+ [ " ____ ____ _ _ "
135+ , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
136+ , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
137+ , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
138+ , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
139+ , " |_| "
140+ , ""
141+ , ":? shows help"
142+ , ""
143+ , "Expressions are terminated using Ctrl+D"
144+ ]
145+
146+-- |
147+-- The quit message.
148+--
149+quitMessage :: String
150+quitMessage = "See ya!"
151+
152+-- Haskeline completions
153+
154+-- |
155+-- Loads module, function, and file completions.
156+--
44completion :: [P.Module] -> CompletionFunc IO
157completion :: [P.Module] -> CompletionFunc IO
45completion ms = completeWord Nothing " \t\n\r" findCompletions
158completion ms = completeWord Nothing " \t\n\r" findCompletions
46 where
159 where
@@ -53,29 +166,40 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
53 , qual <- [ P.Qualified Nothing ident
166 , qual <- [ P.Qualified Nothing ident
54 , P.Qualified (Just moduleName) ident]
167 , P.Qualified (Just moduleName) ident]
55 ]
168 ]
56− let matches = filter (isPrefixOf str) names
169+ let matches = sort $ filter (isPrefixOf str) names
57 return $ map simpleCompletion matches ++ files
170 return $ map simpleCompletion matches ++ files
58 getDeclName :: P.Declaration -> Maybe P.Ident
171 getDeclName :: P.Declaration -> Maybe P.Ident
59 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
172 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
60 getDeclName _ = Nothing
173 getDeclName _ = Nothing
61
174
175+-- Compilation
176+
177+-- | Compilation options.
178+--
179+options :: P.Options
180+options = P.Options True False True (Just "Main") True "PS" []
181+
182+-- |
183+-- Makes a volatile module to execute the current expression.
184+--
62−createTemporaryModule :: [P.ProperName] -> P.Value -> P.Module
185+createTemporaryModule :: [P.ProperName] -> [P.Value -> P.Value] -> P.Value -> P.Module
63−createTemporaryModule imports value =
186+createTemporaryModule imports lets value =
64 let
187 let
65 moduleName = P.ModuleName [P.ProperName "Main"]
188 moduleName = P.ModuleName [P.ProperName "Main"]
66 importDecl m = P.ImportDeclaration m Nothing
189 importDecl m = P.ImportDeclaration m Nothing
67 traceModule = P.ModuleName [P.ProperName "Trace"]
190 traceModule = P.ModuleName [P.ProperName "Trace"]
68 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
191 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
192+ value' = foldr ($) value lets
69− mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing
193+ mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing (P.App trace value')
70− (P.Do [ P.DoNotationBind (P.VarBinder (P.Ident "it")) value
71− , P.DoNotationValue (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))) )
72− ])
73 in
194 in
74 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
195 P.Module moduleName $ map (importDecl . P.ModuleName . return) imports ++ [mainDecl]
75
196
197+-- |
198+-- Takes a value declaration and evaluates it with the current state.
199+--
76−handleDeclaration :: [P.Module] -> [P.ProperName] -> P.Value -> InputT IO ()
200+handleDeclaration :: P.Value -> PSCI -> InputT IO ()
77−handleDeclaration loadedModules imports value = do
201+handleDeclaration value (PSCI imports loadedModules lets) = do
78− let m = createTemporaryModule imports value
202+ let m = createTemporaryModule imports lets value
79 case P.compile options (loadedModules ++ [m]) of
203 case P.compile options (loadedModules ++ [m]) of
80 Left err -> outputStrLn err
204 Left err -> outputStrLn err
81 Right (js, _, _) -> do
205 Right (js, _, _) -> do
@@ -86,73 +210,65 @@ handleDeclaration loadedModules imports value = do
86 Just (ExitFailure _, _, err) -> outputStrLn err
210 Just (ExitFailure _, _, err) -> outputStrLn err
87 Nothing -> outputStrLn "Couldn't find node.js"
211 Nothing -> outputStrLn "Couldn't find node.js"
88
212
89−data Command
213+-- Parser helpers
90− = Empty
91− | Expression [String]
92− | Import String
93− | LoadModule FilePath
94− | Reload deriving (Show, Eq)
95−
96−getCommand :: InputT IO Command
97−getCommand = do
98− firstLine <- getInputLine "> "
99− case firstLine of
100− Nothing -> return Empty
101− Just (':':'i':' ':moduleName) -> return $ Import moduleName
102− Just (':':'m':' ':modulePath) -> return $ LoadModule modulePath
103− Just ":r" -> return Reload
104− Just (':':_) -> outputStrLn "Unknown command" >> getCommand
105− Just other -> Expression <$> go [other]
106− where
107− go ls = do
108− l <- getInputLine " "
109− case l of
110− Nothing -> return $ reverse ls
111− Just l' -> go (l' : ls)
112
214
113−loadModule :: FilePath -> IO (Either String [P.Module])
215+-- |
114−loadModule moduleFile = do
216+-- Parser for our PSCI version of @let@.
115− print moduleFile
217+-- This is essentially let from do-notation.
116− moduleText <- U.readFile moduleFile
218+-- However, since we don't support the @Eff@ monad, we actually want the normal @let@.
117− return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText
219+--
220+parseLet :: Parsec.Parsec String P.ParseState (P.Value -> P.Value)
221+parseLet = P.Let <$> (P.reserved "let" *> P.indented *> P.parseBinder)
222+ <*> (P.indented *> P.reservedOp "=" *> P.parseValue)
118
223
119−findNodeProcess :: IO (Maybe String)
224+-- |
120−findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
225+-- Parser for any other valid expression.
121− where names = ["nodejs", "node"]
226+--
227+parseExpression :: Parsec.Parsec String P.ParseState P.Value
228+parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof
229+
230+-- Commands
231+
232+-- |
233+-- Performs an action for each meta-command given, and also for expressions..
234+--
235+handleCommand :: Command -> StateT PSCI (InputT IO) ()
236+handleCommand Empty = return ()
237+handleCommand (Expression ls) =
238+ case P.runIndentParser "" parseLet (unlines ls) of
239+ Left _ ->
240+ case P.runIndentParser "" parseExpression (unlines ls) of
241+ Left err -> inputTToState $ outputStrLn (show err)
242+ Right decl -> get >>= inputTToState . handleDeclaration decl
243+ Right l -> modify (updateLets l)
244+handleCommand Help = inputTToState $ outputStrLn helpMessage
245+handleCommand (Import moduleName) = modify (updateImports moduleName)
246+handleCommand (LoadFile filePath) = do
247+ mf <- ioToState $ loadModule filePath
248+ case mf of
249+ Left err -> inputTToState $ outputStrLn err
250+ Right mf' -> modify (updateModules mf')
251+handleCommand Reload = do
252+ (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule
253+ put (PSCI defaultImports prelude [])
254+handleCommand Unknown = inputTToState $ outputStrLn "Unknown command"
122
255
256+-- |
257+-- The PSCI main loop.
258+--
123main :: IO ()
259main :: IO ()
124main = do
260main = do
125 preludeFilename <- getPreludeFilename
261 preludeFilename <- getPreludeFilename
126 (Right prelude) <- loadModule preludeFilename
262 (Right prelude) <- loadModule preludeFilename
263+ historyFilename <- getHistoryFilename
264+ let settings = defaultSettings {historyFile = Just historyFilename}
127− runInputT (setComplete (completion prelude) defaultSettings) $ do
265+ runInputT (setComplete (completion prelude) settings) $ do
128− outputStrLn " ____ ____ _ _ "
266+ outputStrLn prologueMessage
129− outputStrLn "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
267+ evalStateT go (PSCI defaultImports prelude [])
130− outputStrLn "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
131− outputStrLn "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
132− outputStrLn "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
133− outputStrLn " |_| "
134− outputStrLn ""
135− outputStrLn "Expressions are terminated using Ctrl+D"
136− go [P.ProperName "Prelude", P.ProperName "Eff"] prelude
137 where
268 where
138− go imports loadedModules = do
269+ go :: StateT PSCI (InputT IO) ()
270+ go = do
139− cmd <- getCommand
271+ c <- inputTToState getCommand
140− case cmd of
272+ case c of
141− Empty -> go imports loadedModules
273+ Quit -> inputTToState $ outputStrLn quitMessage
142− Expression ls -> do
274+ _ -> handleCommand c >> go
143− case P.runIndentParser "" (P.whiteSpace *> P.parseValue <* Parsec.eof) (unlines ls) of
144− Left err -> outputStrLn (show err)
145− Right decl -> handleDeclaration loadedModules imports decl
146− go imports loadedModules
147− Import moduleName -> go (imports ++ [P.ProperName moduleName]) loadedModules
148− LoadModule moduleFile -> do
149− ms <- lift $ loadModule moduleFile
150− case ms of
151− Left err -> outputStrLn err
152− Right ms' -> go imports (loadedModules ++ ms')
153− Reload -> do
154− preludeFilename <- lift getPreludeFilename
155− (Right prelude) <- lift $ loadModule preludeFilename
156− go [P.ProperName "Prelude"] prelude
157−
158−
purescript.cabal+5−3
@@ -1,7 +1,7 @@
1name: purescript
1name: purescript
2version: 0.4.1
2version: 0.4.1
3cabal-version: >=1.8
3cabal-version: >=1.8
4−build-type: Simple
4+build-type: Custom
5license: MIT
5license: MIT
6license-file: LICENSE
6license-file: LICENSE
7copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
7copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
@@ -17,7 +17,8 @@ data-dir: ""
17library
17library
18 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
18 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
19 directory -any, filepath -any, mtl -any, parsec -any, syb -any,
19 directory -any, filepath -any, mtl -any, parsec -any, syb -any,
20− transformers -any, utf8-string -any, pattern-arrows -any, monad-unify >= 0.2 && < 0.3
20+ transformers -any, utf8-string -any, pattern-arrows -any, monad-unify >= 0.2 && < 0.3,
21+ xdg-basedir -any, unix -any
21 exposed-modules: Data.Generics.Extras
22 exposed-modules: Data.Generics.Extras
22 Language.PureScript
23 Language.PureScript
23 Language.PureScript.Options
24 Language.PureScript.Options
@@ -80,7 +81,8 @@ executable psc
80executable psci
81executable psci
81 build-depends: base >=4 && <5, containers -any, directory -any,
82 build-depends: base >=4 && <5, containers -any, directory -any,
82 mtl -any, parsec -any, haskeline <=0.7.1.1, purescript -any,
83 mtl -any, parsec -any, haskeline <=0.7.1.1, purescript -any,
83− syb -any, transformers -any, utf8-string -any, process -any
84+ syb -any, transformers -any, utf8-string -any, process -any,
85+ xdg-basedir -any
84 main-is: Main.hs
86 main-is: Main.hs
85 buildable: True
87 buildable: True
86 hs-source-dirs: psci
88 hs-source-dirs: psci