git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
big psci overhaul: refactoring, completion, tests
e558764Harry Garrood
.travis.yml+13−2
compare with golang
unifiedsplit
@@ -1,5 +1,16 @@
1−language: haskell
1+env:
2−ghc: 7.8
2+ - CABALVER=1.22 GHCVER=7.8.3 SUITE=tests
3+ - CABALVER=1.22 GHCVER=7.8.3 SUITE=psci-tests
4+before_install:
5+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc
6+ - travis_retry sudo apt-get update
7+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
8+ - export PATH="/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.cabal/bin:$PATH"
9+install:
10+ - cabal --version
11+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
12+ - travis_retry cabal update
13+ - cabal install --only-dependencies --enable-tests --enable-benchmarks
3script:
14script:
4 - ./travis-script.sh
15 - ./travis-script.sh
5after_script:
16after_script:
psci/Commands.hsdeleted−78
@@ -1,78 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Commands
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Commands for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Commands where
17−
18−import Language.PureScript
19−
20−-- |
21−-- Valid Meta-commands for PSCI
22−--
23−data Command
24− -- |
25− -- A purescript expression
26− --
27− = Expression Expr
28− -- |
29− -- Show the help command
30− --
31− | Help
32− -- |
33− -- Import a module from a loaded file
34− --
35− | Import ImportedModule
36− -- |
37− -- Browse a module
38− --
39− | Browse ModuleName
40− -- |
41− -- Load a file for use with importing
42− --
43− | LoadFile FilePath
44− -- |
45− -- Exit PSCI
46− --
47− | Quit
48− -- |
49− -- Reset the state of the REPL
50− --
51− | Reset
52− -- |
53− -- Add some declarations to the current evaluation context.
54− --
55− | Decls [Declaration]
56− -- |
57− -- Find the type of an expression
58− --
59− | TypeOf Expr
60− -- |
61− -- Find the kind of an expression
62− --
63− | KindOf Type
64− -- |
65− -- Show command
66− --
67− | Show String
68−
69−-- | All of the data that is contained by an ImportDeclaration in the AST.
70−-- That is:
71−--
72−-- * A module name, the name of the module which is being imported
73−-- * An ImportDeclarationType which specifies whether there is an explicit
74−-- import list, a hiding list, or neither.
75−-- * If the module is imported qualified, its qualified name in the importing
76−-- module. Otherwise, Nothing.
77−--
78−type ImportedModule = (ModuleName, ImportDeclarationType, Maybe ModuleName)
psci/Completion.hsnew file+232
@@ -0,0 +1,232 @@
1+module Completion where
2+
3+import Data.Maybe (mapMaybe)
4+import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
5+import Data.Char (isUpper)
6+import Data.Function (on)
7+import Data.Traversable (traverse)
8+
9+import Control.Applicative ((<$>), (<*>))
10+import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
11+import Control.Monad.Trans.State.Strict
12+
13+import System.Console.Haskeline
14+
15+import qualified Language.PureScript as P
16+import qualified Language.PureScript.Names as N
17+
18+import qualified Directive as D
19+import Types
20+
21+-- Completions may read the state, but not modify it.
22+type CompletionM = ReaderT PSCiState IO
23+
24+-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
25+liftCompletionM :: CompletionM a -> StateT PSCiState IO a
26+liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
27+
28+-- Haskeline completions
29+
30+data CompletionContext
31+ = CtxDirective String
32+ | CtxFilePath String
33+ | CtxModule
34+ | CtxIdentifier
35+ | CtxType
36+ | CtxFixed String
37+ deriving (Show)
38+
39+-- |
40+-- Loads module, function, and file completions.
41+--
42+completion :: CompletionFunc (StateT PSCiState IO)
43+completion = liftCompletionM . completion'
44+
45+completion' :: CompletionFunc CompletionM
46+completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
47+
48+-- |
49+-- Decide what kind of completion we need based on input. This function expects
50+-- a list of complete words (to the left of the cursor) as the first argument,
51+-- and the current word as the second argument.
52+completionContext :: [String] -> String -> [CompletionContext]
53+completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
54+completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
55+completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
56+completionContext _ _ = [CtxIdentifier]
57+
58+completeDirective :: [String] -> String -> [CompletionContext]
59+completeDirective ws w =
60+ case ws of
61+ [] -> [CtxDirective w]
62+ [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
63+ -- only offer completions if the directive is unambiguous
64+ Just [dir'] -> directiveArg w dir'
65+ _ -> []
66+
67+ -- All directives take exactly one argument. If we haven't yet matched,
68+ -- that means one argument has already been supplied. So don't complete
69+ -- any others.
70+ _ -> []
71+
72+directiveArg :: String -> Directive -> [CompletionContext]
73+directiveArg _ Browse = [CtxModule]
74+directiveArg w Load = [CtxFilePath w]
75+directiveArg _ Quit = []
76+directiveArg _ Reset = []
77+directiveArg _ Help = []
78+directiveArg _ Show = map CtxFixed replQueryStrings
79+directiveArg _ Type = [CtxIdentifier]
80+directiveArg _ Kind = [CtxType]
81+
82+completeImport :: [String] -> String -> [CompletionContext]
83+completeImport ws w' =
84+ case (ws, w') of
85+ (["import"], w) | headSatisfies isUpper w -> [CtxModule]
86+ (["import"], _) -> [CtxModule, CtxFixed "qualified"]
87+ (["import", "qualified"], _) -> [CtxModule]
88+ _ -> []
89+
90+headSatisfies :: (a -> Bool) -> [a] -> Bool
91+headSatisfies p str =
92+ case str of
93+ (c:_) -> p c
94+ _ -> False
95+
96+-- | Callback for Haskeline's `completeWordWithPrev`.
97+-- Expects:
98+-- * Line contents to the left of the word, reversed
99+-- * Word to be completed
100+findCompletions :: String -> String -> CompletionM [Completion]
101+findCompletions prev word = do
102+ let ctx = completionContext (words (reverse prev)) word
103+ completions <- concat <$> traverse getCompletions ctx
104+ return $ sortBy directivesFirst completions
105+ where
106+ getCompletions :: CompletionContext -> CompletionM [Completion]
107+ getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
108+
109+ prefixedBy :: String -> String -> Maybe Completion
110+ prefixedBy w cand = if w `isPrefixOf` cand
111+ then Just (simpleCompletion cand)
112+ else Nothing
113+
114+getCompletion :: CompletionContext -> CompletionM [Either String Completion]
115+getCompletion ctx =
116+ case ctx of
117+ CtxFilePath f -> map Right <$> listFiles f
118+ CtxModule -> map Left <$> getModuleNames
119+ CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
120+ CtxType -> map Left <$> getTypeNames
121+ CtxFixed str -> return [Left str]
122+ CtxDirective d -> return (map Left (completeDirectives d))
123+
124+ where
125+ completeDirectives :: String -> [String]
126+ completeDirectives = map (':' :) . D.directiveStringsFor
127+
128+
129+getLoadedModules :: CompletionM [P.Module]
130+getLoadedModules = asks (map snd . psciLoadedModules)
131+
132+getImportedModules :: CompletionM [ImportedModule]
133+getImportedModules = asks psciImportedModules
134+
135+getModuleNames :: CompletionM [String]
136+getModuleNames = moduleNames <$> getLoadedModules
137+
138+mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
139+mapLoadedModulesAndQualify f = do
140+ ms <- getLoadedModules
141+ let argPairs = do m <- ms
142+ fm <- f m
143+ return (m, fm)
144+ concat <$> traverse (uncurry getAllQualifications) argPairs
145+
146+getIdentNames :: CompletionM [String]
147+getIdentNames = mapLoadedModulesAndQualify identNames
148+
149+getDctorNames :: CompletionM [String]
150+getDctorNames = mapLoadedModulesAndQualify dctorNames
151+
152+getTypeNames :: CompletionM [String]
153+getTypeNames = mapLoadedModulesAndQualify typeDecls
154+
155+-- | Given a module and a declaration in that module, return all possible ways
156+-- it could have been referenced given the current PSCiState - including fully
157+-- qualified, qualified using an alias, and unqualified.
158+getAllQualifications :: (Show a) => P.Module -> (a, P.Declaration) -> CompletionM [String]
159+getAllQualifications m (declName, decl) = do
160+ imports <- getAllImportsOf m
161+ let fullyQualified = qualifyWith (Just (P.getModuleName m))
162+ let otherQuals = nub (concatMap qualificationsUsing imports)
163+ return $ fullyQualified : otherQuals
164+ where
165+ qualifyWith mMod = show (P.Qualified mMod declName)
166+ referencedBy refs = P.isExported (Just refs) decl
167+
168+ qualificationsUsing (_, importType, asQ') =
169+ let q = qualifyWith asQ'
170+ in case importType of
171+ P.Implicit -> [q]
172+ P.Explicit refs -> if referencedBy refs
173+ then [q]
174+ else []
175+ P.Hiding refs -> if referencedBy refs
176+ then []
177+ else [q]
178+
179+
180+-- | Returns all the ImportedModule values referring to imports of a particular
181+-- module.
182+getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
183+getAllImportsOf = asks . allImportsOf
184+
185+nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
186+nubOnFst = nubBy ((==) `on` fst)
187+
188+typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]
189+typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
190+ where
191+ getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
192+ getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
193+ getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
194+ getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
195+ getTypeName _ = Nothing
196+
197+identNames :: P.Module -> [(N.Ident, P.Declaration)]
198+identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations
199+ where
200+ getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)
201+ getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)
202+ getDeclName d@(P.ExternDeclaration _ ident _ _) = Just (ident, d)
203+ getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d
204+ getDeclName _ = Nothing
205+
206+dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
207+dctorNames m = nubOnFst $ concatMap dctors dnames
208+ where
209+ getDataDeclName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
210+ getDataDeclName d@(P.DataDeclaration _ name _ _) = Just (name, d)
211+ getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d
212+ getDataDeclName _ = Nothing
213+
214+ dnames :: [(N.ProperName, P.Declaration)]
215+ dnames = (mapMaybe getDataDeclName onlyDataDecls)
216+
217+ onlyDataDecls :: [P.Declaration]
218+ onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
219+
220+ dctors :: (N.ProperName, P.Declaration) -> [(N.ProperName, P.Declaration)]
221+ dctors (name, decl) = map (\n -> (n, decl)) (P.exportedDctors m name)
222+
223+moduleNames :: [P.Module] -> [String]
224+moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
225+
226+directivesFirst :: Completion -> Completion -> Ordering
227+directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
228+ where
229+ go (':' : xs) (':' : ys) = compare xs ys
230+ go (':' : _) _ = LT
231+ go _ (':' : _) = GT
232+ go xs ys = compare xs ys
psci/Directive.hs+71−37
@@ -15,46 +15,85 @@
15
15
16module Directive where
16module Directive where
17
17
18+import Data.Maybe (fromJust, listToMaybe)
18−import Data.List (nub, isPrefixOf)
19+import Data.List (isPrefixOf)
19−
20+import Data.Tuple (swap)
20−data Directive
21+
21− = Help
22+import Types
22− | Quit
23− | Reset
24− | Browse
25− | Load
26− | Type
27− | Kind
28− | Show
29− deriving Eq
30
23
31-- |
24-- |
32−-- Maps given directive to relating command strings.
25+-- List of all avaliable directives.
33--
26--
34−commands :: Directive -> [String]
27+directives :: [Directive]
35−commands Help = ["?", "help"]
28+directives = map fst directiveStrings
36−commands Quit = ["quit"]
37−commands Reset = ["reset"]
38−commands Browse = ["browse"]
39−commands Load = ["load", "module"]
40−commands Type = ["type"]
41−commands Kind = ["kind"]
42−commands Show = ["show"]
43
29
44-- |
30-- |
45−-- Tries to parse given string into a directive.
31+-- A mapping of directives to the different strings that can be used to invoke
32+-- them.
46--
33--
47−parseDirective :: String -> Maybe Directive
34+directiveStrings :: [(Directive, [String])]
48−parseDirective cmd =
35+directiveStrings =
49− case filter (matches . snd) mapping of
36+ [ (Help , ["?", "help"])
50− [directive] -> Just $ fst directive
37+ , (Quit , ["quit"])
51− _ -> Nothing
38+ , (Reset , ["reset"])
39+ , (Browse , ["browse"])
40+ , (Load , ["load", "module"])
41+ , (Type , ["type"])
42+ , (Kind , ["kind"])
43+ , (Show , ["show"])
44+ ]
45+
46+-- |
47+-- Like directiveStrings, but the other way around.
48+--
49+directiveStrings' :: [(String, Directive)]
50+directiveStrings' = concatMap go directiveStrings
52 where
51 where
53− mapping :: [(Directive, [String])]
52+ go (dir, strs) = map (\s -> (s, dir)) strs
54− mapping = zip directives (map commands directives)
55
53
54+-- |
55+-- List of all directive strings.
56+--
56− matches :: [String] -> Bool
57+strings :: [String]
57− matches = any (cmd `isPrefixOf`)
58+strings = concatMap snd directiveStrings
59+
60+-- |
61+-- Returns all possible string representations of a directive.
62+--
63+stringsFor :: Directive -> [String]
64+stringsFor d = fromJust (lookup d directiveStrings)
65+
66+-- |
67+-- Returns the default string representation of a directive.
68+--
69+stringFor :: Directive -> String
70+stringFor = head . stringsFor
71+
72+-- |
73+-- Returns the list of directives which could be expanded from the string
74+-- argument, together with the string alias that matched.
75+--
76+directivesFor' :: String -> [(Directive, String)]
77+directivesFor' str = go directiveStrings'
78+ where
79+ go = map swap . filter ((str `isPrefixOf`) . fst)
80+
81+directivesFor :: String -> [Directive]
82+directivesFor = map fst . directivesFor'
83+
84+directiveStringsFor :: String -> [String]
85+directiveStringsFor = map snd . directivesFor'
86+
87+parseDirective :: String -> Maybe Directive
88+parseDirective = listToMaybe . directivesFor
89+
90+-- |
91+-- True if the given directive takes an argument, false otherwise.
92+hasArgument :: Directive -> Bool
93+hasArgument Help = False
94+hasArgument Quit = False
95+hasArgument Reset = False
96+hasArgument _ = True
58
97
59-- |
98-- |
60-- The help menu.
99-- The help menu.
@@ -72,8 +111,3 @@ help =
72 , (Show, "loaded", "Show loaded modules")
111 , (Show, "loaded", "Show loaded modules")
73 ]
112 ]
74
113
75−-- |
76−-- List of all avaliable directives.
77−--
78−directives :: [Directive]
79−directives = nub . map (\(dir, _, _) -> dir) $ help
psci/Main.hs → psci/PSCi.hsrenamed+42−216
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Main
3+-- Module : PSCi
4-- Copyright : (c) Phil Freeman 2013
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
5-- License : MIT
6--
6--
@@ -19,14 +19,12 @@
19{-# LANGUAGE GeneralizedNewtypeDeriving #-}
19{-# LANGUAGE GeneralizedNewtypeDeriving #-}
20{-# LANGUAGE RecordWildCards #-}
20{-# LANGUAGE RecordWildCards #-}
21
21
22−module Main where
22+module PSCi where
23
23
24import Data.Foldable (traverse_)
24import Data.Foldable (traverse_)
25−import Data.List (intercalate, isPrefixOf, nub, sortBy, sort)
25+import Data.List (intercalate, nub, sort)
26−import Data.Maybe (mapMaybe)
27import Data.Traversable (traverse)
26import Data.Traversable (traverse)
28import Data.Version (showVersion)
27import Data.Version (showVersion)
29−import Data.Char (isSpace)
30import qualified Data.Map as M
28import qualified Data.Map as M
31
29
32import Control.Applicative
30import Control.Applicative
@@ -50,70 +48,21 @@ import System.Process (readProcessWithExitCode)
50import qualified Text.Parsec as Par (ParseError)
48import qualified Text.Parsec as Par (ParseError)
51
49
52import qualified Language.PureScript as P
50import qualified Language.PureScript as P
53−import qualified Language.PureScript.AST as D
54import qualified Language.PureScript.Names as N
51import qualified Language.PureScript.Names as N
55import qualified Paths_purescript as Paths
52import qualified Paths_purescript as Paths
56
53
57−import qualified Commands as C
58import qualified Directive as D
54import qualified Directive as D
59−import Parser
55+import Parser (parseCommand)
56+import Completion (completion)
57+import Types
60
58
61−data PSCiOptions = PSCiOptions
62− { psciMultiLineMode :: Bool
63− , psciInputFile :: [FilePath]
64− , psciInputNodeFlags :: [String]
65− }
66−
67−-- |
68−-- The PSCI state.
69−-- Holds a list of imported modules, loaded files, and partial let bindings.
70−-- The let bindings are partial,
71−-- because it makes more sense to apply the binding to the final evaluated expression.
72−--
73−data PSCiState = PSCiState
74− { psciImportedFilenames :: [FilePath]
75− , psciImportedModules :: [C.ImportedModule]
76− , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
77− , psciLetBindings :: [P.Declaration]
78− , psciNodeFlags :: [String]
79− }
80−
81−psciImportedModuleNames :: PSCiState -> [P.ModuleName]
82−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
83− map (\(mn, _, _) -> mn) is
84−
85−-- State helpers
86−
87−-- |
88−-- Updates the state to have more imported modules.
89−--
90−updateImportedFiles :: FilePath -> PSCiState -> PSCiState
91−updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
92−
93−-- |
94−-- Updates the state to have more imported modules.
95−--
96−updateImportedModules :: C.ImportedModule -> PSCiState -> PSCiState
97−updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
98−
99−-- |
100−-- Updates the state to have more loaded files.
101−--
102−updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
103−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
104−
105−-- |
106−-- Updates the state to have more let bindings.
107−--
108−updateLets :: [P.Declaration] -> PSCiState -> PSCiState
109−updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
110
59
111-- File helpers
60-- File helpers
112-- |
61-- |
113-- Load the necessary modules.
62-- Load the necessary modules.
114--
63--
115−defaultImports :: [C.ImportedModule]
64+defaultImports :: [ImportedModule]
116−defaultImports = [(P.ModuleName [P.ProperName "Prelude"], D.Implicit, Nothing)]
65+defaultImports = [(P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
117
66
118-- |
67-- |
119-- Locates the node executable.
68-- Locates the node executable.
@@ -177,7 +126,7 @@ helpMessage :: String
177helpMessage = "The following commands are available:\n\n " ++
126helpMessage = "The following commands are available:\n\n " ++
178 intercalate "\n " (map line D.help)
127 intercalate "\n " (map line D.help)
179 where
128 where
180− line :: (D.Directive, String, String) -> String
129+ line :: (Directive, String, String) -> String
181 line (dir, arg, desc) = intercalate " "
130 line (dir, arg, desc) = intercalate " "
182 [ cmd
131 [ cmd
183 , replicate (11 - length cmd) ' '
132 , replicate (11 - length cmd) ' '
@@ -185,7 +134,7 @@ helpMessage = "The following commands are available:\n\n " ++
185 , replicate (11 - length arg) ' '
134 , replicate (11 - length arg) ' '
186 , desc
135 , desc
187 ]
136 ]
188− where cmd = ":" ++ head (D.commands dir)
137+ where cmd = ":" ++ D.stringFor dir
189
138
190-- |
139-- |
191-- The welcome prologue.
140-- The welcome prologue.
@@ -208,129 +157,6 @@ prologueMessage = intercalate "\n"
208quitMessage :: String
157quitMessage :: String
209quitMessage = "See ya!"
158quitMessage = "See ya!"
210
159
211−-- Haskeline completions
212−
213−data CompletionContext = Command String | FilePath String | Module | Identifier
214− | Type | Fixed [String] | Multiple [CompletionContext]
215− deriving (Show)
216−
217−-- |
218−-- Decide what kind of completion we need based on input.
219−completionContext :: String -> String -> Maybe CompletionContext
220−completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]
221−completionContext (':' : cmd) word =
222− case D.parseDirective dstr of
223− Just directive | dstr `elem` D.commands directive -> context directive
224− _ -> Just $ Command cmd
225− where
226− dstr :: String
227− dstr = takeWhile (not . isSpace) cmd
228−
229− context :: D.Directive -> Maybe CompletionContext
230− context D.Browse = Just Module
231− context D.Load = Just $ FilePath word
232− context D.Quit = Nothing
233− context D.Reset = Nothing
234− context D.Help = Nothing
235− context D.Show = Just $ Fixed ["import", "loaded"]
236− context D.Type = Just Identifier
237− context D.Kind = Just Type
238−completionContext _ _ = Just Identifier
239−
240−-- |
241−-- Loads module, function, and file completions.
242−--
243−completion :: CompletionFunc (StateT PSCiState IO)
244−completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
245− where
246− findCompletions :: String -> String -> StateT PSCiState IO [Completion]
247− findCompletions prev word = do
248− let ctx = completionContext ((dropWhile isSpace (reverse prev)) ++ word) word
249− completions <- case ctx of
250− Nothing -> return []
251− (Just c) -> (mapMaybe $ either (\cand -> if word `isPrefixOf` cand
252− then Just $ simpleCompletion cand
253− else Nothing) Just)
254− <$> getCompletion c
255− return $ sortBy sorter completions
256−
257− getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]
258− getCompletion (FilePath f) = (map Right) <$> listFiles f
259− getCompletion Module = (map Left) <$> getModuleNames
260− getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)
261− getCompletion Type = (map Left) <$> getTypeNames
262− getCompletion (Fixed list) = return $ (map Left) list
263− getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts
264− getCompletion (Command cmd) = return . map (Left . (":" ++)) . nub $ matching
265− where
266− matching :: [String]
267− matching = filter (isPrefixOf cmd) . concatMap (D.commands) $ D.directives
268−
269− getLoadedModules :: StateT PSCiState IO [P.Module]
270− getLoadedModules = map snd . psciLoadedModules <$> get
271−
272− getModuleNames :: StateT PSCiState IO [String]
273− getModuleNames = moduleNames <$> getLoadedModules
274−
275− mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [a]) -> StateT PSCiState IO [String]
276− mapLoadedModulesAndQualify f = do
277− ms <- getLoadedModules
278− q <- sequence [qualifyIfNeeded m (f m) | m <- ms]
279− return $ concat q
280−
281− getIdentNames :: StateT PSCiState IO [String]
282− getIdentNames = mapLoadedModulesAndQualify identNames
283−
284− getDctorNames :: StateT PSCiState IO [String]
285− getDctorNames = mapLoadedModulesAndQualify dctorNames
286−
287− getTypeNames :: StateT PSCiState IO [String]
288− getTypeNames = mapLoadedModulesAndQualify typeDecls
289−
290− qualifyIfNeeded :: (Show a) => P.Module -> [a] -> StateT PSCiState IO [String]
291− qualifyIfNeeded m decls = do
292− let name = P.getModuleName m
293− imported <- psciImportedModuleNames <$> get
294− let qualified = map (P.Qualified $ Just name) decls
295− if name `elem` imported then
296− return $ map show $ qualified ++ (map (P.Qualified Nothing) decls)
297− else
298− return $ map show qualified
299−
300− typeDecls :: P.Module -> [N.ProperName]
301− typeDecls m = mapMaybe getTypeName $ filter P.isDataDecl (P.exportedDeclarations m)
302− where getTypeName :: P.Declaration -> Maybe N.ProperName
303− getTypeName (P.TypeSynonymDeclaration name _ _) = Just name
304− getTypeName (P.DataDeclaration _ name _ _) = Just name
305− getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
306− getTypeName _ = Nothing
307−
308− identNames :: P.Module -> [N.Ident]
309− identNames (P.Module _ _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]
310− where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
311− getDeclName exts decl@(P.ValueDeclaration ident _ _ _) | P.isExported exts decl = Just ident
312− getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident
313− getDeclName exts (P.PositionedDeclaration _ _ d) = getDeclName exts d
314− getDeclName _ _ = Nothing
315−
316− dctorNames :: P.Module -> [N.ProperName]
317− dctorNames m = nub $ concat $ map (P.exportedDctors m) dnames
318− where getDataDeclName :: P.Declaration -> Maybe N.ProperName
319− getDataDeclName (P.DataDeclaration _ name _ _) = Just name
320− getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d
321− getDataDeclName _ = Nothing
322−
323− dnames :: [N.ProperName]
324− dnames = (mapMaybe getDataDeclName onlyDataDecls)
325−
326− onlyDataDecls :: [P.Declaration]
327− onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
328−
329− moduleNames :: [P.Module] -> [String]
330− moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
331−
332− sorter :: Completion -> Completion -> Ordering
333− sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2
334
160
335-- Compilation
161-- Compilation
336
162
@@ -407,7 +233,7 @@ createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
407 in
233 in
408 P.Module [] moduleName (importDecl `map` imports) Nothing
234 P.Module [] moduleName (importDecl `map` imports) Nothing
409
235
410−importDecl :: C.ImportedModule -> P.Declaration
236+importDecl :: ImportedModule -> P.Declaration
411importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
237importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
412
238
413modulesDir :: FilePath
239modulesDir :: FilePath
@@ -459,7 +285,7 @@ handleShowLoadedModules = do
459 psciIO $ readModules loadedModules >>= putStrLn
285 psciIO $ readModules loadedModules >>= putStrLn
460 return ()
286 return ()
461 where readModules = return . unlines . sort . nub . map toModuleName
287 where readModules = return . unlines . sort . nub . map toModuleName
462− toModuleName = N.runModuleName . (\ (D.Module _ mdName _ _) -> mdName) . snd
288+ toModuleName = N.runModuleName . (\ (P.Module _ mdName _ _) -> mdName) . snd
463
289
464-- |
290-- |
465-- Show the imported modules in psci.
291-- Show the imported modules in psci.
@@ -476,17 +302,17 @@ handleShowImportedModules = do
476 Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
302 Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
477 Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
303 Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
478
304
479− showDeclType D.Implicit = ""
305+ showDeclType P.Implicit = ""
480− showDeclType (D.Explicit refs) = refsList refs
306+ showDeclType (P.Explicit refs) = refsList refs
481− showDeclType (D.Hiding refs) = "hiding " ++ refsList refs
307+ showDeclType (P.Hiding refs) = "hiding " ++ refsList refs
482 refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
308 refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
483
309
484 showRef :: P.DeclarationRef -> String
310 showRef :: P.DeclarationRef -> String
485− showRef (D.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
311+ showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
486− showRef (D.ValueRef ident) = show ident
312+ showRef (P.ValueRef ident) = show ident
487− showRef (D.TypeClassRef pn) = show pn
313+ showRef (P.TypeClassRef pn) = show pn
488− showRef (D.TypeInstanceRef ident) = show ident
314+ showRef (P.TypeInstanceRef ident) = show ident
489− showRef (D.PositionedDeclarationRef _ _ ref) = showRef ref
315+ showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
490
316
491 commaList :: [String] -> String
317 commaList :: [String] -> String
492 commaList = intercalate ", "
318 commaList = intercalate ", "
@@ -494,7 +320,7 @@ handleShowImportedModules = do
494-- |
320-- |
495-- Imports a module, preserving the initial state on failure.
321-- Imports a module, preserving the initial state on failure.
496--
322--
497−handleImport :: C.ImportedModule -> PSCI ()
323+handleImport :: ImportedModule -> PSCI ()
498handleImport im = do
324handleImport im = do
499 st <- updateImportedModules im <$> PSCI (lift get)
325 st <- updateImportedModules im <$> PSCI (lift get)
500 let m = createTemporaryModuleForImports st
326 let m = createTemporaryModuleForImports st
@@ -578,9 +404,9 @@ handleKindOf typ = do
578-- Commands
404-- Commands
579
405
580-- |
406-- |
581−-- Parses the input and returns either a Metacommand or an expression.
407+-- Parses the input and returns either a Metacommand, or an error as a string.
582--
408--
583−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe C.Command))
409+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
584getCommand singleLineMode = do
410getCommand singleLineMode = do
585 firstLine <- getInputLine "> "
411 firstLine <- getInputLine "> "
586 case firstLine of
412 case firstLine of
@@ -593,14 +419,14 @@ getCommand singleLineMode = do
593 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
419 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
594
420
595-- |
421-- |
596−-- Performs an action for each meta-command given, and also for expressions..
422+-- Performs an action for each meta-command given, and also for expressions.
597--
423--
598−handleCommand :: C.Command -> PSCI ()
424+handleCommand :: Command -> PSCI ()
599−handleCommand (C.Expression val) = handleDeclaration val
425+handleCommand (Expression val) = handleDeclaration val
600−handleCommand C.Help = PSCI $ outputStrLn helpMessage
426+handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
601−handleCommand (C.Import im) = handleImport im
427+handleCommand (Import im) = handleImport im
602−handleCommand (C.Decls l) = handleDecls l
428+handleCommand (Decls l) = handleDecls l
603−handleCommand (C.LoadFile filePath) = do
429+handleCommand (LoadFile filePath) = do
604 absPath <- psciIO $ expandTilde filePath
430 absPath <- psciIO $ expandTilde filePath
605 exists <- psciIO $ doesFileExist absPath
431 exists <- psciIO $ doesFileExist absPath
606 if exists then do
432 if exists then do
@@ -611,7 +437,7 @@ handleCommand (C.LoadFile filePath) = do
611 Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
437 Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
612 else
438 else
613 PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
439 PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
614−handleCommand C.Reset = do
440+handleCommand ResetState = do
615 files <- psciImportedFilenames <$> PSCI (lift get)
441 files <- psciImportedFilenames <$> PSCI (lift get)
616 PSCI . lift . modify $ \st -> st
442 PSCI . lift . modify $ \st -> st
617 { psciImportedFilenames = files
443 { psciImportedFilenames = files
@@ -619,14 +445,14 @@ handleCommand C.Reset = do
619 , psciLetBindings = []
445 , psciLetBindings = []
620 }
446 }
621 loadAllImportedModules
447 loadAllImportedModules
622−handleCommand (C.TypeOf val) = handleTypeOf val
448+handleCommand (TypeOf val) = handleTypeOf val
623−handleCommand (C.KindOf typ) = handleKindOf typ
449+handleCommand (KindOf typ) = handleKindOf typ
624−handleCommand (C.Browse moduleName) = handleBrowse moduleName
450+handleCommand (BrowseModule moduleName) = handleBrowse moduleName
625−handleCommand (C.Show "loaded") = handleShowLoadedModules
451+handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
626−handleCommand (C.Show "import") = handleShowImportedModules
452+handleCommand (ShowInfo QueryImport) = handleShowImportedModules
627−handleCommand _ = PSCI $ outputStrLn "Unknown command"
453+handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."
628−
454+
629−loadUserConfig :: IO (Maybe [C.Command])
455+loadUserConfig :: IO (Maybe [Command])
630loadUserConfig = do
456loadUserConfig = do
631 configFile <- (</> ".psci") <$> getCurrentDirectory
457 configFile <- (</> ".psci") <$> getCurrentDirectory
632 exists <- doesFileExist configFile
458 exists <- doesFileExist configFile
@@ -662,7 +488,7 @@ loop PSCiOptions{..} = do
662 case c of
488 case c of
663 Left err -> outputStrLn err >> go
489 Left err -> outputStrLn err >> go
664 Right Nothing -> go
490 Right Nothing -> go
665− Right (Just C.Quit) -> outputStrLn quitMessage
491+ Right (Just QuitPSCi) -> outputStrLn quitMessage
666 Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
492 Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
667
493
668multiLineMode :: Parser Bool
494multiLineMode :: Parser Bool
@@ -690,8 +516,8 @@ psciOptions = PSCiOptions <$> multiLineMode
690 <*> many inputFile
516 <*> many inputFile
691 <*> nodeFlagsFlag
517 <*> nodeFlagsFlag
692
518
693−main :: IO ()
519+runPSCi :: IO ()
694−main = execParser opts >>= loop
520+runPSCi = execParser opts >>= loop
695 where
521 where
696 opts = info (version <*> helper <*> psciOptions) infoModList
522 opts = info (version <*> helper <*> psciOptions) infoModList
697 infoModList = fullDesc <> headerInfo <> footerInfo
523 infoModList = fullDesc <> headerInfo <> footerInfo
psci/Parser.hs+41−27
@@ -19,22 +19,23 @@ module Parser
19
19
20import Prelude hiding (lex)
20import Prelude hiding (lex)
21
21
22−import qualified Commands as C
23−import qualified Directive as D
24−
25import Data.Char (isSpace)
22import Data.Char (isSpace)
23+import Data.List (intercalate)
26
24
27import Control.Applicative hiding (many)
25import Control.Applicative hiding (many)
28
26
29import Text.Parsec hiding ((<|>))
27import Text.Parsec hiding ((<|>))
30
28
31import qualified Language.PureScript as P
29import qualified Language.PureScript as P
32−import qualified Language.PureScript.Parser.Common as C (mark, same)
30+import Language.PureScript.Parser.Common (mark, same)
31+
32+import qualified Directive as D
33+import Types
33
34
34-- |
35-- |
35-- Parses PSCI metacommands or expressions input from the user.
36-- Parses PSCI metacommands or expressions input from the user.
36--
37--
37−parseCommand :: String -> Either String C.Command
38+parseCommand :: String -> Either String Command
38parseCommand cmdString =
39parseCommand cmdString =
39 case cmdString of
40 case cmdString of
40 (':' : cmd) -> parseDirective cmd
41 (':' : cmd) -> parseDirective cmd
@@ -45,7 +46,7 @@ parseRest p s = either (Left . show) Right $ do
45 ts <- P.lex "" s
46 ts <- P.lex "" s
46 P.runTokenParser "" (p <* eof) ts
47 P.runTokenParser "" (p <* eof) ts
47
48
48−psciCommand :: P.TokenParser C.Command
49+psciCommand :: P.TokenParser Command
49psciCommand = choice (map try parsers)
50psciCommand = choice (map try parsers)
50 where
51 where
51 parsers =
52 parsers =
@@ -64,25 +65,31 @@ trimStart = dropWhile isSpace
64trimEnd :: String -> String
65trimEnd :: String -> String
65trimEnd = reverse . trimStart . reverse
66trimEnd = reverse . trimStart . reverse
66
67
67−parseDirective :: String -> Either String C.Command
68+parseDirective :: String -> Either String Command
68parseDirective cmd =
69parseDirective cmd =
69− case D.parseDirective dstr of
70+ case D.directivesFor' dstr of
70− Just D.Help -> return C.Help
71+ [(d, _)] -> commandFor d
71− Just D.Quit -> return C.Quit
72+ [] -> Left "Unrecognized directive. Type :? for help."
72− Just D.Reset -> return C.Reset
73+ ds -> Left ("Ambiguous directive. Possible matches: " ++
74+ intercalate ", " (map snd ds) ++ ". Type :? for help.")
75+ where
76+ (dstr, arg) = break isSpace cmd
77+
78+ commandFor d = case d of
79+ Help -> return ShowHelp
80+ Quit -> return QuitPSCi
81+ Reset -> return ResetState
73− Just D.Browse -> C.Browse <$> parseRest P.moduleName arg
82+ Browse -> BrowseModule <$> parseRest P.moduleName arg
74− Just D.Load -> return $ C.LoadFile (trim arg)
83+ Load -> return $ LoadFile (trim arg)
75− Just D.Show -> return $ C.Show (trim arg)
84+ Show -> ShowInfo <$> parseReplQuery' (trim arg)
76− Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg
85+ Type -> TypeOf <$> parseRest P.parseValue arg
77− Just D.Kind -> C.KindOf <$> parseRest P.parseType arg
86+ Kind -> KindOf <$> parseRest P.parseType arg
78− Nothing -> Left $ "Unrecognized command. Type :? for help."
79− where (dstr, arg) = break isSpace cmd
80
87
81-- |
88-- |
82-- Parses expressions entered at the PSCI repl.
89-- Parses expressions entered at the PSCI repl.
83--
90--
84−psciExpression :: P.TokenParser C.Command
91+psciExpression :: P.TokenParser Command
85−psciExpression = C.Expression <$> P.parseValue
92+psciExpression = Expression <$> P.parseValue
86
93
87-- |
94-- |
88-- PSCI version of @let@.
95-- PSCI version of @let@.
@@ -90,21 +97,21 @@ psciExpression = C.Expression <$> P.parseValue
90-- However, since we don't support the @Eff@ monad,
97-- However, since we don't support the @Eff@ monad,
91-- we actually want the normal @let@.
98-- we actually want the normal @let@.
92--
99--
93−psciLet :: P.TokenParser C.Command
100+psciLet :: P.TokenParser Command
94−psciLet = C.Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
101+psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
95 where
102 where
96 manyDecls :: P.TokenParser [P.Declaration]
103 manyDecls :: P.TokenParser [P.Declaration]
97− manyDecls = C.mark (many1 (C.same *> P.parseLocalDeclaration))
104+ manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
98
105
99-- | Imports must be handled separately from other declarations, so that
106-- | Imports must be handled separately from other declarations, so that
100-- :show import works, for example.
107-- :show import works, for example.
101−psciImport :: P.TokenParser C.Command
108+psciImport :: P.TokenParser Command
102−psciImport = C.Import <$> P.parseImportDeclaration'
109+psciImport = Import <$> P.parseImportDeclaration'
103
110
104-- | Any other declaration that we don't need a 'special case' parser for
111-- | Any other declaration that we don't need a 'special case' parser for
105-- (like let or import declarations).
112-- (like let or import declarations).
106−psciOtherDeclaration :: P.TokenParser C.Command
113+psciOtherDeclaration :: P.TokenParser Command
107−psciOtherDeclaration = C.Decls . (:[]) <$> do
114+psciOtherDeclaration = Decls . (:[]) <$> do
108 decl <- discardPositionInfo <$> P.parseDeclaration
115 decl <- discardPositionInfo <$> P.parseDeclaration
109 if acceptable decl
116 if acceptable decl
110 then return decl
117 then return decl
@@ -123,3 +130,10 @@ acceptable (P.ExternInstanceDeclaration _ _ _ _) = True
123acceptable (P.TypeClassDeclaration _ _ _ _) = True
130acceptable (P.TypeClassDeclaration _ _ _ _) = True
124acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True
131acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True
125acceptable _ = False
132acceptable _ = False
133+
134+parseReplQuery' :: String -> Either String ReplQuery
135+parseReplQuery' str =
136+ case parseReplQuery str of
137+ Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
138+ intercalate ", " replQueryStrings ++ ".")
139+ Just query -> Right query
psci/Types.hsnew file+167
@@ -0,0 +1,167 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Types
4+-- Copyright : (c) Phil Freeman 2014
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- Type declarations and associated basic functions for PSCI.
13+--
14+-----------------------------------------------------------------------------
15+
16+module Types where
17+
18+import qualified Language.PureScript as P
19+
20+data PSCiOptions = PSCiOptions
21+ { psciMultiLineMode :: Bool
22+ , psciInputFile :: [FilePath]
23+ , psciInputNodeFlags :: [String]
24+ }
25+
26+-- |
27+-- The PSCI state.
28+-- Holds a list of imported modules, loaded files, and partial let bindings.
29+-- The let bindings are partial,
30+-- because it makes more sense to apply the binding to the final evaluated expression.
31+--
32+data PSCiState = PSCiState
33+ { psciImportedFilenames :: [FilePath]
34+ , psciImportedModules :: [ImportedModule]
35+ , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
36+ , psciLetBindings :: [P.Declaration]
37+ , psciNodeFlags :: [String]
38+ }
39+
40+-- | All of the data that is contained by an ImportDeclaration in the AST.
41+-- That is:
42+--
43+-- * A module name, the name of the module which is being imported
44+-- * An ImportDeclarationType which specifies whether there is an explicit
45+-- import list, a hiding list, or neither.
46+-- * If the module is imported qualified, its qualified name in the importing
47+-- module. Otherwise, Nothing.
48+--
49+type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
50+
51+psciImportedModuleNames :: PSCiState -> [P.ModuleName]
52+psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
53+ map (\(mn, _, _) -> mn) is
54+
55+allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
56+allImportsOf m (PSCiState{psciImportedModules = is}) =
57+ filter isImportOfThis is
58+ where
59+ name = P.getModuleName m
60+ isImportOfThis (name', _, _) = name == name'
61+
62+-- State helpers
63+
64+-- |
65+-- Updates the state to have more imported modules.
66+--
67+updateImportedFiles :: FilePath -> PSCiState -> PSCiState
68+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
69+
70+-- |
71+-- Updates the state to have more imported modules.
72+--
73+updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
74+updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
75+
76+-- |
77+-- Updates the state to have more loaded files.
78+--
79+updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
80+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
81+
82+-- |
83+-- Updates the state to have more let bindings.
84+--
85+updateLets :: [P.Declaration] -> PSCiState -> PSCiState
86+updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
87+
88+-- |
89+-- Valid Meta-commands for PSCI
90+--
91+data Command
92+ -- |
93+ -- A purescript expression
94+ --
95+ = Expression P.Expr
96+ -- |
97+ -- Show the help (ie, list of directives)
98+ --
99+ | ShowHelp
100+ -- |
101+ -- Import a module from a loaded file
102+ --
103+ | Import ImportedModule
104+ -- |
105+ -- Browse a module
106+ --
107+ | BrowseModule P.ModuleName
108+ -- |
109+ -- Load a file for use with importing
110+ --
111+ | LoadFile FilePath
112+ -- |
113+ -- Exit PSCI
114+ --
115+ | QuitPSCi
116+ -- |
117+ -- Reset the state of the REPL
118+ --
119+ | ResetState
120+ -- |
121+ -- Add some declarations to the current evaluation context.
122+ --
123+ | Decls [P.Declaration]
124+ -- |
125+ -- Find the type of an expression
126+ --
127+ | TypeOf P.Expr
128+ -- |
129+ -- Find the kind of an expression
130+ --
131+ | KindOf P.Type
132+ -- |
133+ -- Shows information about the current state of the REPL
134+ --
135+ | ShowInfo ReplQuery
136+
137+data ReplQuery
138+ = QueryLoaded
139+ | QueryImport
140+ deriving (Eq, Show)
141+
142+-- | A list of all ReplQuery values.
143+replQueries :: [ReplQuery]
144+replQueries = [QueryLoaded, QueryImport]
145+
146+replQueryStrings :: [String]
147+replQueryStrings = map showReplQuery replQueries
148+
149+showReplQuery :: ReplQuery -> String
150+showReplQuery QueryLoaded = "loaded"
151+showReplQuery QueryImport = "import"
152+
153+parseReplQuery :: String -> Maybe ReplQuery
154+parseReplQuery "loaded" = Just QueryLoaded
155+parseReplQuery "import" = Just QueryImport
156+parseReplQuery _ = Nothing
157+
158+data Directive
159+ = Help
160+ | Quit
161+ | Reset
162+ | Browse
163+ | Load
164+ | Type
165+ | Kind
166+ | Show
167+ deriving (Eq, Show)
psci/main/Main.hsnew file+6
@@ -0,0 +1,6 @@
1+module Main where
2+
3+import PSCi
4+
5+main :: IO ()
6+main = runPSCi
psci/tests/Main.hsnew file+137
@@ -0,0 +1,137 @@
1+{-# LANGUAGE RecordWildCards #-}
2+
3+module Main where
4+
5+import Control.Monad.Trans.State.Strict (runStateT)
6+import Control.Monad (when)
7+
8+import System.Exit (exitFailure)
9+import System.Console.Haskeline
10+
11+import Test.HUnit
12+
13+import qualified Language.PureScript as P
14+
15+import PSCi
16+import Completion
17+import Types
18+
19+main :: IO ()
20+main = do
21+ Counts{..} <- runTestTT allTests
22+ when (errors + failures > 0) exitFailure
23+
24+allTests :: Test
25+allTests = completionTests
26+
27+completionTests :: Test
28+completionTests =
29+ TestLabel "completionTests"
30+ (TestList (map (TestCase . assertCompletedOk) completionTestData))
31+
32+-- If the cursor is at the right end of the line, with the 1st element of the
33+-- pair as the text in the line, then pressing tab should offer all the
34+-- elements of the list (which is the 2nd element) as completions.
35+completionTestData :: [(String, [String])]
36+completionTestData =
37+ -- basic directives
38+ [ (":h", [":help"])
39+ , (":re", [":reset"])
40+ , (":q", [":quit"])
41+ , (":mo", [":module"])
42+ , (":b", [":browse"])
43+
44+ -- :browse should complete modules
45+ , (":b Prel", [":b Prelude", ":b Prelude.Unsafe"])
46+ , (":b Prelude.", [":b Prelude.Unsafe"])
47+
48+ -- :load, :module should complete file paths
49+ , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
50+ , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
51+
52+ -- :quit, :help, :reset should not complete
53+ , (":help ", [])
54+ , (":quit ", [])
55+ , (":reset ", [])
56+
57+ -- :show should complete to "loaded" and "import"
58+ , (":show ", [":show import", ":show loaded"])
59+ , (":show a", [])
60+
61+ -- :type should complete values and data constructors in scope
62+ , (":type Prelude.Unsafe.un", [":type Prelude.Unsafe.unsafeIndex"])
63+ , (":type un", [":type unit"])
64+ , (":type E", [":type EQ"])
65+
66+ -- :kind should complete types in scope
67+ , (":kind C", [":kind Control.Monad.Eff.Pure"])
68+ , (":kind O", [":kind Ordering"])
69+
70+ -- Only one argument for directives should be completed
71+ , (":show import ", [])
72+ , (":type EQ ", [])
73+ , (":kind Ordering ", [])
74+
75+ -- import should complete module names
76+ , ("import Control.Monad.S", ["import Control.Monad.ST"])
77+ , ("import qualified Control.Monad.S", ["import qualified Control.Monad.ST"])
78+ , ("import Control.Monad.", map ("import Control.Monad." ++)
79+ ["Eff", "Eff.Unsafe", "ST"])
80+
81+ -- a few other import tests
82+ , ("impor", ["import"])
83+ , ("import q", ["import qualified"])
84+ , ("import ", map ("import " ++) allModuleNames ++ ["import qualified"])
85+ , ("import Prelude.Unsafe ", [])
86+
87+ -- String and number literals should not be completed
88+ , ("\"hi", [])
89+ , ("34", [])
90+
91+ -- Identifiers and data constructors should be completed
92+ , ("un", ["unit"])
93+ , ("Debug.Trace.", map ("Debug.Trace." ++) ["print", "trace"])
94+ , ("G", ["GT"])
95+ , ("Prelude.L", ["Prelude.LT"])
96+
97+ -- if a module is imported qualified, values should complete under the
98+ -- qualified name, as well as the original name.
99+ , ("ST.new", ["ST.newSTRef"])
100+ , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
101+ ]
102+ where
103+ allModuleNames = [ "Control.Monad.Eff"
104+ , "Control.Monad.Eff.Unsafe"
105+ , "Control.Monad.ST"
106+ , "Data.Function"
107+ , "Debug.Trace"
108+ , "Prelude"
109+ , "Prelude.Unsafe"
110+ ]
111+
112+assertCompletedOk :: (String, [String]) -> Assertion
113+assertCompletedOk (line, expecteds) = do
114+ (unusedR, completions) <- runCM (completion' (reverse line, ""))
115+ let unused = reverse unusedR
116+ let actuals = map ((unused ++) . replacement) completions
117+ expecteds @=? actuals
118+
119+runCM :: CompletionM a -> IO a
120+runCM act = do
121+ psciState <- getPSCiState
122+ fmap fst (runStateT (liftCompletionM act) psciState)
123+
124+getPSCiState :: IO PSCiState
125+getPSCiState = do
126+ modulesOrFirstError <- loadAllModules []
127+ case modulesOrFirstError of
128+ Left err ->
129+ print err >> exitFailure
130+ Right modules ->
131+ let imports = controlMonadSTasST : defaultImports
132+ in return (PSCiState [] imports modules [] [])
133+
134+controlMonadSTasST :: ImportedModule
135+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
136+ where
137+ s = P.moduleNameFromString
psci/tests/data/Sample.pursnew file

No changes to the content.

purescript.cabal+15−2
@@ -148,10 +148,12 @@ executable psci
148
148
149 main-is: Main.hs
149 main-is: Main.hs
150 buildable: True
150 buildable: True
151− hs-source-dirs: psci
151+ hs-source-dirs: psci psci/main
152− other-modules: Commands
152+ other-modules: Types
153 Parser
153 Parser
154 Directive
154 Directive
155+ Completion
156+ PSCi
155 ghc-options: -Wall -O2
157 ghc-options: -Wall -O2
156
158
157executable psc-docs
159executable psc-docs
@@ -182,3 +184,14 @@ test-suite tests
182 main-is: Main.hs
184 main-is: Main.hs
183 buildable: True
185 buildable: True
184 hs-source-dirs: tests
186 hs-source-dirs: tests
187+
188+test-suite psci-tests
189+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
190+ mtl -any, optparse-applicative >= 0.10.0, parsec -any,
191+ haskeline >= 0.7.0.0, purescript -any, transformers -any,
192+ process -any, HUnit -any
193+ type: exitcode-stdio-1.0
194+ main-is: Main.hs
195+ buildable: True
196+ hs-source-dirs: psci psci/tests
197+ ghc-options: -Wall
tests/Main.hs−1
@@ -105,4 +105,3 @@ main = do
105 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
105 forM_ failingTestCases $ \inputFile -> when (".purs" `isSuffixOf` inputFile) $
106 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)
106 assertDoesNotCompile preludeExterns (failing ++ pathSeparator : inputFile)
107 exitSuccess
107 exitSuccess
108−
travis-after-script.sh+9−1
@@ -9,5 +9,13 @@ popd
9if [ -z $( git describe --tags --exact-match 2>/dev/null ) ]
9if [ -z $( git describe --tags --exact-match 2>/dev/null ) ]
10then
10then
11 cabal install hpc-coveralls
11 cabal install hpc-coveralls
12+ case "$SUITE" in
13+ "tests")
12− hpc-coveralls --exclude-dir=tests tests
14+ hpc-coveralls --exclude-dir=dist/build/autogen --exclude-dir=tests tests;;
15+ "psci-tests")
16+ hpc-coveralls --exclude-dir=dist/build/autogen --exclude-dir=src --exclude-dir=psci/tests psci-tests;;
17+ *)
18+ echo "unrecognised test suite $SUITE"
19+ exit 1;;
20+ esac
13fi
21fi
travis-script.sh+1−1
@@ -2,7 +2,7 @@ set -e
2
2
3if [ -z $( git describe --tags --exact-match 2>/dev/null ) ]
3if [ -z $( git describe --tags --exact-match 2>/dev/null ) ]
4then
4then
5− cabal configure --enable-tests --enable-library-coverage -v2
5+ cabal configure --enable-tests --enable-coverage -v2
6else
6else
7 cabal configure --enable-tests -v2
7 cabal configure --enable-tests -v2
8fi
8fi