git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge branch '0.9' into pure11-0.9
20dbda1Andy Arvanitis
appveyor.yml+1−3
compare with golang
unifiedsplit
@@ -3,12 +3,10 @@ version: '{build}'
3environment:
3environment:
4 # Keep the path as short as possible, just in case.
4 # Keep the path as short as possible, just in case.
5 STACK_ROOT: c:\s
5 STACK_ROOT: c:\s
6− # Appveyor does not seem to be able to cope with the symbolic link
7− # stack.yaml, so this is a workaround.
8 RELEASE_USER: purescript
6 RELEASE_USER: purescript
9 RELEASE_REPO: purescript
7 RELEASE_REPO: purescript
10cache:
8cache:
11−- c:\s
9+- c:\s -> appveyor/cache-buster.txt
12install:
10install:
13- git submodule update --init
11- git submodule update --init
14- ps: Install-Product node 5
12- ps: Install-Product node 5
appveyor/cache-buster.txtnew file+8
@@ -0,0 +1,8 @@
1+This file acts as a cache buster for the AppVeyor (Windows CI) build
2+cache. In order to invalidate the AppVeyor build cache, simply make a
3+change to the number at the end of this file and commit.
4+
5+See http://www.appveyor.com/docs/build-cache#cache-dependencies for more
6+information.
7+
8+Increment me to invalidate the cache: 0
examples/passing/ExportedInstanceDeclarations.purs+45−44
@@ -1,44 +1,45 @@
1−-- Tests that instances for non-exported classes / types do not appear in the
1+-- Tests that instances for non-exported classes / types do not appear in the
2−-- result of `exportedDeclarations`.
2+-- result of `exportedDeclarations`.
3−module ExportedInstanceDeclarations
3+module Main
4− ( Const(..)
4+ ( Const(..)
5− , class Foo
5+ , class Foo
6− , foo
6+ , foo
7+ , main
7− ) where
8+ ) where
8−
9+
9−import Prelude
10+import Prelude
10−import Control.Monad.Eff.Console (log)
11+import Control.Monad.Eff.Console (log)
11−
12+
12−data Const a b = Const a
13+data Const a b = Const a
13−
14+
14−class Foo a where
15+class Foo a where
15− foo :: a
16+ foo :: a
16−
17+
17−data NonexportedType = NonexportedType
18+data NonexportedType = NonexportedType
18−
19+
19−class NonexportedClass a where
20+class NonexportedClass a where
20− notExported :: a
21+ notExported :: a
21−
22+
22−-- There are three places that a nonexported type or type class can occur,
23+-- There are three places that a nonexported type or type class can occur,
23−-- leading an instance to count as non-exported:
24+-- leading an instance to count as non-exported:
24−-- * Constraints
25+-- * Constraints
25−-- * The type class itself
26+-- * The type class itself
26−-- * The instance types
27+-- * The instance types
27−
28+
28−-- Case 1: constraints
29+-- Case 1: constraints
29−instance nonExportedFoo :: (NonexportedClass a) => Foo a where
30+instance nonExportedFoo :: (NonexportedClass a) => Foo a where
30− foo = notExported
31+ foo = notExported
31−
32+
32−-- Another instance of case 1:
33+-- Another instance of case 1:
33−instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
34+instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
34− foo = id
35+ foo = id
35−
36+
36−-- Case 2: type class
37+-- Case 2: type class
37−instance nonExportedNonexportedType :: NonexportedClass (Const Int a) where
38+instance nonExportedNonexportedType :: NonexportedClass (Const Int a) where
38− notExported = Const 0
39+ notExported = Const 0
39−
40+
40−-- Case 3: instance types
41+-- Case 3: instance types
41−instance constFoo :: Foo (Const NonexportedType b) where
42+instance constFoo :: Foo (Const NonexportedType b) where
42− foo = Const NonexportedType
43+ foo = Const NonexportedType
43−
44+
44−main = log "Done"
45+main = log "Done"
examples/passing/NumberLiterals.pursnew file+39
@@ -0,0 +1,39 @@
1+module Main where
2+
3+-- See issue #2115.
4+
5+import Prelude
6+import Test.Assert (assert')
7+import Control.Monad.Eff.Console (log)
8+
9+main = do
10+ test "0.17" 0.17
11+ test "0.25996181067141905" 0.25996181067141905
12+ test "0.3572019862807257" 0.3572019862807257
13+ test "0.46817723004874223" 0.46817723004874223
14+ test "0.9640035681058178" 0.9640035681058178
15+ test "4.23808622486133" 4.23808622486133
16+ test "4.540362294799751" 4.540362294799751
17+ test "5.212384849884261" 5.212384849884261
18+ test "13.958257048123212" 13.958257048123212
19+ test "32.96176575630599" 32.96176575630599
20+ test "38.47735512322269" 38.47735512322269
21+
22+ test "10000000000" 1e10
23+ test "10000000000" 1.0e10
24+ test "0.00001" 1e-5
25+ test "0.00001" 1.0e-5
26+ test "1.5339794352098402e-118" 1.5339794352098402e-118
27+ test "2.108934760892056e-59" 2.108934760892056e-59
28+ test "2.250634744599241e-19" 2.250634744599241e-19
29+ test "5.960464477539063e-8" 5.960464477539063e-8
30+ test "5e-324" 5e-324
31+ test "5e-324" 5.0e-324
32+
33+ log "Done"
34+
35+test str num =
36+ if (show num == str)
37+ then pure unit
38+ else flip assert' false $
39+ "Expected " <> show str <> ", got " <> show (show num) <> "."
examples/passing/ParensInTypedBinder.pursnew file+20
@@ -0,0 +1,20 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff (Eff)
5+import Control.Monad.Eff.Console (CONSOLE, log)
6+
7+foo :: Array Int
8+foo = do
9+ xss :: Array (Array Int) <- [[[1,2,3], [4, 5]], [[6]]]
10+ xs :: Array Int <- xss
11+ xs
12+
13+main ::
14+ forall eff.
15+ Eff
16+ ( console :: CONSOLE
17+ | eff
18+ )
19+ Unit
20+main = log "Done"
psc-ide-server/Main.hs+15−22
@@ -72,12 +72,13 @@ data Options = Options
72 { optionsDirectory :: Maybe FilePath
72 { optionsDirectory :: Maybe FilePath
73 , optionsOutputPath :: FilePath
73 , optionsOutputPath :: FilePath
74 , optionsPort :: PortID
74 , optionsPort :: PortID
75+ , optionsNoWatch :: Bool
75 , optionsDebug :: Bool
76 , optionsDebug :: Bool
76 }
77 }
77
78
78main :: IO ()
79main :: IO ()
79main = do
80main = do
80− Options dir outputPath port debug <- execParser opts
81+ Options dir outputPath port noWatch debug <- execParser opts
81 maybe (pure ()) setCurrentDirectory dir
82 maybe (pure ()) setCurrentDirectory dir
82 serverState <- newTVarIO emptyPscIdeState
83 serverState <- newTVarIO emptyPscIdeState
83 cwd <- getCurrentDirectory
84 cwd <- getCurrentDirectory
@@ -88,31 +89,23 @@ main = do
88 (do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)
89 (do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)
89 createDirectory fullOutputPath
90 createDirectory fullOutputPath
90 putStrLn "This usually means you didn't compile your project yet."
91 putStrLn "This usually means you didn't compile your project yet."
91− putStrLn "psc-ide needs you to compile your project (for example by running pulp build)"
92+ putStrLn "psc-ide needs you to compile your project (for example by running pulp build)")
92− )
93
93
94+ unless noWatch $
94− _ <- forkFinally (watcher serverState fullOutputPath) print
95+ void (forkFinally (watcher serverState fullOutputPath) print)
95− let conf =
96+
96− Configuration
97− {
98− confDebug = debug
99− , confOutputPath = outputPath
97+ let conf = Configuration {confDebug = debug, confOutputPath = outputPath}
100− }
101− let env =
102− PscIdeEnvironment
103− {
104− envStateVar = serverState
98+ env = PscIdeEnvironment {envStateVar = serverState, envConfiguration = conf}
105− , envConfiguration = conf
106− }
107 startServer port env
99 startServer port env
108 where
100 where
109 parser =
101 parser =
110− Options <$>
102+ Options
111− optional (strOption (long "directory" <> short 'd')) <*>
103+ <$> optional (strOption (long "directory" <> short 'd'))
112− strOption (long "output-directory" <> value "output/") <*>
104+ <*> strOption (long "output-directory" <> value "output/")
113− (PortNumber . fromIntegral <$>
105+ <*> (PortNumber . fromIntegral <$>
114− option auto (long "port" <> short 'p' <> value (4242 :: Integer))) <*>
106+ option auto (long "port" <> short 'p' <> value (4242 :: Integer)))
107+ <*> switch (long "no-watch")
115− switch (long "debug")
108+ <*> switch (long "debug")
116 opts = info (version <*> helper <*> parser) mempty
109 opts = info (version <*> helper <*> parser) mempty
117 version = abortOption
110 version = abortOption
118 (InfoMsg (showVersion Paths.version))
111 (InfoMsg (showVersion Paths.version))
psc-ide-server/PROTOCOL.md+4−2
@@ -407,14 +407,16 @@ Hiding Import(`import Data.Array hiding (filter, filterM, join)`):
407 }
407 }
408]
408]
409```
409```
410−### Cwd/Quit
410+### Cwd/Quit/Reset
411`cwd` returns the working directory of the server(should be your project root).
411`cwd` returns the working directory of the server(should be your project root).
412
412
413`quit` quits the server.
413`quit` quits the server.
414
414
415+`reset` resets all loaded modules.
416+
415```json
417```json
416{
418{
417− "command": "cwd|quit"
419+ "command": "cwd|quit|reset"
418}
420}
419```
421```
420
422
psc-ide-server/README.md+1
@@ -20,6 +20,7 @@ It supports the following options:
20 project directory. Defaults to `output/`, relative to either the current
20 project directory. Defaults to `output/`, relative to either the current
21 directory or the directory specified by `-d`.
21 directory or the directory specified by `-d`.
22- `--debug`: Enables some logging meant for debugging
22- `--debug`: Enables some logging meant for debugging
23+- `--no-watch`: Disables the filewatcher
23- `--version`: Output psc-ide version
24- `--version`: Output psc-ide version
24
25
25## Issuing queries
26## Issuing queries
psci/Main.hsnew file+144
@@ -0,0 +1,144 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DoAndIfThenElse #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE ScopedTypeVariables #-}
7+{-# LANGUAGE TupleSections #-}
8+
9+module Main (main) where
10+
11+import Prelude ()
12+import Prelude.Compat
13+
14+import Data.Monoid ((<>))
15+import Data.Version (showVersion)
16+
17+import Control.Applicative (many)
18+import Control.Monad
19+import Control.Monad.IO.Class (liftIO)
20+import Control.Monad.Trans.Class
21+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
22+import Control.Monad.Trans.State.Strict (StateT, evalStateT)
23+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
24+
25+import qualified Language.PureScript as P
26+import Language.PureScript.Interactive
27+
28+import qualified Options.Applicative as Opts
29+
30+import qualified Paths_purescript as Paths
31+
32+import System.Console.Haskeline
33+import System.Exit
34+import System.FilePath.Glob (glob)
35+
36+-- | Command line options
37+data PSCiOptions = PSCiOptions
38+ { psciMultiLineMode :: Bool
39+ , psciInputFile :: [FilePath]
40+ , psciForeignInputFiles :: [FilePath]
41+ , psciInputNodeFlags :: [String]
42+ }
43+
44+multiLineMode :: Opts.Parser Bool
45+multiLineMode = Opts.switch $
46+ Opts.long "multi-line-mode"
47+ <> Opts.short 'm'
48+ <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
49+
50+inputFile :: Opts.Parser FilePath
51+inputFile = Opts.strArgument $
52+ Opts.metavar "FILE"
53+ <> Opts.help "Optional .purs files to load on start"
54+
55+inputForeignFile :: Opts.Parser FilePath
56+inputForeignFile = Opts.strOption $
57+ Opts.short 'f'
58+ <> Opts.long "ffi"
59+ <> Opts.help "The input .js file(s) providing foreign import implementations"
60+
61+nodeFlagsFlag :: Opts.Parser [String]
62+nodeFlagsFlag = Opts.option parser $
63+ Opts.long "node-opts"
64+ <> Opts.metavar "NODE_OPTS"
65+ <> Opts.value []
66+ <> Opts.help "Flags to pass to node, separated by spaces"
67+ where
68+ parser = words <$> Opts.str
69+
70+psciOptions :: Opts.Parser PSCiOptions
71+psciOptions = PSCiOptions <$> multiLineMode
72+ <*> many inputFile
73+ <*> many inputForeignFile
74+ <*> nodeFlagsFlag
75+
76+version :: Opts.Parser (a -> a)
77+version = Opts.abortOption (Opts.InfoMsg (showVersion Paths.version)) $
78+ Opts.long "version" <>
79+ Opts.help "Show the version number" <>
80+ Opts.hidden
81+
82+getOpt :: IO PSCiOptions
83+getOpt = Opts.execParser opts
84+ where
85+ opts = Opts.info (version <*> Opts.helper <*> psciOptions) infoModList
86+ infoModList = Opts.fullDesc <> headerInfo <> footerInfo
87+ headerInfo = Opts.header "psci - Interactive mode for PureScript"
88+ footerInfo = Opts.footer $ "psci " ++ showVersion Paths.version
89+
90+-- | Parses the input and returns either a command, or an error as a 'String'.
91+getCommand :: forall m. MonadException m => Bool -> InputT m (Either String (Maybe Command))
92+getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
93+ firstLine <- withInterrupt $ getInputLine "> "
94+ case firstLine of
95+ Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
96+ Just "" -> return (Right Nothing)
97+ Just s | singleLineMode || head s == ':' -> return . fmap Just $ parseCommand s
98+ Just s -> fmap Just . parseCommand <$> go [s]
99+ where
100+ go :: [String] -> InputT m String
101+ go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
102+
103+-- | Get command line options and drop into the REPL
104+main :: IO ()
105+main = getOpt >>= loop
106+ where
107+ loop :: PSCiOptions -> IO ()
108+ loop PSCiOptions{..} = do
109+ inputFiles <- concat <$> traverse glob psciInputFile
110+ foreignFiles <- concat <$> traverse glob psciForeignInputFiles
111+ e <- runExceptT $ do
112+ modules <- ExceptT (loadAllModules inputFiles)
113+ unless (supportModuleIsDefined (map snd modules)) . liftIO $ do
114+ putStrLn supportModuleMessage
115+ exitFailure
116+ foreigns <- ExceptT . runMake $ do
117+ foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> P.readTextFile inFile)
118+ P.parseForeignModulesFromFiles foreignFilesContent
119+ (externs, env) <- ExceptT . runMake . make foreigns . map snd $ modules
120+ return (modules, foreigns, externs, env)
121+ case e of
122+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
123+ Right (modules, foreigns, externs, env) -> do
124+ historyFilename <- getHistoryFilename
125+ let settings = defaultSettings { historyFile = Just historyFilename }
126+ initialState = PSCiState [] [] (zip (map snd modules) externs)
127+ config = PSCiConfig inputFiles foreigns psciInputNodeFlags env
128+ runner = flip runReaderT config
129+ . flip evalStateT initialState
130+ . runInputT (setComplete completion settings)
131+ putStrLn prologueMessage
132+ runner go
133+ where
134+ go :: InputT (StateT PSCiState (ReaderT PSCiConfig IO)) ()
135+ go = do
136+ c <- getCommand (not psciMultiLineMode)
137+ case c of
138+ Left err -> outputStrLn err >> go
139+ Right Nothing -> go
140+ Right (Just QuitPSCi) -> outputStrLn quitMessage
141+ Right (Just c') -> do
142+ handleInterrupt (outputStrLn "Interrupted.")
143+ (withInterrupt (lift (handleCommand c')))
144+ go
psci/PSCi.hsdeleted−374
@@ -1,374 +0,0 @@
1−{-# LANGUAGE DoAndIfThenElse #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE RecordWildCards #-}
4−{-# LANGUAGE TupleSections #-}
5−{-# LANGUAGE DataKinds #-}
6−
7−-- |
8−-- PureScript Compiler Interactive.
9−--
10−module PSCi (runPSCi) where
11−
12−import Prelude ()
13−import Prelude.Compat
14−
15−import Data.Foldable (traverse_)
16−import Data.List (intercalate, nub, sort, find, foldl')
17−import Data.Tuple (swap)
18−import qualified Data.Map as M
19−
20−import Control.Arrow (first)
21−import Control.Monad
22−import Control.Monad.Error.Class (MonadError(..))
23−import Control.Monad.Trans.Class
24−import Control.Monad.Trans.Except (ExceptT(), runExceptT)
25−import Control.Monad.Trans.State.Strict
26−import Control.Monad.IO.Class (liftIO)
27−import Control.Monad.Writer.Strict (Writer(), runWriter)
28−
29−import System.Console.Haskeline
30−import System.Directory (doesFileExist, getHomeDirectory, getCurrentDirectory)
31−import System.Exit
32−import System.FilePath ((</>))
33−import System.FilePath.Glob (glob)
34−import System.Process (readProcessWithExitCode)
35−import System.IO.Error (tryIOError)
36−import System.IO.UTF8 (readUTF8File)
37−
38−import qualified Language.PureScript as P
39−import qualified Language.PureScript.Names as N
40−
41−import PSCi.Completion (completion)
42−import PSCi.Parser (parseCommand)
43−import PSCi.Option
44−import PSCi.Types
45−import PSCi.Message
46−import PSCi.IO
47−import PSCi.Printer
48−import PSCi.Module
49−
50−-- |
51−-- PSCI monad
52−--
53−newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
54−
55−psciIO :: IO a -> PSCI a
56−psciIO io = PSCI . lift $ lift io
57−
58−-- |
59−-- The runner
60−--
61−runPSCi :: IO ()
62−runPSCi = getOpt >>= loop
63−
64−-- |
65−-- The PSCI main loop.
66−--
67−loop :: PSCiOptions -> IO ()
68−loop PSCiOptions{..} = do
69− config <- loadUserConfig
70− inputFiles <- concat <$> traverse glob psciInputFile
71− foreignFiles <- concat <$> traverse glob psciForeignInputFiles
72− modulesOrFirstError <- loadAllModules inputFiles
73− case modulesOrFirstError of
74− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
75− Right modules -> do
76− historyFilename <- getHistoryFilename
77− let settings = defaultSettings { historyFile = Just historyFilename }
78− foreignsOrError <- runMake $ do
79− foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.ErrorMessage [] $ P.CannotReadFile inFile)) (readUTF8File inFile))
80− P.parseForeignModulesFromFiles foreignFilesContent
81− case foreignsOrError of
82− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
83− Right foreigns ->
84− flip evalStateT (mkPSCiState [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
85− outputStrLn prologueMessage
86− traverse_ (traverse_ (runPSCI . handleCommand)) config
87− modules' <- lift $ gets psciLoadedModules
88− unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines
89− [ "PSCi requires the purescript-console module to be installed."
90− , "For help getting started, visit http://wiki.purescript.org/PSCi"
91− ]
92− go
93− where
94− go :: InputT (StateT PSCiState IO) ()
95− go = do
96− c <- getCommand (not psciMultiLineMode)
97− case c of
98− Left err -> outputStrLn err >> go
99− Right Nothing -> go
100− Right (Just QuitPSCi) -> outputStrLn quitMessage
101− Right (Just c') -> do
102− handleInterrupt (outputStrLn "Interrupted.")
103− (withInterrupt (runPSCI (loadAllImportedModules >> handleCommand c')))
104− go
105−
106−-- Compile the module
107−
108−-- |
109−-- Load all modules, updating the application state
110−--
111−loadAllImportedModules :: PSCI ()
112−loadAllImportedModules = do
113− files <- PSCI . lift $ fmap psciImportedFilenames get
114− modulesOrFirstError <- psciIO $ loadAllModules files
115− case modulesOrFirstError of
116− Left errs -> PSCI $ printErrors errs
117− Right modules -> PSCI . lift . modify $ updateModules modules
118−
119−-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
120−-- options and ignores the warning messages.
121−runMake :: P.Make a -> IO (Either P.MultipleErrors a)
122−runMake mk = fst <$> P.runMake P.defaultOptions mk
123−
124−makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a
125−makeIO f io = do
126− e <- liftIO $ tryIOError io
127− either (throwError . P.singleError . f) return e
128−
129−make :: PSCiState -> [P.Module] -> P.Make P.Environment
130−make st@PSCiState{..} ms = do
131− externs <- P.make actions' (map snd loadedModules ++ ms)
132− return $ foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs
133− where
134− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules
135− actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
136− actions' = actions { P.progress = const (return ()) }
137− loadedModules = psciLoadedModules st
138− allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms
139−
140−
141−-- Commands
142−
143−-- |
144−-- Parses the input and returns either a Metacommand, or an error as a string.
145−--
146−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
147−getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
148− firstLine <- withInterrupt $ getInputLine "> "
149− case firstLine of
150− Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
151− Just "" -> return (Right Nothing)
152− Just s | singleLineMode || head s == ':' -> return .fmap Just $ parseCommand s
153− Just s -> fmap Just . parseCommand <$> go [s]
154− where
155− go :: [String] -> InputT (StateT PSCiState IO) String
156− go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
157−
158−-- |
159−-- Performs an action for each meta-command given, and also for expressions.
160−--
161−handleCommand :: Command -> PSCI ()
162−handleCommand (Expression val) = handleExpression val
163−handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
164−handleCommand (Import im) = handleImport im
165−handleCommand (Decls l) = handleDecls l
166−handleCommand (LoadFile filePath) = PSCI $ whenFileExists filePath $ \absPath -> do
167− m <- lift . lift $ loadModule absPath
168− case m of
169− Left err -> outputStrLn err
170− Right mods -> lift $ modify (updateModules (map (absPath,) mods))
171−handleCommand (LoadForeign filePath) = PSCI $ whenFileExists filePath $ \absPath -> do
172− foreignsOrError <- lift . lift . runMake $ do
173− foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readUTF8File absPath)
174− P.parseForeignModulesFromFiles [(absPath, foreignFile)]
175− case foreignsOrError of
176− Left err -> outputStrLn $ P.prettyPrintMultipleErrors False err
177− Right foreigns -> lift $ modify (updateForeignFiles foreigns)
178−handleCommand ResetState = do
179− PSCI . lift . modify $ \st ->
180− st { psciImportedModules = []
181− , psciLetBindings = []
182− }
183− loadAllImportedModules
184−handleCommand (TypeOf val) = handleTypeOf val
185−handleCommand (KindOf typ) = handleKindOf typ
186−handleCommand (BrowseModule moduleName) = handleBrowse moduleName
187−handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
188−handleCommand (ShowInfo QueryImport) = handleShowImportedModules
189−handleCommand QuitPSCi = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
190−
191−
192−-- |
193−-- Takes a value expression and evaluates it with the current state.
194−--
195−handleExpression :: P.Expr -> PSCI ()
196−handleExpression val = do
197− st <- PSCI $ lift get
198− let m = createTemporaryModule True st val
199− let nodeArgs = psciNodeFlags st ++ [indexFile]
200− e <- psciIO . runMake $ make st [supportModule, m]
201− case e of
202− Left errs -> PSCI $ printErrors errs
203− Right _ -> do
204− psciIO $ writeFile indexFile "require('$PSCI')['$main']();"
205− process <- psciIO findNodeProcess
206− result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
207− case result of
208− Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
209− Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
210− Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
211−
212−-- |
213−-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
214−-- restore the original environment.
215−--
216−handleDecls :: [P.Declaration] -> PSCI ()
217−handleDecls ds = do
218− st <- PSCI $ lift get
219− let st' = updateLets ds st
220− let m = createTemporaryModule False st' (P.Literal (P.ObjectLiteral []))
221− e <- psciIO . runMake $ make st' [m]
222− case e of
223− Left err -> PSCI $ printErrors err
224− Right _ -> PSCI $ lift (put st')
225−
226−-- |
227−-- Show actual loaded modules in psci.
228−--
229−handleShowLoadedModules :: PSCI ()
230−handleShowLoadedModules = do
231− loadedModules <- PSCI $ lift $ gets psciLoadedModules
232− psciIO $ readModules loadedModules >>= putStrLn
233− return ()
234− where readModules = return . unlines . sort . nub . map toModuleName
235− toModuleName = N.runModuleName . (\ (P.Module _ _ mdName _ _) -> mdName) . snd
236−
237−-- |
238−-- Show the imported modules in psci.
239−--
240−handleShowImportedModules :: PSCI ()
241−handleShowImportedModules = do
242− PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
243− psciIO $ showModules importedModules >>= putStrLn
244− return ()
245− where
246− showModules = return . unlines . sort . map showModule
247− showModule (mn, declType, asQ) =
248− "import " ++ N.runModuleName mn ++ showDeclType declType ++
249− foldMap (\mn' -> " as " ++ N.runModuleName mn') asQ
250−
251− showDeclType P.Implicit = ""
252− showDeclType (P.Explicit refs) = refsList refs
253− showDeclType (P.Hiding refs) = " hiding " ++ refsList refs
254− refsList refs = " (" ++ commaList (map showRef refs) ++ ")"
255−
256− showRef :: P.DeclarationRef -> String
257− showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
258− showRef (P.TypeOpRef op) = "type " ++ N.showOp op
259− showRef (P.ValueRef ident) = N.runIdent ident
260− showRef (P.ValueOpRef op) = N.showOp op
261− showRef (P.TypeClassRef pn) = "class " ++ N.runProperName pn
262− showRef (P.TypeInstanceRef ident) = N.runIdent ident
263− showRef (P.ModuleRef name) = "module " ++ N.runModuleName name
264− showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
265−
266− commaList :: [String] -> String
267− commaList = intercalate ", "
268−
269−-- |
270−-- Imports a module, preserving the initial state on failure.
271−--
272−handleImport :: ImportedModule -> PSCI ()
273−handleImport im = do
274− st <- updateImportedModules im <$> PSCI (lift get)
275− let m = createTemporaryModuleForImports st
276− e <- psciIO . runMake $ make st [m]
277− case e of
278− Left errs -> PSCI $ printErrors errs
279− Right _ -> do
280− PSCI $ lift $ put st
281− return ()
282−
283−-- |
284−-- Takes a value and prints its type
285−--
286−handleTypeOf :: P.Expr -> PSCI ()
287−handleTypeOf val = do
288− st <- PSCI $ lift get
289− let m = createTemporaryModule False st val
290− e <- psciIO . runMake $ make st [m]
291− case e of
292− Left errs -> PSCI $ printErrors errs
293− Right env' ->
294− case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
295− Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
296− Nothing -> PSCI $ outputStrLn "Could not find type"
297−
298−-- |
299−-- Browse a module and displays its signature (if module exists).
300−--
301−handleBrowse :: P.ModuleName -> PSCI ()
302−handleBrowse moduleName = do
303− st <- PSCI $ lift get
304− env <- psciIO . runMake $ make st []
305− case env of
306− Left errs -> PSCI $ printErrors errs
307− Right env' ->
308− if isModInEnv moduleName st
309− then PSCI $ printModuleSignatures moduleName env'
310− else case lookupUnQualifiedModName moduleName st of
311− Just unQualifiedName ->
312− if isModInEnv unQualifiedName st
313− then PSCI $ printModuleSignatures unQualifiedName env'
314− else failNotInEnv moduleName
315− Nothing ->
316− failNotInEnv moduleName
317− where
318− isModInEnv modName =
319− any ((== modName) . P.getModuleName . snd) . psciLoadedModules
320− failNotInEnv modName =
321− PSCI $ outputStrLn $ "Module '" ++ N.runModuleName modName ++ "' is not valid."
322− lookupUnQualifiedModName quaModName st =
323− (\(modName,_,_) -> modName) <$> find ( \(_, _, mayQuaName) -> mayQuaName == Just quaModName) (psciImportedModules st)
324−
325−-- |
326−-- Takes a value and prints its kind
327−--
328−handleKindOf :: P.Type -> PSCI ()
329−handleKindOf typ = do
330− st <- PSCI $ lift get
331− let m = createTemporaryModuleForKind st typ
332− mName = P.ModuleName [P.ProperName "$PSCI"]
333− e <- psciIO . runMake $ make st [m]
334− case e of
335− Left errs -> PSCI $ printErrors errs
336− Right env' ->
337− case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
338− Just (_, typ') -> do
339− let chk = (P.emptyCheckState env') { P.checkCurrentModule = Just mName }
340− k = check (P.kindOf typ') chk
341−
342− check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
343− check sew = fst . runWriter . runExceptT . runStateT sew
344− case k of
345− Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
346− Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
347− Nothing -> PSCI $ outputStrLn "Could not find kind"
348−
349−-- Misc
350−
351−-- |
352−-- Attempts to read initial commands from '.psci' in the present working
353−-- directory then the user's home
354−--
355−loadUserConfig :: IO (Maybe [Command])
356−loadUserConfig = onFirstFileMatching readCommands pathGetters
357− where
358− pathGetters = [getCurrentDirectory, getHomeDirectory]
359− readCommands :: IO FilePath -> IO (Maybe [Command])
360− readCommands path = do
361− configFile <- (</> ".psci") <$> path
362− exists <- doesFileExist configFile
363− if exists
364− then do
365− ls <- lines <$> readUTF8File configFile
366− case traverse parseCommand ls of
367− Left err -> print err >> exitFailure
368− Right cs -> return $ Just cs
369− else
370− return Nothing
371−
372−-- | Checks if the Console module is defined
373−consoleIsDefined :: [P.Module] -> Bool
374−consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)
psci/PSCi/Message.hsdeleted−52
@@ -1,52 +0,0 @@
1−module PSCi.Message where
2−
3−import Data.List (intercalate)
4−
5−import PSCi.Types
6−import qualified PSCi.Directive as D
7−
8−-- Messages
9−
10−-- |
11−-- The help message.
12−--
13−helpMessage :: String
14−helpMessage = "The following commands are available:\n\n " ++
15− intercalate "\n " (map line D.help) ++
16− "\n\n" ++ extraHelp
17− where
18− line :: (Directive, String, String) -> String
19− line (dir, arg, desc) =
20− let cmd = ':' : D.stringFor dir
21− in unwords [ cmd
22− , replicate (11 - length cmd) ' '
23− , arg
24− , replicate (11 - length arg) ' '
25− , desc
26− ]
27−
28− extraHelp =
29− "Further information is available on the PureScript wiki:\n" ++
30− " --> https://github.com/purescript/purescript/wiki/psci"
31−
32−
33−-- |
34−-- The welcome prologue.
35−--
36−prologueMessage :: String
37−prologueMessage = intercalate "\n"
38− [ " ____ ____ _ _ "
39− , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
40− , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
41− , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
42− , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
43− , " |_| "
44− , ""
45− , ":? shows help"
46− ]
47−
48−-- |
49−-- The quit message.
50−--
51−quitMessage :: String
52−quitMessage = "See ya!"
psci/PSCi/Option.hsdeleted−57
@@ -1,57 +0,0 @@
1−module PSCi.Option (
2− getOpt
3−) where
4−
5−import Prelude ()
6−import Prelude.Compat
7−
8−import Options.Applicative as Opts
9−import Data.Version (showVersion)
10−
11−import PSCi.Types
12−import qualified Paths_purescript as Paths
13−
14−-- Parse Command line option
15−
16−multiLineMode :: Parser Bool
17−multiLineMode = switch $
18− long "multi-line-mode"
19− <> short 'm'
20− <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
21−
22−inputFile :: Parser FilePath
23−inputFile = strArgument $
24− metavar "FILE"
25− <> Opts.help "Optional .purs files to load on start"
26−
27−inputForeignFile :: Parser FilePath
28−inputForeignFile = strOption $
29− short 'f'
30− <> long "ffi"
31− <> help "The input .js file(s) providing foreign import implementations"
32−
33−nodeFlagsFlag :: Parser [String]
34−nodeFlagsFlag = option parser $
35− long "node-opts"
36− <> metavar "NODE_OPTS"
37− <> value []
38− <> Opts.help "Flags to pass to node, separated by spaces"
39− where
40− parser = words <$> str
41−
42−psciOptions :: Parser PSCiOptions
43−psciOptions = PSCiOptions <$> multiLineMode
44− <*> many inputFile
45− <*> many inputForeignFile
46− <*> nodeFlagsFlag
47−
48−version :: Parser (a -> a)
49−version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
50−
51−getOpt :: IO PSCiOptions
52−getOpt = execParser opts
53− where
54− opts = info (version <*> helper <*> psciOptions) infoModList
55− infoModList = fullDesc <> headerInfo <> footerInfo
56− headerInfo = header "psci - Interactive mode for PureScript"
57− footerInfo = footer $ "psci " ++ showVersion Paths.version
psci/main/Main.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main where
2−
3−import PSCi
4−
5−main :: IO ()
6−main = runPSCi
purescript.cabal+152−96
@@ -89,47 +89,48 @@ source-repository head
89
89
90library
90library
91 build-depends: base >=4.8 && <5,
91 build-depends: base >=4.8 && <5,
92+ aeson >= 0.8 && < 0.12,
93+ aeson-better-errors >= 0.8,
92 base-compat >=0.6.0,
94 base-compat >=0.6.0,
93− lifted-base >= 0.2.3 && < 0.2.4,
95+ bower-json >= 0.8,
94− monad-control >= 1.0.0.0 && < 1.1,
96+ boxes >= 0.1.4 && < 0.2.0,
95− transformers-base >= 0.4.0 && < 0.5,
97+ bytestring -any,
96 containers -any,
98 containers -any,
97− unordered-containers -any,
98− dlist -any,
99 directory >= 1.2,
99 directory >= 1.2,
100+ dlist -any,
101+ edit-distance -any,
100 filepath -any,
102 filepath -any,
103+ fsnotify >= 0.2.1,
104+ Glob >= 0.7 && < 0.8,
105+ haskeline >= 0.7.0.0,
106+ http-types -any,
107+ language-javascript == 0.6.*,
108+ lifted-base >= 0.2.3 && < 0.2.4,
109+ monad-control >= 1.0.0.0 && < 1.1,
110+ monad-logger >= 0.3 && < 0.4,
101 mtl >= 2.1.0 && < 2.3.0,
111 mtl >= 2.1.0 && < 2.3.0,
112+ parallel >= 3.2 && < 3.3,
102− parsec -any,
113+ parsec >=3.1.10,
103− transformers >= 0.3.0 && < 0.6,
104− transformers-compat >= 0.3.0,
105− utf8-string >= 1 && < 2,
106 pattern-arrows >= 0.0.2 && < 0.1,
114 pattern-arrows >= 0.0.2 && < 0.1,
107− time -any,
115+ pipes >= 4.0.0 && < 4.2.0,
108− boxes >= 0.1.4 && < 0.2.0,
116+ pipes-http -any,
109− aeson >= 0.8 && < 0.12,
110− vector -any,
111− bower-json >= 0.8,
112− aeson-better-errors >= 0.8,
113− bytestring -any,
114− text -any,
115− split -any,
116− language-javascript == 0.6.*,
117− syb -any,
118− Glob >= 0.7 && < 0.8,
119 process >= 1.2.0 && < 1.5,
117 process >= 1.2.0 && < 1.5,
118+ regex-tdfa -any,
120 safe >= 0.3.9 && < 0.4,
119 safe >= 0.3.9 && < 0.4,
121 semigroups >= 0.16.2 && < 0.19,
120 semigroups >= 0.16.2 && < 0.19,
122− parallel >= 3.2 && < 3.3,
123 sourcemap >= 0.1.6,
121 sourcemap >= 0.1.6,
122+ spdx == 0.2.*,
123+ split -any,
124 stm >= 0.2.4.0,
124 stm >= 0.2.4.0,
125− regex-tdfa -any,
125+ syb -any,
126− edit-distance -any,
126+ text -any,
127− fsnotify >= 0.2.1,
127+ time -any,
128− monad-logger >= 0.3 && < 0.4,
128+ transformers >= 0.3.0 && < 0.6,
129− pipes >= 4.0.0 && < 4.2.0 ,
129+ transformers-base >= 0.4.0 && < 0.5,
130− pipes-http -any,
130+ transformers-compat >= 0.3.0,
131− http-types -any,
131+ unordered-containers -any,
132− spdx == 0.2.*
132+ utf8-string >= 1 && < 2,
133+ vector -any
133
134
134 exposed-modules: Language.PureScript
135 exposed-modules: Language.PureScript
135 Language.PureScript.AST
136 Language.PureScript.AST
@@ -273,6 +274,16 @@ library
273 Language.PureScript.Ide.Util
274 Language.PureScript.Ide.Util
274 Language.PureScript.Ide.Rebuild
275 Language.PureScript.Ide.Rebuild
275
276
277+ Language.PureScript.Interactive
278+ Language.PureScript.Interactive.Types
279+ Language.PureScript.Interactive.Parser
280+ Language.PureScript.Interactive.Directive
281+ Language.PureScript.Interactive.Completion
282+ Language.PureScript.Interactive.IO
283+ Language.PureScript.Interactive.Message
284+ Language.PureScript.Interactive.Module
285+ Language.PureScript.Interactive.Printer
286+
276 Control.Monad.Logger
287 Control.Monad.Logger
277 Control.Monad.Supply
288 Control.Monad.Supply
278 Control.Monad.Supply.Class
289 Control.Monad.Supply.Class
@@ -302,11 +313,22 @@ library
302 ghc-options: -Wall -O2
313 ghc-options: -Wall -O2
303
314
304executable psc
315executable psc
305− build-depends: base >=4 && <5, base-compat >=0.6.0,
316+ build-depends: base >=4 && <5,
317+ purescript -any,
318+ aeson >= 0.8 && < 0.12,
319+ base-compat >=0.6.0,
320+ bytestring -any,
306− containers -any, directory -any, filepath -any,
321+ containers -any,
322+ directory -any,
323+ filepath -any,
324+ Glob >= 0.7 && < 0.8,
325+ mtl -any,
307− mtl -any, optparse-applicative >= 0.12.1, parsec -any, purescript -any,
326+ optparse-applicative >= 0.12.1,
327+ parsec -any,
328+ time -any,
329+ transformers -any,
308− time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8,
330+ transformers-compat -any,
309− aeson >= 0.8 && < 0.12, bytestring -any, utf8-string >= 1 && < 2
331+ utf8-string >= 1 && < 2
310 main-is: Main.hs
332 main-is: Main.hs
311 buildable: True
333 buildable: True
312 hs-source-dirs: psc
334 hs-source-dirs: psc
@@ -314,33 +336,40 @@ executable psc
314 ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
336 ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
315
337
316executable psci
338executable psci
317− build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
339+ build-depends: base >=4 && <5,
340+ purescript -any,
341+ base-compat >=0.6.0,
342+ boxes >= 0.1.4 && < 0.2.0,
343+ containers -any,
344+ directory -any,
345+ filepath -any,
346+ Glob -any,
347+ haskeline >= 0.7.0.0,
348+ mtl -any,
318− mtl -any, optparse-applicative >= 0.12.1, parsec -any,
349+ optparse-applicative >= 0.12.1,
319− haskeline >= 0.7.0.0, purescript -any, transformers -any,
350+ parsec -any,
320− transformers-compat -any, process -any, time -any, Glob -any, base-compat >=0.6.0,
351+ process -any,
321− boxes >= 0.1.4 && < 0.2.0
352+ time -any,
322−
353+ transformers -any,
354+ transformers-compat -any
323 main-is: Main.hs
355 main-is: Main.hs
324 buildable: True
356 buildable: True
325− hs-source-dirs: psci psci/main
357+ hs-source-dirs: psci
326− other-modules: PSCi
327− PSCi.Types
328− PSCi.Parser
329− PSCi.Directive
330− PSCi.Completion
331− PSCi.IO
332− PSCi.Message
333− PSCi.Option
334− PSCi.Module
335− PSCi.Printer
336− Paths_purescript
358+ other-modules: Paths_purescript
337 ghc-options: -Wall -O2
359 ghc-options: -Wall -O2
338
360
339executable psc-docs
361executable psc-docs
340− build-depends: base >=4 && <5, purescript -any,
362+ build-depends: base >=4 && <5,
363+ purescript -any,
364+ ansi-wl-pprint -any,
365+ directory -any,
366+ filepath -any,
367+ Glob -any,
368+ mtl -any,
341− optparse-applicative >= 0.12.1, process -any, mtl -any,
369+ optparse-applicative >= 0.12.1,
342− split -any, ansi-wl-pprint -any, directory -any,
370+ process -any,
371+ split -any,
343− filepath -any, Glob -any, transformers -any,
372+ transformers -any,
344 transformers-compat -any
373 transformers-compat -any
345 main-is: Main.hs
374 main-is: Main.hs
346 other-modules: Paths_purescript
375 other-modules: Paths_purescript
@@ -352,7 +381,11 @@ executable psc-docs
352 ghc-options: -Wall -O2
381 ghc-options: -Wall -O2
353
382
354executable psc-publish
383executable psc-publish
384+ build-depends: base >=4 && <5,
385+ purescript -any,
386+ aeson -any,
387+ bytestring -any,
355− build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any
388+ optparse-applicative -any
356 main-is: Main.hs
389 main-is: Main.hs
357 other-modules: Paths_purescript
390 other-modules: Paths_purescript
358 buildable: True
391 buildable: True
@@ -360,9 +393,15 @@ executable psc-publish
360 ghc-options: -Wall -O2
393 ghc-options: -Wall -O2
361
394
362executable psc-hierarchy
395executable psc-hierarchy
396+ build-depends: base >=4 && <5,
397+ purescript -any,
398+ directory -any,
399+ filepath -any,
400+ Glob -any,
401+ mtl -any,
363− build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.12.1,
402+ optparse-applicative >= 0.12.1,
364− process -any, mtl -any, parsec -any, filepath -any, directory -any,
403+ parsec -any,
365− Glob -any
404+ process -any
366 main-is: Main.hs
405 main-is: Main.hs
367 other-modules: Paths_purescript
406 other-modules: Paths_purescript
368 buildable: True
407 buildable: True
@@ -376,13 +415,13 @@ executable psc-bundle
376 other-extensions:
415 other-extensions:
377 build-depends: base >=4 && <5,
416 build-depends: base >=4 && <5,
378 purescript -any,
417 purescript -any,
379− filepath -any,
380 directory -any,
418 directory -any,
419+ filepath -any,
420+ Glob -any,
381 mtl -any,
421 mtl -any,
382− transformers -any,
383− transformers-compat -any,
384 optparse-applicative >= 0.12.1,
422 optparse-applicative >= 0.12.1,
385− Glob -any
423+ transformers -any,
424+ transformers-compat -any
386 ghc-options: -Wall -O2
425 ghc-options: -Wall -O2
387 hs-source-dirs: psc-bundle
426 hs-source-dirs: psc-bundle
388
427
@@ -390,19 +429,19 @@ executable psc-ide-server
390 main-is: Main.hs
429 main-is: Main.hs
391 other-modules: Paths_purescript
430 other-modules: Paths_purescript
392 other-extensions:
431 other-extensions:
393− build-depends: base >=4 && <5
432+ build-depends: base >=4 && <5,
394− , purescript -any
433+ purescript -any,
434+ base-compat >=0.6.0,
395− , directory -any
435+ directory -any,
396− , filepath -any
436+ filepath -any,
397− , monad-logger -any
437+ monad-logger -any,
398− , mtl -any
438+ mtl -any,
399− , transformers -any
400− , transformers-compat -any
401− , network -any
439+ network -any,
402− , optparse-applicative >= 0.12.1
440+ optparse-applicative >= 0.12.1,
403− , stm -any
441+ stm -any,
404− , text -any
442+ text -any,
405− , base-compat >=0.6.0
443+ transformers -any,
444+ transformers-compat -any
406 ghc-options: -Wall -O2 -threaded
445 ghc-options: -Wall -O2 -threaded
407 hs-source-dirs: psc-ide-server
446 hs-source-dirs: psc-ide-server
408
447
@@ -410,12 +449,12 @@ executable psc-ide-client
410 main-is: Main.hs
449 main-is: Main.hs
411 other-modules: Paths_purescript
450 other-modules: Paths_purescript
412 other-extensions:
451 other-extensions:
413− build-depends: base >=4 && <5
452+ build-depends: base >=4 && <5,
453+ base-compat >=0.6.0,
414− , mtl -any
454+ mtl -any,
415− , text -any
455+ network -any,
416− , optparse-applicative >= 0.12.1
456+ optparse-applicative >= 0.12.1,
417− , network -any
457+ text -any
418− , base-compat >=0.6.0
419 ghc-options: -Wall -O2
458 ghc-options: -Wall -O2
420 hs-source-dirs: psc-ide-client
459 hs-source-dirs: psc-ide-client
421
460
@@ -432,13 +471,33 @@ executable pcc
432 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
471 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
433
472
434test-suite tests
473test-suite tests
435− build-depends: base >=4 && <5, containers -any, directory -any,
474+ build-depends: base >=4 && <5,
436− filepath -any, mtl -any, parsec -any, purescript -any,
475+ purescript -any,
437− transformers -any, process -any, transformers-compat -any, time -any,
476+ aeson -any,
438− Glob -any, aeson-better-errors -any, bytestring -any, aeson -any,
477+ aeson-better-errors -any,
478+ base-compat -any,
479+ boxes -any,
480+ bytestring -any,
481+ containers -any,
482+ directory -any,
483+ filepath -any,
484+ Glob -any,
485+ haskeline >= 0.7.0.0,
486+ hspec -any,
487+ hspec-discover -any,
488+ HUnit -any,
489+ mtl -any,
439− base-compat -any, haskeline >= 0.7.0.0, optparse-applicative -any,
490+ optparse-applicative -any,
440− boxes -any, HUnit -any, hspec -any, hspec-discover -any, stm -any, text -any,
491+ parsec -any,
492+ process -any,
493+ silently -any,
494+ stm -any,
495+ text -any,
496+ time -any,
497+ transformers -any,
498+ transformers-compat -any,
441− vector -any, utf8-string -any, silently -any
499+ utf8-string -any,
500+ vector -any
442 ghc-options: -Wall
501 ghc-options: -Wall
443 type: exitcode-stdio-1.0
502 type: exitcode-stdio-1.0
444 main-is: Main.hs
503 main-is: Main.hs
@@ -457,12 +516,8 @@ test-suite tests
457 Language.PureScript.Ide.RebuildSpec
516 Language.PureScript.Ide.RebuildSpec
458 Language.PureScript.Ide.ReexportsSpec
517 Language.PureScript.Ide.ReexportsSpec
459 Language.PureScript.IdeSpec
518 Language.PureScript.IdeSpec
460− PSCi.Completion
461− PSCi.Directive
462− PSCi.Module
463− PSCi.Types
464 buildable: True
519 buildable: True
465− hs-source-dirs: tests psci
520+ hs-source-dirs: tests
466
521
467test-suite pcc-tests
522test-suite pcc-tests
468 build-depends: base >=4 && <5, directory -any, filepath -any, process -any
523 build-depends: base >=4 && <5, directory -any, filepath -any, process -any
@@ -470,3 +525,4 @@ test-suite pcc-tests
470 main-is: TestMain.hs
525 main-is: TestMain.hs
471 buildable: True
526 buildable: True
472 hs-source-dirs: pcc
527 hs-source-dirs: pcc
528+
src/Language/PureScript/Ide.hs+1
@@ -90,6 +90,7 @@ handleCommand (Rebuild file) =
90 rebuildFile file
90 rebuildFile file
91handleCommand Cwd =
91handleCommand Cwd =
92 TextResult . T.pack <$> liftIO getCurrentDirectory
92 TextResult . T.pack <$> liftIO getCurrentDirectory
93+handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")
93handleCommand Quit = liftIO exitSuccess
94handleCommand Quit = liftIO exitSuccess
94
95
95findCompletions :: (PscIde m, MonadLogger m) =>
96findCompletions :: (PscIde m, MonadLogger m) =>
src/Language/PureScript/Ide/Command.hs+2
@@ -63,6 +63,7 @@ data Command
63 | List { listType :: ListType }
63 | List { listType :: ListType }
64 | Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs
64 | Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs
65 | Cwd
65 | Cwd
66+ | Reset
66 | Quit
67 | Quit
67
68
68data ImportCommand
69data ImportCommand
@@ -104,6 +105,7 @@ instance FromJSON Command where
104 return $ List (fromMaybe LoadedModules listType')
105 return $ List (fromMaybe LoadedModules listType')
105 "cwd" -> return Cwd
106 "cwd" -> return Cwd
106 "quit" -> return Quit
107 "quit" -> return Quit
108+ "reset" -> pure Reset
107 "load" ->
109 "load" ->
108 maybe (pure (Load [] [])) (\params -> do
110 maybe (pure (Load [] [])) (\params -> do
109 mods <- params .:? "modules"
111 mods <- params .:? "modules"
src/Language/PureScript/Ide/State.hs+5
@@ -35,6 +35,11 @@ import Language.PureScript.Ide.Reexports
35import Language.PureScript.Ide.Types
35import Language.PureScript.Ide.Types
36import Language.PureScript.Names
36import Language.PureScript.Names
37
37
38+resetPscIdeState :: PscIde m => m ()
39+resetPscIdeState = do
40+ stateVar <- envStateVar <$> ask
41+ liftIO $ atomically (writeTVar stateVar emptyPscIdeState)
42+
38getPscIdeState :: (PscIde m) =>
43getPscIdeState :: (PscIde m) =>
39 m (M.Map ModuleIdent [ExternDecl])
44 m (M.Map ModuleIdent [ExternDecl])
40getPscIdeState = do
45getPscIdeState = do
src/Language/PureScript/Interactive.hsnew file+288
@@ -0,0 +1,288 @@
1+{-# LANGUAGE DoAndIfThenElse #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE TupleSections #-}
7+{-# LANGUAGE DataKinds #-}
8+
9+module Language.PureScript.Interactive
10+ ( handleCommand
11+ , module Interactive
12+
13+ -- TODO: remove these exports
14+ , make
15+ , runMake
16+ ) where
17+
18+import Prelude ()
19+import Prelude.Compat
20+
21+import Data.List (intercalate, nub, sort, find, foldl')
22+import qualified Data.Map as M
23+
24+import Control.Monad.IO.Class (MonadIO, liftIO)
25+import Control.Monad.State.Class
26+import Control.Monad.Reader.Class
27+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
28+import Control.Monad.Trans.State.Strict (StateT, runStateT)
29+import Control.Monad.Writer.Strict (Writer(), runWriter)
30+
31+import qualified Language.PureScript as P
32+import qualified Language.PureScript.Names as N
33+
34+import Language.PureScript.Interactive.Completion as Interactive
35+import Language.PureScript.Interactive.IO as Interactive
36+import Language.PureScript.Interactive.Message as Interactive
37+import Language.PureScript.Interactive.Module as Interactive
38+import Language.PureScript.Interactive.Parser as Interactive
39+import Language.PureScript.Interactive.Printer as Interactive
40+import Language.PureScript.Interactive.Types as Interactive
41+
42+import System.Exit
43+import System.Process (readProcessWithExitCode)
44+
45+-- | Pretty-print errors
46+printErrors :: MonadIO m => P.MultipleErrors -> m ()
47+printErrors = liftIO . putStrLn . P.prettyPrintMultipleErrors False
48+
49+-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
50+-- options and ignores the warning messages.
51+runMake :: P.Make a -> IO (Either P.MultipleErrors a)
52+runMake mk = fst <$> P.runMake P.defaultOptions mk
53+
54+-- | Rebuild a module, using the cached externs data for dependencies.
55+rebuild
56+ :: M.Map P.ModuleName FilePath
57+ -> [P.ExternsFile]
58+ -> P.Module
59+ -> P.Make (P.ExternsFile, P.Environment)
60+rebuild foreignFiles loadedExterns m = do
61+ externs <- P.rebuildModule buildActions loadedExterns m
62+ return (externs, foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment (loadedExterns ++ [externs]))
63+ where
64+ buildActions :: P.MakeActions P.Make
65+ buildActions = (P.buildMakeActions modulesDir
66+ filePathMap
67+ foreignFiles
68+ False) { P.progress = const (return ()) }
69+
70+ filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
71+ filePathMap = M.singleton (P.getModuleName m) (Left P.RebuildAlways)
72+
73+-- | Build the collection of modules from scratch. This is usually done on startup.
74+make
75+ :: M.Map P.ModuleName FilePath
76+ -> [P.Module]
77+ -> P.Make ([P.ExternsFile], P.Environment)
78+make foreignFiles ms = do
79+ externs <- P.make buildActions ms
80+ return (externs, foldl' (flip P.applyExternsFileToEnvironment) P.initEnvironment externs)
81+ where
82+ buildActions :: P.MakeActions P.Make
83+ buildActions = (P.buildMakeActions modulesDir
84+ filePathMap
85+ foreignFiles
86+ False)
87+
88+ filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
89+ filePathMap = M.fromList $ map (\m -> (P.getModuleName m, Left P.RebuildAlways)) ms
90+
91+-- | Performs a PSCi command
92+handleCommand
93+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
94+ => Command
95+ -> m ()
96+handleCommand ShowHelp = liftIO $ putStrLn helpMessage
97+handleCommand ResetState = handleResetState
98+handleCommand (Expression val) = handleExpression val
99+handleCommand (Import im) = handleImport im
100+handleCommand (Decls l) = handleDecls l
101+handleCommand (TypeOf val) = handleTypeOf val
102+handleCommand (KindOf typ) = handleKindOf typ
103+handleCommand (BrowseModule moduleName) = handleBrowse moduleName
104+handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
105+handleCommand (ShowInfo QueryImport) = handleShowImportedModules
106+handleCommand QuitPSCi = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
107+
108+-- | Reset the application state
109+handleResetState
110+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
111+ => m ()
112+handleResetState = do
113+ modify $ updateImportedModules (const [])
114+ . updateLets (const [])
115+ files <- asks psciLoadedFiles
116+ e <- runExceptT $ do
117+ modules <- ExceptT . liftIO $ loadAllModules files
118+ foreignFiles <- asks psciForeignFiles
119+ (externs, _) <- ExceptT . liftIO . runMake . make foreignFiles . map snd $ modules
120+ return (map snd modules, externs)
121+ case e of
122+ Left errs -> printErrors errs
123+ Right (modules, externs) -> modify (updateLoadedExterns (const (zip modules externs)))
124+
125+-- | Takes a value expression and evaluates it with the current state.
126+--
127+-- TODO: factor out the Node process runner, so that we can use PSCi in other settings.
128+handleExpression
129+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
130+ => P.Expr
131+ -> m ()
132+handleExpression val = do
133+ st <- get
134+ let m = createTemporaryModule True st val
135+ foreignFiles <- asks psciForeignFiles
136+ nodeArgs <- asks ((++ [indexFile]) . psciNodeFlags)
137+ e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m
138+ case e of
139+ Left errs -> printErrors errs
140+ Right _ -> do
141+ liftIO $ writeFile indexFile "require('$PSCI')['$main']();"
142+ process <- liftIO findNodeProcess
143+ result <- liftIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
144+ case result of
145+ Just (ExitSuccess, out, _) -> liftIO $ putStrLn out
146+ Just (ExitFailure _, _, err) -> liftIO $ putStrLn err
147+ Nothing -> liftIO $ putStrLn "Couldn't find node.js"
148+
149+-- |
150+-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
151+-- restore the original environment.
152+--
153+handleDecls
154+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
155+ => [P.Declaration]
156+ -> m ()
157+handleDecls ds = do
158+ st <- gets (updateLets (++ ds))
159+ let m = createTemporaryModule False st (P.Literal (P.ObjectLiteral []))
160+ foreignFiles <- asks psciForeignFiles
161+ e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m
162+ case e of
163+ Left err -> printErrors err
164+ Right _ -> put st
165+
166+-- | Show actual loaded modules in psci.
167+handleShowLoadedModules
168+ :: (MonadState PSCiState m, MonadIO m)
169+ => m ()
170+handleShowLoadedModules = do
171+ loadedModules <- gets psciLoadedExterns
172+ liftIO $ putStrLn (readModules loadedModules)
173+ where
174+ readModules = unlines . sort . nub . map (P.runModuleName . P.getModuleName . fst)
175+
176+-- | Show the imported modules in psci.
177+handleShowImportedModules
178+ :: (MonadState PSCiState m, MonadIO m)
179+ => m ()
180+handleShowImportedModules = do
181+ PSCiState { psciImportedModules = importedModules } <- get
182+ liftIO $ showModules importedModules >>= putStrLn
183+ return ()
184+ where
185+ showModules = return . unlines . sort . map showModule
186+ showModule (mn, declType, asQ) =
187+ "import " ++ N.runModuleName mn ++ showDeclType declType ++
188+ foldMap (\mn' -> " as " ++ N.runModuleName mn') asQ
189+
190+ showDeclType P.Implicit = ""
191+ showDeclType (P.Explicit refs) = refsList refs
192+ showDeclType (P.Hiding refs) = " hiding " ++ refsList refs
193+ refsList refs = " (" ++ commaList (map showRef refs) ++ ")"
194+
195+ showRef :: P.DeclarationRef -> String
196+ showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
197+ showRef (P.TypeOpRef op) = "type " ++ N.showOp op
198+ showRef (P.ValueRef ident) = N.runIdent ident
199+ showRef (P.ValueOpRef op) = N.showOp op
200+ showRef (P.TypeClassRef pn) = "class " ++ N.runProperName pn
201+ showRef (P.TypeInstanceRef ident) = N.runIdent ident
202+ showRef (P.ModuleRef name) = "module " ++ N.runModuleName name
203+ showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
204+
205+ commaList :: [String] -> String
206+ commaList = intercalate ", "
207+
208+-- | Imports a module, preserving the initial state on failure.
209+handleImport
210+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
211+ => ImportedModule
212+ -> m ()
213+handleImport im = do
214+ st <- gets (updateImportedModules (im :))
215+ foreignFiles <- asks psciForeignFiles
216+ let m = createTemporaryModuleForImports st
217+ e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m
218+ case e of
219+ Left errs -> printErrors errs
220+ Right _ -> put st
221+
222+-- | Takes a value and prints its type
223+handleTypeOf
224+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
225+ => P.Expr
226+ -> m ()
227+handleTypeOf val = do
228+ st <- get
229+ foreignFiles <- asks psciForeignFiles
230+ let m = createTemporaryModule False st val
231+ e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m
232+ case e of
233+ Left errs -> printErrors errs
234+ Right (_, env') ->
235+ case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
236+ Just (ty, _, _) -> liftIO . putStrLn . P.prettyPrintType $ ty
237+ Nothing -> liftIO $ putStrLn "Could not find type"
238+
239+-- | Takes a type and prints its kind
240+handleKindOf
241+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
242+ => P.Type
243+ -> m ()
244+handleKindOf typ = do
245+ st <- get
246+ foreignFiles <- asks psciForeignFiles
247+ let m = createTemporaryModuleForKind st typ
248+ mName = P.ModuleName [P.ProperName "$PSCI"]
249+ e <- liftIO . runMake $ rebuild foreignFiles (map snd (psciLoadedExterns st)) m
250+ case e of
251+ Left errs -> printErrors errs
252+ Right (_, env') ->
253+ case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
254+ Just (_, typ') -> do
255+ let chk = (P.emptyCheckState env') { P.checkCurrentModule = Just mName }
256+ k = check (P.kindOf typ') chk
257+
258+ check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
259+ check sew = fst . runWriter . runExceptT . runStateT sew
260+ case k of
261+ Left err -> printErrors err
262+ Right (kind, _) -> liftIO . putStrLn . P.prettyPrintKind $ kind
263+ Nothing -> liftIO $ putStrLn "Could not find kind"
264+
265+-- | Browse a module and displays its signature
266+handleBrowse
267+ :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
268+ => P.ModuleName
269+ -> m ()
270+handleBrowse moduleName = do
271+ st <- get
272+ env <- asks psciEnvironment
273+ if isModInEnv moduleName st
274+ then liftIO . putStrLn $ printModuleSignatures moduleName env
275+ else case lookupUnQualifiedModName moduleName st of
276+ Just unQualifiedName ->
277+ if isModInEnv unQualifiedName st
278+ then liftIO . putStrLn $ printModuleSignatures unQualifiedName env
279+ else failNotInEnv moduleName
280+ Nothing ->
281+ failNotInEnv moduleName
282+ where
283+ isModInEnv modName =
284+ any ((== modName) . P.getModuleName . fst) . psciLoadedExterns
285+ failNotInEnv modName =
286+ liftIO $ putStrLn $ "Module '" ++ N.runModuleName modName ++ "' is not valid."
287+ lookupUnQualifiedModName quaModName st =
288+ (\(modName,_,_) -> modName) <$> find ( \(_, _, mayQuaName) -> mayQuaName == Just quaModName) (psciImportedModules st)
psci/PSCi/Completion.hs → src/Language/PureScript/Interactive/Completion.hsrenamed+74−75
@@ -1,35 +1,89 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2
2
3−module PSCi.Completion where
3+module Language.PureScript.Interactive.Completion
4+ ( CompletionM
5+ , liftCompletionM
6+ , completion
7+ , completion'
8+ ) where
4
9
5−import Prelude ()
6import Prelude.Compat
10import Prelude.Compat
7
11
8−import Data.Maybe (mapMaybe)
9−import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
10−import Data.Function (on)
11−
12−import Control.Arrow (second)
12+import Control.Arrow (second)
13+import Control.Monad.IO.Class (MonadIO(..))
14+import Control.Monad.State.Class (MonadState(..))
13−import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
15+import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
14−import Control.Monad.Trans.State.Strict
16+import Data.Function (on)
15−
17+import Data.List (nub, nubBy, isPrefixOf, sortBy, stripPrefix)
16−import System.Console.Haskeline
18+import Data.Maybe (mapMaybe)
17−
18import qualified Language.PureScript as P
19import qualified Language.PureScript as P
20+import qualified Language.PureScript.Interactive.Directive as D
21+import Language.PureScript.Interactive.Types
19import qualified Language.PureScript.Names as N
22import qualified Language.PureScript.Names as N
20−
23+import System.Console.Haskeline
21−import qualified PSCi.Directive as D
22−import PSCi.Types
23
24
24-- Completions may read the state, but not modify it.
25-- Completions may read the state, but not modify it.
25type CompletionM = ReaderT PSCiState IO
26type CompletionM = ReaderT PSCiState IO
26
27
27−-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
28+-- Lift a `CompletionM` action into a state monad.
28−liftCompletionM :: CompletionM a -> StateT PSCiState IO a
29+liftCompletionM
30+ :: (MonadState PSCiState m, MonadIO m)
31+ => CompletionM a
32+ -> m a
29−liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
33+liftCompletionM act = do
34+ st <- get
35+ liftIO $ runReaderT act st
30
36
31-- Haskeline completions
37-- Haskeline completions
32
38
39+-- | Loads module, function, and file completions.
40+completion
41+ :: (MonadState PSCiState m, MonadIO m)
42+ => CompletionFunc m
43+completion = liftCompletionM . completion'
44+
45+completion' :: CompletionFunc CompletionM
46+completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
47+
48+-- | Callback for Haskeline's `completeWordWithPrev`.
49+-- Expects:
50+-- * Line contents to the left of the word, reversed
51+-- * Word to be completed
52+findCompletions :: String -> String -> CompletionM [Completion]
53+findCompletions prev word = do
54+ let ctx = completionContext (words (reverse prev)) word
55+ completions <- concat <$> traverse getCompletions ctx
56+ return $ sortBy directivesFirst completions
57+ where
58+ getCompletions :: CompletionContext -> CompletionM [Completion]
59+ getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
60+
61+ getCompletion :: CompletionContext -> CompletionM [Either String Completion]
62+ getCompletion ctx =
63+ case ctx of
64+ CtxFilePath f -> map Right <$> listFiles f
65+ CtxModule -> map Left <$> getModuleNames
66+ CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
67+ CtxType -> map Left <$> getTypeNames
68+ CtxFixed str -> return [Left str]
69+ CtxDirective d -> return (map Left (completeDirectives d))
70+
71+ completeDirectives :: String -> [String]
72+ completeDirectives = map (':' :) . D.directiveStringsFor
73+
74+ prefixedBy :: String -> String -> Maybe Completion
75+ prefixedBy w cand = if w `isPrefixOf` cand
76+ then Just (simpleCompletion cand)
77+ else Nothing
78+
79+ directivesFirst :: Completion -> Completion -> Ordering
80+ directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
81+ where
82+ go (':' : xs) (':' : ys) = compare xs ys
83+ go (':' : _) _ = LT
84+ go _ (':' : _) = GT
85+ go xs ys = compare xs ys
86+
33data CompletionContext
87data CompletionContext
34 = CtxDirective String
88 = CtxDirective String
35 | CtxFilePath String
89 | CtxFilePath String
@@ -39,15 +93,6 @@ data CompletionContext
39 | CtxFixed String
93 | CtxFixed String
40 deriving (Show, Read)
94 deriving (Show, Read)
41
95
42−-- |
43−-- Loads module, function, and file completions.
44−--
45−completion :: CompletionFunc (StateT PSCiState IO)
46−completion = liftCompletionM . completion'
47−
48−completion' :: CompletionFunc CompletionM
49−completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
50−
51-- |
96-- |
52-- Decide what kind of completion we need based on input. This function expects
97-- Decide what kind of completion we need based on input. This function expects
53-- a list of complete words (to the left of the cursor) as the first argument,
98-- a list of complete words (to the left of the cursor) as the first argument,
@@ -74,8 +119,6 @@ completeDirective ws w =
74
119
75directiveArg :: String -> Directive -> [CompletionContext]
120directiveArg :: String -> Directive -> [CompletionContext]
76directiveArg _ Browse = [CtxModule]
121directiveArg _ Browse = [CtxModule]
77−directiveArg w Load = [CtxFilePath w]
78−directiveArg w Foreign = [CtxFilePath w]
79directiveArg _ Quit = []
122directiveArg _ Quit = []
80directiveArg _ Reset = []
123directiveArg _ Reset = []
81directiveArg _ Help = []
124directiveArg _ Help = []
@@ -95,44 +138,8 @@ headSatisfies p str =
95 (c:_) -> p c
138 (c:_) -> p c
96 _ -> False
139 _ -> False
97
140
98−-- | Callback for Haskeline's `completeWordWithPrev`.
99−-- Expects:
100−-- * Line contents to the left of the word, reversed
101−-- * Word to be completed
102−findCompletions :: String -> String -> CompletionM [Completion]
103−findCompletions prev word = do
104− let ctx = completionContext (words (reverse prev)) word
105− completions <- concat <$> traverse getCompletions ctx
106− return $ sortBy directivesFirst completions
107− where
108− getCompletions :: CompletionContext -> CompletionM [Completion]
109− getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
110−
111− prefixedBy :: String -> String -> Maybe Completion
112− prefixedBy w cand = if w `isPrefixOf` cand
113− then Just (simpleCompletion cand)
114− else Nothing
115−
116−getCompletion :: CompletionContext -> CompletionM [Either String Completion]
117−getCompletion ctx =
118− case ctx of
119− CtxFilePath f -> map Right <$> listFiles f
120− CtxModule -> map Left <$> getModuleNames
121− CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
122− CtxType -> map Left <$> getTypeNames
123− CtxFixed str -> return [Left str]
124− CtxDirective d -> return (map Left (completeDirectives d))
125−
126− where
127− completeDirectives :: String -> [String]
128− completeDirectives = map (':' :) . D.directiveStringsFor
129−
130−
131getLoadedModules :: CompletionM [P.Module]
141getLoadedModules :: CompletionM [P.Module]
132−getLoadedModules = asks (map snd . psciLoadedModules)
142+getLoadedModules = asks (map fst . psciLoadedExterns)
133−
134−getImportedModules :: CompletionM [ImportedModule]
135−getImportedModules = asks psciImportedModules
136
143
137getModuleNames :: CompletionM [String]
144getModuleNames :: CompletionM [String]
138getModuleNames = moduleNames <$> getLoadedModules
145getModuleNames = moduleNames <$> getLoadedModules
@@ -212,12 +219,4 @@ dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
212 go _ = []
219 go _ = []
213
220
214moduleNames :: [P.Module] -> [String]
221moduleNames :: [P.Module] -> [String]
215−moduleNames ms = nub [P.runModuleName moduleName | P.Module _ _ moduleName _ _ <- ms]
222+moduleNames = nub . map (P.runModuleName . P.getModuleName)
216−
217−directivesFirst :: Completion -> Completion -> Ordering
218−directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
219− where
220− go (':' : xs) (':' : ys) = compare xs ys
221− go (':' : _) _ = LT
222− go _ (':' : _) = GT
223− go xs ys = compare xs ys
psci/PSCi/Directive.hs → src/Language/PureScript/Interactive/Directive.hsrenamed+2−8
@@ -1,17 +1,15 @@
1-- |
1-- |
2-- Directives for PSCI.
2-- Directives for PSCI.
3--
3--
4−module PSCi.Directive where
4+module Language.PureScript.Interactive.Directive where
5
5
6−import Prelude ()
7import Prelude.Compat
6import Prelude.Compat
8
7
9−
10import Data.Maybe (fromJust, listToMaybe)
8import Data.Maybe (fromJust, listToMaybe)
11import Data.List (isPrefixOf)
9import Data.List (isPrefixOf)
12import Data.Tuple (swap)
10import Data.Tuple (swap)
13
11
14−import PSCi.Types
12+import Language.PureScript.Interactive.Types
15
13
16-- |
14-- |
17-- List of all avaliable directives.
15-- List of all avaliable directives.
@@ -29,8 +27,6 @@ directiveStrings =
29 , (Quit , ["quit"])
27 , (Quit , ["quit"])
30 , (Reset , ["reset"])
28 , (Reset , ["reset"])
31 , (Browse , ["browse"])
29 , (Browse , ["browse"])
32− , (Load , ["load", "module"])
33− , (Foreign, ["foreign"])
34 , (Type , ["type"])
30 , (Type , ["type"])
35 , (Kind , ["kind"])
31 , (Kind , ["kind"])
36 , (Show , ["show"])
32 , (Show , ["show"])
@@ -97,8 +93,6 @@ help =
97 , (Quit, "", "Quit PSCi")
93 , (Quit, "", "Quit PSCi")
98 , (Reset, "", "Discard all imported modules and declared bindings")
94 , (Reset, "", "Discard all imported modules and declared bindings")
99 , (Browse, "<module>", "See all functions in <module>")
95 , (Browse, "<module>", "See all functions in <module>")
100− , (Load, "<file>", "Load <file> for importing")
101− , (Foreign, "<file>", "Load foreign module <file>")
102 , (Type, "<expr>", "Show the type of <expr>")
96 , (Type, "<expr>", "Show the type of <expr>")
103 , (Kind, "<type>", "Show the kind of <type>")
97 , (Kind, "<type>", "Show the kind of <type>")
104 , (Show, "import", "Show all imported modules")
98 , (Show, "import", "Show all imported modules")
psci/PSCi/IO.hs → src/Language/PureScript/Interactive/IO.hsrenamed+4−17
@@ -1,14 +1,11 @@
1−module PSCi.IO where
1+module Language.PureScript.Interactive.IO where
2
2
3−import Prelude ()
4import Prelude.Compat
3import Prelude.Compat
5
4
6−import System.Directory (createDirectoryIfMissing, getHomeDirectory, findExecutable, doesFileExist)
7−import System.FilePath (takeDirectory, (</>), isPathSeparator)
8−import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
9import Control.Monad (msum)
5import Control.Monad (msum)
10−import Control.Monad.IO.Class (MonadIO, liftIO)
6+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
11−import System.Console.Haskeline (outputStrLn, InputT)
7+import System.Directory (createDirectoryIfMissing, getHomeDirectory, findExecutable)
8+import System.FilePath (takeDirectory, (</>), isPathSeparator)
12
9
13mkdirp :: FilePath -> IO ()
10mkdirp :: FilePath -> IO ()
14mkdirp = createDirectoryIfMissing True . takeDirectory
11mkdirp = createDirectoryIfMissing True . takeDirectory
@@ -36,19 +33,9 @@ getHistoryFilename = do
36 mkdirp filename
33 mkdirp filename
37 return filename
34 return filename
38
35
39−
40-- |
36-- |
41-- Expands tilde in path.
37-- Expands tilde in path.
42--
38--
43expandTilde :: FilePath -> IO FilePath
39expandTilde :: FilePath -> IO FilePath
44expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
40expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
45expandTilde p = return p
41expandTilde p = return p
46−
47−
48−whenFileExists :: MonadIO m => FilePath -> (FilePath -> InputT m ()) -> InputT m ()
49−whenFileExists filePath f = do
50− absPath <- liftIO $ expandTilde filePath
51− exists <- liftIO $ doesFileExist absPath
52− if exists
53− then f absPath
54− else outputStrLn $ "Couldn't locate: " ++ filePath
src/Language/PureScript/Interactive/Message.hsnew file+52
@@ -0,0 +1,52 @@
1+module Language.PureScript.Interactive.Message where
2+
3+import Prelude.Compat
4+
5+import Data.List (intercalate)
6+import Data.Version (showVersion)
7+import qualified Paths_purescript as Paths
8+import qualified Language.PureScript.Interactive.Directive as D
9+import Language.PureScript.Interactive.Types
10+
11+-- Messages
12+
13+-- | The help message.
14+helpMessage :: String
15+helpMessage = "The following commands are available:\n\n " ++
16+ intercalate "\n " (map line D.help) ++
17+ "\n\n" ++ extraHelp
18+ where
19+ line :: (Directive, String, String) -> String
20+ line (dir, arg, desc) =
21+ let cmd = ':' : D.stringFor dir
22+ in unwords [ cmd
23+ , replicate (11 - length cmd) ' '
24+ , arg
25+ , replicate (11 - length arg) ' '
26+ , desc
27+ ]
28+
29+ extraHelp =
30+ "Further information is available on the PureScript wiki:\n" ++
31+ " --> https://github.com/purescript/purescript/wiki/psci"
32+
33+-- | The welcome prologue.
34+prologueMessage :: String
35+prologueMessage = unlines
36+ [ "PSCi, version " ++ showVersion Paths.version
37+ , "Type :? for help"
38+ ]
39+
40+supportModuleMessage :: String
41+supportModuleMessage = unlines
42+ [ "PSCi requires the purescript-psci-support package to be installed."
43+ , "You can install it using Bower as follows:"
44+ , ""
45+ , " bower i purescript-psci-support --save"
46+ , ""
47+ , "For help getting started, visit http://wiki.purescript.org/PSCi"
48+ ]
49+
50+-- | The quit message.
51+quitMessage :: String
52+quitMessage = "See ya!"
psci/PSCi/Module.hs → src/Language/PureScript/Interactive/Module.hsrenamed+13−35
@@ -1,45 +1,24 @@
1−module PSCi.Module where
1+module Language.PureScript.Interactive.Module where
2
2
3−import Prelude ()
4−import Prelude.Compat
3+import Prelude.Compat
5
4
5+import Control.Monad
6import qualified Language.PureScript as P
6import qualified Language.PureScript as P
7−import PSCi.Types
7+import Language.PureScript.Interactive.Types
8−import System.FilePath (pathSeparator)
8+import System.FilePath (pathSeparator)
9−import System.IO.UTF8 (readUTF8File)
9+import System.IO.UTF8 (readUTF8File)
10−import Control.Monad
10+
11+-- * Support Module
11
12
12-- | The name of the PSCI support module
13-- | The name of the PSCI support module
13supportModuleName :: P.ModuleName
14supportModuleName :: P.ModuleName
14−supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
15+supportModuleName = P.moduleNameFromString "PSCI.Support"
15
16
16−-- | Support module, contains code to evaluate terms
17+-- | Checks if the Console module is defined
17−supportModule :: P.Module
18+supportModuleIsDefined :: [P.Module] -> Bool
18−supportModule =
19+supportModuleIsDefined = any ((== supportModuleName) . P.getModuleName)
19− case P.parseModulesFromFiles id [("", code)] of
20− Right [(_, P.Module ss cs _ ds exps)] -> P.Module ss cs supportModuleName ds exps
21− _ -> P.internalError "Support module could not be parsed"
22− where
23− code :: String
24− code = unlines
25− [ "module S where"
26− , ""
27− , "import Prelude"
28− , "import Control.Monad.Eff (Eff)"
29− , "import Control.Monad.Eff.Console (CONSOLE, logShow)"
30− , "import Control.Monad.Eff.Unsafe (unsafeInterleaveEff)"
31− , ""
32− , "class Eval a where"
33− , " eval :: a -> Eff (console :: CONSOLE) Unit"
34− , ""
35− , "instance evalShow :: (Show a) => Eval a where"
36− , " eval = logShow"
37− , ""
38− , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
39− , " eval x = unsafeInterleaveEff x >>= eval"
40− ]
41
20
42−-- Module Management
21+-- * Module Management
43
22
44-- |
23-- |
45-- Loads a file for use with imports.
24-- Loads a file for use with imports.
@@ -59,7 +38,6 @@ loadAllModules files = do
59 return (filename, content)
38 return (filename, content)
60 return $ P.parseModulesFromFiles id filesAndContent
39 return $ P.parseModulesFromFiles id filesAndContent
61
40
62−
63-- |
41-- |
64-- Makes a volatile module to execute the current expression.
42-- Makes a volatile module to execute the current expression.
65--
43--
psci/PSCi/Parser.hs → src/Language/PureScript/Interactive/Parser.hsrenamed+8−14
@@ -1,23 +1,19 @@
1-- |
1-- |
2-- Parser for PSCI.
2-- Parser for PSCI.
3--
3--
4−module PSCi.Parser
4+module Language.PureScript.Interactive.Parser
5 ( parseCommand
5 ( parseCommand
6 ) where
6 ) where
7
7
8−import Prelude ()
9−import Prelude.Compat hiding (lex)
8+import Prelude.Compat hiding (lex)
10−
11−import Data.Char (isSpace)
12−import Data.List (intercalate)
13−
14−import Text.Parsec hiding ((<|>))
15
9
10+import Data.Char (isSpace)
11+import Data.List (intercalate)
12+import Text.Parsec hiding ((<|>))
16import qualified Language.PureScript as P
13import qualified Language.PureScript as P
14+import qualified Language.PureScript.Interactive.Directive as D
15+import Language.PureScript.Interactive.Types
17−import Language.PureScript.Parser.Common (mark, same)
16+import Language.PureScript.Parser.Common (mark, same)
18−
19−import qualified PSCi.Directive as D
20−import PSCi.Types
21
17
22-- |
18-- |
23-- Parses PSCI metacommands or expressions input from the user.
19-- Parses PSCI metacommands or expressions input from the user.
@@ -67,8 +63,6 @@ parseDirective cmd =
67 Quit -> return QuitPSCi
63 Quit -> return QuitPSCi
68 Reset -> return ResetState
64 Reset -> return ResetState
69 Browse -> BrowseModule <$> parseRest P.moduleName arg
65 Browse -> BrowseModule <$> parseRest P.moduleName arg
70− Load -> return $ LoadFile (trim arg)
71− Foreign -> return $ LoadForeign (trim arg)
72 Show -> ShowInfo <$> parseReplQuery' (trim arg)
66 Show -> ShowInfo <$> parseReplQuery' (trim arg)
73 Type -> TypeOf <$> parseRest P.parseValue arg
67 Type -> TypeOf <$> parseRest P.parseValue arg
74 Kind -> KindOf <$> parseRest P.parseType arg
68 Kind -> KindOf <$> parseRest P.parseType arg
psci/PSCi/Printer.hs → src/Language/PureScript/Interactive/Printer.hsrenamed+7−14
@@ -1,25 +1,22 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3
3
4−module PSCi.Printer where
4+module Language.PureScript.Interactive.Printer where
5
5
6−import Prelude ()
7−import Prelude.Compat
6+import Prelude.Compat
8
7
8+import Data.List (intersperse)
9+import qualified Data.Map as M
10+import Data.Maybe (mapMaybe)
9import qualified Language.PureScript as P
11import qualified Language.PureScript as P
10import qualified Text.PrettyPrint.Boxes as Box
12import qualified Text.PrettyPrint.Boxes as Box
11−import qualified Data.Map as M
12−import System.Console.Haskeline
13−import Data.Maybe (mapMaybe)
14−import Data.List (intersperse)
15−import Control.Monad.IO.Class (MonadIO)
16
13
17-- Printers
14-- Printers
18
15
19-- |
16-- |
20-- Pretty print a module's signatures
17-- Pretty print a module's signatures
21--
18--
22−printModuleSignatures :: MonadIO m => P.ModuleName -> P.Environment -> InputT m ()
19+printModuleSignatures :: P.ModuleName -> P.Environment -> String
23printModuleSignatures moduleName (P.Environment {..}) =
20printModuleSignatures moduleName (P.Environment {..}) =
24 -- get relevant components of a module from environment
21 -- get relevant components of a module from environment
25 let moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) names
22 let moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) names
@@ -28,7 +25,7 @@ printModuleSignatures moduleName (P.Environment {..}) =
28
25
29 in
26 in
30 -- print each component
27 -- print each component
31− (outputStr . unlines . map trimEnd . lines . Box.render . Box.vsep 1 Box.left)
28+ (unlines . map trimEnd . lines . Box.render . Box.vsep 1 Box.left)
32 [ printModule's (mapMaybe (showTypeClass . findTypeClass typeClasses)) moduleTypeClasses -- typeClasses
29 [ printModule's (mapMaybe (showTypeClass . findTypeClass typeClasses)) moduleTypeClasses -- typeClasses
33 , printModule's (mapMaybe (showType typeClasses dataConstructors typeSynonyms . findType types)) moduleTypes -- types
30 , printModule's (mapMaybe (showType typeClasses dataConstructors typeSynonyms . findType types)) moduleTypes -- types
34 , printModule's (map (showNameType . findNameType names)) moduleNamesIdent -- functions
31 , printModule's (map (showNameType . findNameType names)) moduleNamesIdent -- functions
@@ -125,7 +122,3 @@ printModuleSignatures moduleName (P.Environment {..}) =
125 mapFirstRest f g (x:xs) = f x : map g xs
122 mapFirstRest f g (x:xs) = f x : map g xs
126
123
127 trimEnd = reverse . dropWhile (== ' ') . reverse
124 trimEnd = reverse . dropWhile (== ' ') . reverse
128−
129−-- | Pretty-print errors
130−printErrors :: MonadIO m => P.MultipleErrors -> InputT m ()
131−printErrors = outputStrLn . P.prettyPrintMultipleErrors False
psci/PSCi/Types.hs → src/Language/PureScript/Interactive/Types.hsrenamed+28−86
@@ -1,71 +1,37 @@
1-- |
1-- |
2-- Type declarations and associated basic functions for PSCI.
2-- Type declarations and associated basic functions for PSCI.
3--
3--
4−module PSCi.Types where
4+module Language.PureScript.Interactive.Types where
5
5
6−import Prelude ()
7import Prelude.Compat
6import Prelude.Compat
8
7
9−import Control.Arrow (second)
10−import Data.Map (Map)
8+import Data.Map (Map)
11−import qualified Data.Map as Map
12import qualified Language.PureScript as P
9import qualified Language.PureScript as P
13
10
14−data PSCiOptions = PSCiOptions
11+-- | The PSCI configuration.
15− { psciMultiLineMode :: Bool
12+--
16− , psciInputFile :: [FilePath]
13+-- These configuration values do not change during execution.
17− , psciForeignInputFiles :: [FilePath]
14+--
18− , psciInputNodeFlags :: [String]
15+data PSCiConfig = PSCiConfig
19− }
16+ { psciLoadedFiles :: [FilePath]
17+ , psciForeignFiles :: Map P.ModuleName FilePath
18+ , psciNodeFlags :: [String]
19+ , psciEnvironment :: P.Environment
20+ } deriving Show
20
21
21−-- |
22−-- The PSCI state.
22+-- | The PSCI state.
23+--
23-- Holds a list of imported modules, loaded files, and partial let bindings.
24-- Holds a list of imported modules, loaded files, and partial let bindings.
24-- The let bindings are partial,
25-- The let bindings are partial,
25-- because it makes more sense to apply the binding to the final evaluated expression.
26-- because it makes more sense to apply the binding to the final evaluated expression.
26−--
27data PSCiState = PSCiState
27data PSCiState = PSCiState
28 { psciImportedModules :: [ImportedModule]
28 { psciImportedModules :: [ImportedModule]
29− , _psciLoadedModules :: Map FilePath [P.Module]
30− , psciForeignFiles :: Map P.ModuleName FilePath
31 , psciLetBindings :: [P.Declaration]
29 , psciLetBindings :: [P.Declaration]
32− , psciNodeFlags :: [String]
30+ , psciLoadedExterns :: [(P.Module, P.ExternsFile)]
33− }
31+ } deriving Show
34
32
35initialPSCiState :: PSCiState
33initialPSCiState :: PSCiState
36−initialPSCiState =
34+initialPSCiState = PSCiState [] [] []
37− PSCiState [] Map.empty Map.empty [] []
38−
39−mkPSCiState :: [ImportedModule]
40− -> [(FilePath, P.Module)]
41− -> Map P.ModuleName FilePath
42− -> [P.Declaration]
43− -> [String]
44− -> PSCiState
45−mkPSCiState imported loaded foreigns lets nodeFlags =
46− (initialPSCiState
47− |> each imported updateImportedModules
48− |> updateModules loaded)
49− { psciForeignFiles = foreigns
50− , psciLetBindings = lets
51− , psciNodeFlags = nodeFlags
52− }
53− where
54− x |> f = f x
55− each xs f st = foldl (flip f) st xs
56−
57−-- Public psci state accessors
58−
59−-- | Get the imported filenames as a list.
60−psciImportedFilenames :: PSCiState -> [FilePath]
61−psciImportedFilenames = Map.keys . _psciLoadedModules
62−
63−-- | Get the loaded modules as a list.
64−psciLoadedModules :: PSCiState -> [(FilePath, P.Module)]
65−psciLoadedModules = collect . Map.toList . _psciLoadedModules
66− where
67− collect :: [(k, [v])] -> [(k, v)]
68− collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
69
35
70-- | All of the data that is contained by an ImportDeclaration in the AST.
36-- | All of the data that is contained by an ImportDeclaration in the AST.
71-- That is:
37-- That is:
@@ -89,35 +55,21 @@ allImportsOf m (PSCiState{psciImportedModules = is}) =
89 name = P.getModuleName m
55 name = P.getModuleName m
90 isImportOfThis (name', _, _) = name == name'
56 isImportOfThis (name', _, _) = name == name'
91
57
92−-- State helpers
58+-- * State helpers
93
59
94−-- |
95−-- Updates the state to have more imported modules.
60+-- | Updates the imported modules in the state record.
96−--
97−updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
61+updateImportedModules :: ([ImportedModule] -> [ImportedModule]) -> PSCiState -> PSCiState
98−updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
62+updateImportedModules f st = st { psciImportedModules = f (psciImportedModules st) }
99
63
100−-- |
64+-- | Updates the loaded externs files in the state record.
101−-- Updates the state to have more loaded modules (available for import, but
102−-- not necessarily imported).
103−--
104−updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
65+updateLoadedExterns :: ([(P.Module, P.ExternsFile)] -> [(P.Module, P.ExternsFile)]) -> PSCiState -> PSCiState
105−updateModules modules st =
66+updateLoadedExterns f st = st { psciLoadedExterns = f (psciLoadedExterns st) }
106− st { _psciLoadedModules = Map.union (go modules) (_psciLoadedModules st) }
107− where
108− go = Map.fromListWith (++) . map (second (:[]))
109
67
110−-- |
111−-- Updates the state to have more let bindings.
68+-- | Updates the let bindings in the state record.
112−--
113−updateLets :: [P.Declaration] -> PSCiState -> PSCiState
69+updateLets :: ([P.Declaration] -> [P.Declaration]) -> PSCiState -> PSCiState
114−updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
70+updateLets f st = st { psciLetBindings = f (psciLetBindings st) }
115
71
116−-- |
72+-- * Commands
117−-- Updates the state to have more let bindings.
118−--
119−updateForeignFiles :: Map P.ModuleName FilePath -> PSCiState -> PSCiState
120−updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `Map.union` fs }
121
73
122-- |
74-- |
123-- Valid Meta-commands for PSCI
75-- Valid Meta-commands for PSCI
@@ -140,14 +92,6 @@ data Command
140 --
92 --
141 | BrowseModule P.ModuleName
93 | BrowseModule P.ModuleName
142 -- |
94 -- |
143− -- Load a file for use with importing
144− --
145− | LoadFile FilePath
146− -- |
147− -- Load a foreign module
148− --
149− | LoadForeign FilePath
150− -- |
151 -- Exit PSCI
95 -- Exit PSCI
152 --
96 --
153 | QuitPSCi
97 | QuitPSCi
@@ -198,8 +142,6 @@ data Directive
198 | Quit
142 | Quit
199 | Reset
143 | Reset
200 | Browse
144 | Browse
201− | Load
202− | Foreign
203 | Type
145 | Type
204 | Kind
146 | Kind
205 | Show
147 | Show
src/Language/PureScript/Make.hs+7−8
@@ -14,6 +14,8 @@ module Language.PureScript.Make
14 -- * Implementation of Make API using files on disk
14 -- * Implementation of Make API using files on disk
15 , Make(..)
15 , Make(..)
16 , runMake
16 , runMake
17+ , makeIO
18+ , readTextFile
17 , buildMakeActions
19 , buildMakeActions
18 ) where
20 ) where
19
21
@@ -290,10 +292,10 @@ makeIO f io = do
290 e <- liftIO $ tryIOError io
292 e <- liftIO $ tryIOError io
291 either (throwError . singleError . f) return e
293 either (throwError . singleError . f) return e
292
294
293−-- Traverse (Either e) instance (base 4.7)
295+-- | Read a text file in the 'Make' monad, capturing any errors using the
294−traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
296+-- 'MonadError' instance.
295−traverseEither _ (Left x) = pure (Left x)
297+readTextFile :: FilePath -> Make String
296−traverseEither f (Right y) = Right <$> f y
298+readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path
297
299
298-- |
300-- |
299-- A set of make actions that read and write modules from the given directory.
301-- A set of make actions that read and write modules from the given directory.
@@ -310,7 +312,7 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
310 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))
312 getInputTimestamp :: ModuleName -> Make (Either RebuildPolicy (Maybe UTCTime))
311 getInputTimestamp mn = do
313 getInputTimestamp mn = do
312 let path = fromMaybe (internalError "Module has no filename in 'make'") $ M.lookup mn filePathMap
314 let path = fromMaybe (internalError "Module has no filename in 'make'") $ M.lookup mn filePathMap
313− e1 <- traverseEither getTimestamp path
315+ e1 <- traverse getTimestamp path
314 fPath <- maybe (return Nothing) getTimestamp $ M.lookup mn foreigns
316 fPath <- maybe (return Nothing) getTimestamp $ M.lookup mn foreigns
315 return $ fmap (max fPath) e1
317 return $ fmap (max fPath) e1
316
318
@@ -400,9 +402,6 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =
400 progress :: ProgressMessage -> Make ()
402 progress :: ProgressMessage -> Make ()
401 progress = liftIO . putStrLn . renderProgressMessage
403 progress = liftIO . putStrLn . renderProgressMessage
402
404
403−readTextFile :: FilePath -> Make String
404−readTextFile path = makeIO (const (ErrorMessage [] $ CannotReadFile path)) $ readUTF8File path
405−
406-- |
405-- |
407-- Check that the declarations in a given PureScript module match with those
406-- Check that the declarations in a given PureScript module match with those
408-- in its corresponding foreign module.
407-- in its corresponding foreign module.
src/Language/PureScript/Sugar.hs+1−1
@@ -34,7 +34,7 @@ import Language.PureScript.Sugar.TypeDeclarations as S
34--
34--
35-- * Desugar operator sections
35-- * Desugar operator sections
36--
36--
37−-- * Desugar do-notation using the @Prelude.Monad@ type class
37+-- * Desugar do-notation
38--
38--
39-- * Desugar top-level case declarations into explicit case expressions
39-- * Desugar top-level case declarations into explicit case expressions
40--
40--
src/Language/PureScript/Sugar/CaseDeclarations.hs+1−5
@@ -9,6 +9,7 @@ module Language.PureScript.Sugar.CaseDeclarations
9
9
10import Prelude.Compat
10import Prelude.Compat
11
11
12+import Data.Either (isLeft)
12import Data.List (nub, groupBy, foldl1')
13import Data.List (nub, groupBy, foldl1')
13import Data.Maybe (catMaybes, mapMaybe)
14import Data.Maybe (catMaybes, mapMaybe)
14
15
@@ -24,11 +25,6 @@ import Language.PureScript.Names
24import Language.PureScript.Traversals
25import Language.PureScript.Traversals
25import Language.PureScript.TypeChecker.Monad (guardWith)
26import Language.PureScript.TypeChecker.Monad (guardWith)
26
27
27−-- Data.Either.isLeft (base 4.7)
28−isLeft :: Either a b -> Bool
29−isLeft (Left _) = True
30−isLeft (Right _) = False
31−
32-- |
28-- |
33-- Replace all top-level binders in a module with case expressions.
29-- Replace all top-level binders in a module with case expressions.
34--
30--
src/Language/PureScript/Sugar/DoNotation.hs+7−3
@@ -1,6 +1,6 @@
1-- |
1-- |
2-- This module implements the desugaring pass which replaces do-notation statements with
2-- This module implements the desugaring pass which replaces do-notation statements with
3−-- appropriate calls to bind from the Prelude.Monad type class.
3+-- appropriate calls to bind.
4--
4--
5module Language.PureScript.Sugar.DoNotation (desugarDoModule) where
5module Language.PureScript.Sugar.DoNotation (desugarDoModule) where
6
6
@@ -17,12 +17,16 @@ import Language.PureScript.Names
17import qualified Language.PureScript.Constants as C
17import qualified Language.PureScript.Constants as C
18
18
19-- |
19-- |
20−-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.bind function,
20+-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with
21+-- applications of the bind function in scope, and all @DoNotationLet@
21−-- and all @DoNotationLet@ constructors with let expressions.
22+-- constructors with let expressions.
22--
23--
23desugarDoModule :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Module -> m Module
24desugarDoModule :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Module -> m Module
24desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts
25desugarDoModule (Module ss coms mn ds exts) = Module ss coms mn <$> parU ds desugarDo <*> pure exts
25
26
27+-- |
28+-- Desugar a single do statement
29+--
26desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration
30desugarDo :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration
27desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)
31desugarDo (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> rethrowWithPosition pos (desugarDo d)
28desugarDo d =
32desugarDo d =
src/Language/PureScript/Sugar/Operators.hs+17−9
@@ -112,13 +112,13 @@ rebracket externs modules = do
112 renameAliasedOperators valueAliased typeAliased (Module ss coms mn ds exts) =
112 renameAliasedOperators valueAliased typeAliased (Module ss coms mn ds exts) =
113 Module ss coms mn <$> mapM f' ds <*> pure exts
113 Module ss coms mn <$> mapM f' ds <*> pure exts
114 where
114 where
115− (goDecl', goExpr') = updateTypes goType
115+ (goDecl', goExpr', goBinder') = updateTypes goType
116 (f', _, _, _, _) =
116 (f', _, _, _, _) =
117 everywhereWithContextOnValuesM
117 everywhereWithContextOnValuesM
118 Nothing
118 Nothing
119 (\pos -> uncurry goDecl <=< goDecl' pos)
119 (\pos -> uncurry goDecl <=< goDecl' pos)
120 (\pos -> uncurry goExpr <=< goExpr' pos)
120 (\pos -> uncurry goExpr <=< goExpr' pos)
121− goBinder
121+ (\pos -> uncurry goBinder <=< goBinder' pos)
122 defS
122 defS
123 defS
123 defS
124
124
@@ -182,9 +182,9 @@ rebracketModule valueOpTable typeOpTable (Module ss coms mn ds exts) =
182 everywhereOnValuesTopDownM
182 everywhereOnValuesTopDownM
183 (decontextify goDecl)
183 (decontextify goDecl)
184 (goExpr <=< decontextify goExpr')
184 (goExpr <=< decontextify goExpr')
185− goBinder
185+ (goBinder <=< decontextify goBinder')
186
186
187− (goDecl, goExpr') = updateTypes (const goType)
187+ (goDecl, goExpr', goBinder') = updateTypes (const goType)
188
188
189 goExpr :: Expr -> m Expr
189 goExpr :: Expr -> m Expr
190 goExpr = return . matchExprOperators valueOpTable
190 goExpr = return . matchExprOperators valueOpTable
@@ -205,9 +205,9 @@ removeParens = f
205 everywhereOnValues
205 everywhereOnValues
206 (decontextify goDecl)
206 (decontextify goDecl)
207 (goExpr . decontextify goExpr')
207 (goExpr . decontextify goExpr')
208− goBinder
208+ (goBinder . decontextify goBinder')
209
209
210− (goDecl, goExpr') = updateTypes (\_ -> return . goType)
210+ (goDecl, goExpr', goBinder') = updateTypes (\_ -> return . goType)
211
211
212 goExpr :: Expr -> Expr
212 goExpr :: Expr -> Expr
213 goExpr (Parens val) = val
213 goExpr (Parens val) = val
@@ -294,10 +294,11 @@ updateTypes
294 :: forall m
294 :: forall m
295 . Monad m
295 . Monad m
296 => (Maybe SourceSpan -> Type -> m Type)
296 => (Maybe SourceSpan -> Type -> m Type)
297− -> ( Maybe SourceSpan -> Declaration -> m (Maybe SourceSpan, Declaration)
297+ -> ( Maybe SourceSpan -> Declaration -> m (Maybe SourceSpan, Declaration)
298− , Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)
298+ , Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)
299+ , Maybe SourceSpan -> Binder -> m (Maybe SourceSpan, Binder)
299 )
300 )
300−updateTypes goType = (goDecl, goExpr)
301+updateTypes goType = (goDecl, goExpr, goBinder)
301 where
302 where
302
303
303 goType' :: Maybe SourceSpan -> Type -> m Type
304 goType' :: Maybe SourceSpan -> Type -> m Type
@@ -339,6 +340,13 @@ updateTypes goType = (goDecl, goExpr)
339 return (pos, TypedValue check v ty')
340 return (pos, TypedValue check v ty')
340 goExpr pos other = return (pos, other)
341 goExpr pos other = return (pos, other)
341
342
343+ goBinder :: Maybe SourceSpan -> Binder -> m (Maybe SourceSpan, Binder)
344+ goBinder _ e@(PositionedBinder pos _ _) = return (Just pos, e)
345+ goBinder pos (TypedBinder ty b) = do
346+ ty' <- goType' pos ty
347+ return (pos, TypedBinder ty' b)
348+ goBinder pos other = return (pos, other)
349+
342-- |
350-- |
343-- Checks all the fixity exports within a module to ensure that members aliased
351-- Checks all the fixity exports within a module to ensure that members aliased
344-- by the operators are also exported from the module.
352-- by the operators are also exported from the module.
stack.yaml+1
@@ -4,4 +4,5 @@ packages:
4extra-deps:
4extra-deps:
5- bower-json-0.8.0
5- bower-json-0.8.0
6- language-javascript-0.6.0.4
6- language-javascript-0.6.0.4
7+- parsec-3.1.11
7flags: {}
8flags: {}
tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs+3−10
@@ -1,7 +1,7 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2module Language.PureScript.Ide.Imports.IntegrationSpec where
2module Language.PureScript.Ide.Imports.IntegrationSpec where
3
3
4−import Control.Monad
4+import Control.Monad (void)
5import Data.Text (Text)
5import Data.Text (Text)
6import qualified Data.Text as T
6import qualified Data.Text as T
7import qualified Data.Text.IO as TIO
7import qualified Data.Text.IO as TIO
@@ -13,16 +13,9 @@ import System.FilePath
13
13
14setup :: IO ()
14setup :: IO ()
15setup = do
15setup = do
16− Integration.deleteOutputFolder
16+ Integration.reset
17− s <- Integration.compileTestProject
18− unless s $ fail "Failed to compile .purs sources"
19− -- Integration.quitServer -- kill a eventually running psc-ide-server instance
20− _ <- Integration.startServer
21 mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]
17 mapM_ Integration.loadModuleWithDeps ["ImportsSpec", "ImportsSpec1"]
22
18
23−teardown :: IO ()
24−teardown = Integration.quitServer
25−
26withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()
19withSupportFiles :: (FilePath -> FilePath -> IO a) -> IO ()
27withSupportFiles test = do
20withSupportFiles test = do
28 pdir <- Integration.projectDirectory
21 pdir <- Integration.projectDirectory
@@ -38,7 +31,7 @@ outputFileShouldBe expectation = do
38 shouldBe (T.lines outRes) expectation
31 shouldBe (T.lines outRes) expectation
39
32
40spec :: Spec
33spec :: Spec
41−spec = beforeAll_ setup $ afterAll_ teardown $ describe "Adding imports" $ do
34+spec = beforeAll_ setup . describe "Adding imports" $ do
42 let
35 let
43 sourceFileSkeleton :: [Text] -> [Text]
36 sourceFileSkeleton :: [Text] -> [Text]
44 sourceFileSkeleton importSection =
37 sourceFileSkeleton importSection =
tests/Language/PureScript/Ide/Integration.hs+43−11
@@ -27,33 +27,36 @@ module Language.PureScript.Ide.Integration
27 , projectDirectory
27 , projectDirectory
28 , deleteFileIfExists
28 , deleteFileIfExists
29 -- sending commands
29 -- sending commands
30+ , addImport
31+ , addImplicitImport
30 , loadModule
32 , loadModule
31 , loadModuleWithDeps
33 , loadModuleWithDeps
34+ , getCwd
32 , getFlexCompletions
35 , getFlexCompletions
33 , getType
36 , getType
34− , addImport
35− , addImplicitImport
36 , rebuildModule
37 , rebuildModule
38+ , reset
37 -- checking results
39 -- checking results
38 , resultIsSuccess
40 , resultIsSuccess
39 , parseCompletions
41 , parseCompletions
40 , parseTextResult
42 , parseTextResult
41 ) where
43 ) where
42
44
43−import Control.Concurrent (threadDelay)
45+import Control.Concurrent (threadDelay)
44import Control.Exception
46import Control.Exception
45−import Control.Monad (join, when)
47+import Control.Monad (join, when)
46import Data.Aeson
48import Data.Aeson
47import Data.Aeson.Types
49import Data.Aeson.Types
48−import qualified Data.ByteString.Lazy.UTF8 as BSL
50+import qualified Data.ByteString.Lazy.UTF8 as BSL
49−import Data.Either (isRight)
51+import Data.Either (isRight)
50−import Data.Maybe (fromJust)
52+import Data.Maybe (fromJust, isNothing)
51−import qualified Data.Text as T
53+import qualified Data.Text as T
52−import qualified Data.Vector as V
54+import qualified Data.Vector as V
53import Language.PureScript.Ide.Util
55import Language.PureScript.Ide.Util
54import System.Directory
56import System.Directory
55import System.Exit
57import System.Exit
56import System.FilePath
58import System.FilePath
59+import System.IO.Error (mkIOError, userErrorType)
57import System.Process
60import System.Process
58
61
59projectDirectory :: IO FilePath
62projectDirectory :: IO FilePath
@@ -64,7 +67,9 @@ projectDirectory = do
64startServer :: IO ProcessHandle
67startServer :: IO ProcessHandle
65startServer = do
68startServer = do
66 pdir <- projectDirectory
69 pdir <- projectDirectory
70+ -- Turn off filewatching since it creates race condition in a testing environment
67− (_, _, _, procHandle) <- createProcess $ (shell "psc-ide-server") {cwd=Just pdir}
71+ (_, _, _, procHandle) <- createProcess $
72+ (shell "psc-ide-server --no-watch") {cwd = Just pdir}
68 threadDelay 500000 -- give the server 500ms to start up
73 threadDelay 500000 -- give the server 500ms to start up
69 return procHandle
74 return procHandle
70
75
@@ -74,9 +79,15 @@ stopServer = terminateProcess
74withServer :: IO a -> IO a
79withServer :: IO a -> IO a
75withServer s = do
80withServer s = do
76 _ <- startServer
81 _ <- startServer
82+ started <- tryNTimes 5 (shush <$> (try getCwd :: IO (Either SomeException String)))
83+ when (isNothing started) $
84+ throwIO (mkIOError userErrorType "psc-ide-server didn't start in time" Nothing Nothing)
77 r <- s
85 r <- s
78 quitServer
86 quitServer
79− return r
87+ pure r
88+
89+shush :: Either a b -> Maybe b
90+shush = either (const Nothing) Just
80
91
81-- project management utils
92-- project management utils
82
93
@@ -90,6 +101,16 @@ compileTestProject = do
90 }
101 }
91 isSuccess <$> waitForProcess procHandle
102 isSuccess <$> waitForProcess procHandle
92
103
104+tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)
105+tryNTimes 0 _ = pure Nothing
106+tryNTimes n action = do
107+ r <- action
108+ case r of
109+ Nothing -> do
110+ threadDelay 500000
111+ tryNTimes (n - 1) action
112+ Just a -> pure (Just a)
113+
93deleteOutputFolder :: IO ()
114deleteOutputFolder :: IO ()
94deleteOutputFolder = do
115deleteOutputFolder = do
95 odir <- fmap (</> "output") projectDirectory
116 odir <- fmap (</> "output") projectDirectory
@@ -128,6 +149,17 @@ quitServer = do
128 _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)
149 _ <- try $ sendCommand quitCommand :: IO (Either SomeException String)
129 return ()
150 return ()
130
151
152+reset :: IO ()
153+reset = do
154+ let resetCommand = object ["command" .= ("reset" :: String)]
155+ _ <- try $ sendCommand resetCommand :: IO (Either SomeException String)
156+ return ()
157+
158+getCwd :: IO String
159+getCwd = do
160+ let cwdCommand = object ["command" .= ("cwd" :: String)]
161+ sendCommand cwdCommand
162+
131loadModuleWithDeps :: String -> IO String
163loadModuleWithDeps :: String -> IO String
132loadModuleWithDeps m = sendCommand $ load [] [m]
164loadModuleWithDeps m = sendCommand $ load [] [m]
133
165
tests/Language/PureScript/Ide/MatcherSpec.hs+8−16
@@ -2,21 +2,22 @@
2
2
3module Language.PureScript.Ide.MatcherSpec where
3module Language.PureScript.Ide.MatcherSpec where
4
4
5+import Control.Monad (void)
5import Data.Text (Text)
6import Data.Text (Text)
7+import qualified Language.PureScript as P
6import Language.PureScript.Ide.Integration
8import Language.PureScript.Ide.Integration
7import Language.PureScript.Ide.Matcher
9import Language.PureScript.Ide.Matcher
8import Language.PureScript.Ide.Types
10import Language.PureScript.Ide.Types
9−import qualified Language.PureScript as P
10import Test.Hspec
11import Test.Hspec
11
12
12value :: Text -> ExternDecl
13value :: Text -> ExternDecl
13value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)
14value s = ValueDeclaration s $ P.TypeWildcard $ P.SourceSpan "" (P.SourcePos 0 0) (P.SourcePos 0 0)
14
15
15completions :: [Match]
16completions :: [Match]
16−completions = [
17+completions =
17− Match "" $ value "firstResult",
18+ [ Match "" (value "firstResult")
18− Match "" $ value "secondResult",
19+ , Match "" (value "secondResult")
19− Match "" $ value "fiult"
20+ , Match "" (value "fiult")
20 ]
21 ]
21
22
22mkResult :: [Int] -> [Match]
23mkResult :: [Int] -> [Match]
@@ -26,15 +27,7 @@ runFlex :: Text -> [Match]
26runFlex s = runMatcher (flexMatcher s) completions
27runFlex s = runMatcher (flexMatcher s) completions
27
28
28setup :: IO ()
29setup :: IO ()
29−setup = do
30− deleteOutputFolder
31− _ <- compileTestProject
32− _ <- startServer
33− _ <- loadModuleWithDeps "Main"
30+setup = reset *> void (loadModuleWithDeps "Main")
34− return ()
35−
36−teardown :: IO ()
37−teardown = quitServer
38
31
39spec :: Spec
32spec :: Spec
40spec = do
33spec = do
@@ -46,8 +39,7 @@ spec = do
46 it "scores short matches higher and sorts accordingly" $
39 it "scores short matches higher and sorts accordingly" $
47 runFlex "filt" `shouldBe` mkResult [2, 0]
40 runFlex "filt" `shouldBe` mkResult [2, 0]
48
41
49− beforeAll_ setup $ afterAll_ teardown $
50− describe "Integration Tests: Flex Matcher" $ do
42+ beforeAll_ setup . describe "Integration Tests: Flex Matcher" $ do
51 it "doesn't match on an empty string" $ do
43 it "doesn't match on an empty string" $ do
52 cs <- getFlexCompletions ""
44 cs <- getFlexCompletions ""
53 cs `shouldBe` []
45 cs `shouldBe` []
tests/Language/PureScript/Ide/RebuildSpec.hs+2−17
@@ -1,22 +1,8 @@
1module Language.PureScript.Ide.RebuildSpec where
1module Language.PureScript.Ide.RebuildSpec where
2
2
3−import Control.Monad
4import qualified Language.PureScript.Ide.Integration as Integration
3import qualified Language.PureScript.Ide.Integration as Integration
5−import Test.Hspec
6−
7import System.FilePath
4import System.FilePath
8−
5+import Test.Hspec
9−compile :: IO ()
10−compile = do
11− Integration.deleteOutputFolder
12− s <- Integration.compileTestProject
13− unless s $ fail "Failed to compile .purs sources"
14−
15−teardown :: IO ()
16−teardown = Integration.quitServer
17−
18−restart :: IO ()
19−restart = Integration.quitServer *> (void Integration.startServer)
20
6
21shouldBeSuccess :: String -> IO ()
7shouldBeSuccess :: String -> IO ()
22shouldBeSuccess = shouldBe True . Integration.resultIsSuccess
8shouldBeSuccess = shouldBe True . Integration.resultIsSuccess
@@ -25,8 +11,7 @@ shouldBeFailure :: String -> IO ()
25shouldBeFailure = shouldBe False . Integration.resultIsSuccess
11shouldBeFailure = shouldBe False . Integration.resultIsSuccess
26
12
27spec :: Spec
13spec :: Spec
28−spec = beforeAll_ compile $ afterAll_ teardown $ before_ restart $ do
29− describe "Rebuilding single modules" $ do
14+spec = before_ Integration.reset $ describe "Rebuilding single modules" $ do
30 it "rebuilds a correct module without dependencies successfully" $ do
15 it "rebuilds a correct module without dependencies successfully" $ do
31 _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"
16 _ <- Integration.loadModuleWithDeps "RebuildSpecSingleModule"
32 pdir <- Integration.projectDirectory
17 pdir <- Integration.projectDirectory
tests/TestCompiler.hs+17−8
@@ -176,10 +176,12 @@ compile
176 :: [(P.Module, P.ExternsFile)]
176 :: [(P.Module, P.ExternsFile)]
177 -> [FilePath]
177 -> [FilePath]
178 -> M.Map P.ModuleName FilePath
178 -> M.Map P.ModuleName FilePath
179+ -> ([P.Module] -> IO ())
179 -> IO (Either P.MultipleErrors [P.ExternsFile])
180 -> IO (Either P.MultipleErrors [P.ExternsFile])
180−compile supportExterns inputFiles foreigns = silence $ runTest $ do
181+compile supportExterns inputFiles foreigns check = silence $ runTest $ do
181 fs <- liftIO $ readInput inputFiles
182 fs <- liftIO $ readInput inputFiles
182 ms <- P.parseModulesFromFiles id fs
183 ms <- P.parseModulesFromFiles id fs
184+ liftIO (check (map snd ms))
183 let actions = makeActions foreigns
185 let actions = makeActions foreigns
184 case ms of
186 case ms of
185 [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)
187 [singleModule] -> pure <$> P.rebuildModule actions (map snd supportExterns) (snd singleModule)
@@ -189,10 +191,11 @@ assert
189 :: [(P.Module, P.ExternsFile)]
191 :: [(P.Module, P.ExternsFile)]
190 -> [FilePath]
192 -> [FilePath]
191 -> M.Map P.ModuleName FilePath
193 -> M.Map P.ModuleName FilePath
194+ -> ([P.Module] -> IO ())
192 -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))
195 -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))
193 -> Expectation
196 -> Expectation
194−assert supportExterns inputFiles foreigns f = do
197+assert supportExterns inputFiles foreigns check f = do
195− e <- compile supportExterns inputFiles foreigns
198+ e <- compile supportExterns inputFiles foreigns check
196 maybeErr <- f e
199 maybeErr <- f e
197 maybe (return ()) expectationFailure maybeErr
200 maybe (return ()) expectationFailure maybeErr
198
201
@@ -201,8 +204,8 @@ assertCompiles
201 -> [FilePath]
204 -> [FilePath]
202 -> M.Map P.ModuleName FilePath
205 -> M.Map P.ModuleName FilePath
203 -> Expectation
206 -> Expectation
204−assertCompiles supportExterns inputFiles foreigns = do
207+assertCompiles supportExterns inputFiles foreigns =
205− assert supportExterns inputFiles foreigns $ \e ->
208+ assert supportExterns inputFiles foreigns checkMain $ \e ->
206 case e of
209 case e of
207 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs
210 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs
208 Right _ -> do
211 Right _ -> do
@@ -217,6 +220,10 @@ assertCompiles supportExterns inputFiles foreigns = do
217 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
220 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
218 Just (ExitFailure _, _, err) -> return $ Just err
221 Just (ExitFailure _, _, err) -> return $ Just err
219 Nothing -> return $ Just "Couldn't find node.js executable"
222 Nothing -> return $ Just "Couldn't find node.js executable"
223+ where
224+ checkMain ms =
225+ unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)
226+ (fail "Main module missing")
220
227
221assertDoesNotCompile
228assertDoesNotCompile
222 :: [(P.Module, P.ExternsFile)]
229 :: [(P.Module, P.ExternsFile)]
@@ -224,10 +231,10 @@ assertDoesNotCompile
224 -> M.Map P.ModuleName FilePath
231 -> M.Map P.ModuleName FilePath
225 -> [String]
232 -> [String]
226 -> Expectation
233 -> Expectation
227−assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith = do
234+assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith =
228− assert supportExterns inputFiles foreigns $ \e ->
235+ assert supportExterns inputFiles foreigns noPreCheck $ \e ->
229 case e of
236 case e of
230− Left errs -> do
237+ Left errs ->
231 return $ if null shouldFailWith
238 return $ if null shouldFailWith
232 then Just $ "shouldFailWith declaration is missing (errors were: "
239 then Just $ "shouldFailWith declaration is missing (errors were: "
233 ++ show (map P.errorCode (P.runMultipleErrors errs))
240 ++ show (map P.errorCode (P.runMultipleErrors errs))
@@ -237,6 +244,8 @@ assertDoesNotCompile supportExterns inputFiles foreigns shouldFailWith = do
237 return $ Just "Should not have compiled"
244 return $ Just "Should not have compiled"
238
245
239 where
246 where
247+ noPreCheck = const (return ())
248+
240 checkShouldFailWith expected errs =
249 checkShouldFailWith expected errs =
241 let actual = map P.errorCode $ P.runMultipleErrors errs
250 let actual = map P.errorCode $ P.runMultipleErrors errs
242 in if sort expected == sort actual
251 in if sort expected == sort actual
tests/TestPscIde.hs+9−2
@@ -1,7 +1,14 @@
1module TestPscIde where
1module TestPscIde where
2
2
3+import Control.Monad (unless)
4+import Language.PureScript.Ide.Integration
3import qualified PscIdeSpec
5import qualified PscIdeSpec
4−import Test.Hspec
6+import Test.Hspec
5
7
6main :: IO ()
8main :: IO ()
9+main = do
10+ deleteOutputFolder
11+ s <- compileTestProject
12+ unless s $ fail "Failed to compile .purs sources"
13+
7−main = hspec PscIdeSpec.spec
14+ withServer (hspec PscIdeSpec.spec)
tests/TestPsci.hs+11−21
@@ -6,10 +6,8 @@ module TestPsci where
6import Prelude ()
6import Prelude ()
7import Prelude.Compat
7import Prelude.Compat
8
8
9−import Control.Monad.Trans.State.Strict (runStateT)
9+import Control.Monad.Trans.State.Strict (evalStateT)
10−import Control.Monad (when, forM)
10+import Control.Monad (when)
11−import Control.Monad.Writer.Strict (runWriterT)
12−import Control.Monad.Trans.Except (runExceptT)
13
11
14import Data.List (sort)
12import Data.List (sort)
15
13
@@ -17,16 +15,15 @@ import System.Exit (exitFailure)
17import System.Console.Haskeline
15import System.Console.Haskeline
18import System.FilePath ((</>))
16import System.FilePath ((</>))
19import System.Directory (getCurrentDirectory)
17import System.Directory (getCurrentDirectory)
20−import System.IO.UTF8 (readUTF8File)
21import qualified System.FilePath.Glob as Glob
18import qualified System.FilePath.Glob as Glob
22
19
23import Test.HUnit
20import Test.HUnit
24
21
25import qualified Language.PureScript as P
22import qualified Language.PureScript as P
26
23
27−import PSCi.Module (loadAllModules)
24+import Language.PureScript.Interactive.Module (loadAllModules)
28−import PSCi.Completion
25+import Language.PureScript.Interactive.Completion
29−import PSCi.Types
26+import Language.PureScript.Interactive.Types
30
27
31import TestUtils (supportModules)
28import TestUtils (supportModules)
32
29
@@ -49,11 +46,10 @@ completionTests =
49completionTestData :: [(String, [String])]
46completionTestData :: [(String, [String])]
50completionTestData =
47completionTestData =
51 -- basic directives
48 -- basic directives
52− [ (":h", [":help"])
49+ [ (":h", [":help"])
53 , (":re", [":reset"])
50 , (":re", [":reset"])
54− , (":q", [":quit"])
51+ , (":q", [":quit"])
55− , (":mo", [":module"])
56− , (":b", [":browse"])
52+ , (":b", [":browse"])
57
53
58 -- :browse should complete module names
54 -- :browse should complete module names
59 , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
55 , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
@@ -63,10 +59,6 @@ completionTestData =
63 , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
59 , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
64 , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
60 , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
65
61
66− -- :load, :module should complete file paths
67− , (":l tests/support/psci/", [":l tests/support/psci/Sample.purs"])
68− , (":module tests/support/psci/", [":module tests/support/psci/Sample.purs"])
69−
70 -- :quit, :help, :reset should not complete
62 -- :quit, :help, :reset should not complete
71 , (":help ", [])
63 , (":help ", [])
72 , (":quit ", [])
64 , (":quit ", [])
@@ -122,7 +114,7 @@ assertCompletedOk (line, expecteds) = do
122runCM :: CompletionM a -> IO a
114runCM :: CompletionM a -> IO a
123runCM act = do
115runCM act = do
124 psciState <- getPSCiState
116 psciState <- getPSCiState
125− fmap fst (runStateT (liftCompletionM act) psciState)
117+ evalStateT (liftCompletionM act) psciState
126
118
127getPSCiState :: IO PSCiState
119getPSCiState :: IO PSCiState
128getPSCiState = do
120getPSCiState = do
@@ -130,17 +122,15 @@ getPSCiState = do
130 let supportDir = cwd </> "tests" </> "support" </> "bower_components"
122 let supportDir = cwd </> "tests" </> "support" </> "bower_components"
131 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir
123 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir
132 pursFiles <- supportFiles "purs"
124 pursFiles <- supportFiles "purs"
133− jsFiles <- supportFiles "js"
134
125
135 modulesOrFirstError <- loadAllModules pursFiles
126 modulesOrFirstError <- loadAllModules pursFiles
136− foreignFiles <- forM jsFiles (\f -> (f,) <$> readUTF8File f)
137− Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
138 case modulesOrFirstError of
127 case modulesOrFirstError of
139 Left err ->
128 Left err ->
140 print err >> exitFailure
129 print err >> exitFailure
141 Right modules ->
130 Right modules ->
142 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
131 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
132+ dummyExterns = P.internalError "TestPsci: dummyExterns should not be used"
143− in return (mkPSCiState imports modules foreigns [] [])
133+ in return (PSCiState imports [] (zip (map snd modules) (repeat dummyExterns)))
144
134
145controlMonadSTasST :: ImportedModule
135controlMonadSTasST :: ImportedModule
146controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
136controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))