git.iko.soy/elk
on master help sign in
update the Repl.hs logic for all the compiler changes
afa4f13Evan Czaplicki
terminal/src/Repl.hs+404−207
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
2module Repl
3module Repl
3 ( Flags(..)
4 ( Flags(..)
@@ -8,16 +9,18 @@ module Repl
8
9
9import Prelude hiding (lines, read)
10import Prelude hiding (lines, read)
10import Control.Applicative ((<|>))
11import Control.Applicative ((<|>))
11−import Control.Monad.RWS (lift, liftIO)
12+import Control.Monad.Trans (lift, liftIO)
12−import qualified Control.Monad.RWS as RWS
13+import qualified Control.Monad.State.Strict as State
14+import qualified Data.ByteString as BS
13import qualified Data.ByteString.Builder as B
15import qualified Data.ByteString.Builder as B
16+import qualified Data.ByteString.Char8 as BSC
14import qualified Data.ByteString.Lazy as LBS
17import qualified Data.ByteString.Lazy as LBS
18+import qualified Data.ByteString.UTF8 as BS_UTF8
19+import qualified Data.Char as Char
15import qualified Data.List as List
20import qualified Data.List as List
16import qualified Data.Map as Map
21import qualified Data.Map as Map
17import Data.Monoid ((<>))
22import Data.Monoid ((<>))
18−import qualified Data.Name as Name
23+import qualified Data.Name as N
19−import qualified Data.Text as Text
20−import qualified Data.Text.Encoding as Text
21import qualified System.Console.Haskeline as Repl
24import qualified System.Console.Haskeline as Repl
22import qualified System.Directory as Dir
25import qualified System.Directory as Dir
23import qualified System.Exit as Exit
26import qualified System.Exit as Exit
@@ -25,16 +28,31 @@ import System.FilePath ((</>))
25import qualified System.IO as IO
28import qualified System.IO as IO
26import qualified System.Process as Proc
29import qualified System.Process as Proc
27
30
28−import qualified Elm.Compiler as Elm (version)
31+import qualified AST.Source as Src
32+import qualified Build
33+import qualified Elm.Constraint as C
34+import qualified Elm.Details as Details
35+import qualified Elm.Licenses as Licenses
36+import qualified Elm.ModuleName as ModuleName
29−import qualified Elm.Project as Project
37+import qualified Elm.Outline as Outline
30import qualified Elm.Package as Pkg
38import qualified Elm.Package as Pkg
31−import qualified Elm.PerUserCache as PerUserCache
39+import qualified Elm.Version as V
32−import qualified Parse.Repl as Elm
40+import qualified Generate
41+import qualified Parse.Expression as PE
42+import qualified Parse.Declaration as PD
43+import qualified Parse.Module as PM
44+import qualified Parse.Primitives as P
45+import Parse.Primitives (Row, Col)
46+import qualified Reporting
47+import qualified Reporting.Annotation as A
33import Reporting.Doc ((<+>))
48import Reporting.Doc ((<+>))
34import qualified Reporting.Doc as D
49import qualified Reporting.Doc as D
50+import qualified Reporting.Error.Syntax as ES
51+import qualified Reporting.Exit as Exit
52+import qualified Reporting.Render.Code as Code
53+import qualified Reporting.Report as Report
35import qualified Reporting.Task as Task
54import qualified Reporting.Task as Task
36−import qualified Reporting.Progress.Repl as Repl
55+import qualified Stuff
37−import qualified Reporting.Render.Type.Localizer as L
38
56
39
57
40
58
@@ -43,174 +61,249 @@ import qualified Reporting.Render.Type.Localizer as L
43
61
44data Flags =
62data Flags =
45 Flags
63 Flags
46− { _interpreter :: Maybe FilePath
64+ { _maybeInterpreter :: Maybe FilePath
47 , _noColors :: Bool
65 , _noColors :: Bool
48 }
66 }
49
67
50
68
51run :: () -> Flags -> IO ()
69run :: () -> Flags -> IO ()
52−run () (Flags maybeAlternateInterpreter noColors) =
70+run () flags =
53− do interpreter <- getInterpreter maybeAlternateInterpreter
54− _ <- Project.getRootWithReplFallback
55− printWelcomeMessage
71+ do printWelcomeMessage
56 settings <- initSettings
72 settings <- initSettings
73+ env <- initEnv flags
57− let manager = Repl.runInputT settings (Repl.withInterrupt loop)
74+ let looper = Repl.runInputT settings (Repl.withInterrupt (loop env initialState))
58− (exitCode,_,_) <- RWS.runRWST manager (interpreter, noColors) initialState
75+ exitCode <- State.evalStateT looper initialState
59 Exit.exitWith exitCode
76 Exit.exitWith exitCode
60
77
61
78
62−type Runner =
63− RWS.RWST (FilePath, Bool) () State IO
64−
65−
66−
67−-- LOOP
68−
69−
70−loop :: Repl.InputT Runner Exit.ExitCode
71−loop =
72− do input <- Repl.handleInterrupt (return Skip) read
73− maybe loop return =<< lift (eval input)
74
79
80+-- WELCOME
75
81
76
82
77−-- READ
83+printWelcomeMessage :: IO ()
84+printWelcomeMessage =
85+ let
86+ vsn = V.toChars V.compiler
87+ title = "Elm" <+> D.fromChars vsn
88+ dashes = replicate (70 - length vsn) '-'
89+ in
90+ D.toAnsi IO.stdout $
91+ D.vcat
92+ [ D.black "----" <+> D.dullcyan title <+> D.black (D.fromChars dashes)
93+ , D.black $ D.fromChars $ "Say :help for help and :exit to exit! More at " <> D.makeLink "repl"
94+ , D.black "--------------------------------------------------------------------------------"
95+ , D.empty
96+ ]
78
97
79
98
80−read :: Repl.InputT Runner Input
81−read =
82− readHelp "> " []
83
99
100+-- ENV
84
101
85−readHelp :: String -> [String] -> Repl.InputT Runner Input
86−readHelp starter lines =
87− do input <- Repl.getInputLine starter
88− case input of
89− Nothing ->
90− return Exit
91
102
92− Just line ->
103+data Env =
93− if not (null line) && last line == '\\'
104+ Env
94− then readHelp "| " (init line : lines)
105+ { _root :: FilePath
95− else return $ toInput $ List.intercalate "\n " $ reverse (line : lines)
106+ , _interpreter :: FilePath
107+ , _ansi :: Bool
108+ }
96
109
97
110
111+initEnv :: Flags -> IO Env
112+initEnv (Flags maybeAlternateInterpreter noColors) =
113+ do root <- getRoot
114+ interpreter <- getInterpreter maybeAlternateInterpreter
115+ return $ Env root interpreter (not noColors)
98
116
99−-- EVAL
100
117
101
118
102−eval :: Input -> Runner (Maybe Exit.ExitCode)
119+-- LOOP
103−eval input =
104− case input of
105− Skip ->
106− return Nothing
107
120
108− Exit ->
109− return (Just Exit.ExitSuccess)
110
121
111− Reset ->
122+data Outcome
112− do RWS.put initialState
123+ = Loop State
113− report "<reset>"
124+ | End Exit.ExitCode
114
125
115− Help info ->
116− report (helpMessage info)
117
126
118− Code entry ->
127+type M =
119− Repl.handleInterrupt (report "<cancelled>") $
128+ State.StateT State IO
120− do state@(State _ imports types defs tricks localizer) <- RWS.get
121− case entry of
122− Elm.Import name alias exposing src ->
123− interpret None $
124− state
125− { _imports = Map.insert name src imports
126− , _localizer = L.replAdd name alias exposing localizer
127− }
128
129
129− Elm.Type name src ->
130− interpret None $ state { _types = Map.insert name src types }
131
130
132− Elm.Def (Just name) src ->
131+loop :: Env -> State -> Repl.InputT M Exit.ExitCode
133− interpret (Def name) $ state { _defs = Map.insert name src defs }
132+loop env state =
133+ do input <- Repl.handleInterrupt (return Skip) read
134+ outcome <- liftIO (eval env state input)
135+ case outcome of
136+ Loop state ->
137+ do lift (State.put state)
138+ loop env state
134
139
135− Elm.Def Nothing src ->
140+ End exitCode ->
136− interpret None $ state { _tricks = src : tricks }
141+ return exitCode
137
142
138− Elm.Other src ->
139− interpret (Expr src) state
140
143
141− Elm.Annotation ->
142− report "I cannot handle type annotations."
143
144
144− Elm.Port ->
145+-- READ
145− report "I cannot handle port declarations."
146
146
147
147
148−report :: String -> Runner (Maybe a)
148+data Input
149−report msg =
149+ = Import ModuleName.Raw BS.ByteString
150− do liftIO (putStrLn msg)
150+ | Type N.Name BS.ByteString
151− return Nothing
151+ | Port
152+ | Decl N.Name BS.ByteString
153+ | Expr BS.ByteString
154+ --
155+ | Reset
156+ | Exit
157+ | Skip
158+ | Help (Maybe String)
152
159
153
160
154−data Output = None | Def Name.Name | Expr Text.Text
161+read :: Repl.InputT M Input
162+read =
163+ do line <- Repl.getInputLine "> "
164+ case line of
165+ Nothing ->
166+ return Exit
155
167
168+ Just chars ->
169+ case categorize chars of
170+ Done input -> return input
171+ Continue -> readMore chars
156
172
157−interpret :: Output -> State -> Runner (Maybe a)
158−interpret def state =
159− do noColors <- RWS.asks snd
160− result <- liftIO $ Task.try Repl.reporter $ compile noColors def state
161
173
174+readMore :: [Char] -> Repl.InputT M Input
175+readMore previousLines =
176+ do input <- Repl.getInputLineWithInitial "| " (" ","")
162− case result of
177+ case input of
163 Nothing ->
178 Nothing ->
164− return ()
179+ return Skip
165
180
166− Just maybePath ->
181+ Just chars ->
167− do RWS.put (state { _count = _count state + 1 })
182+ let
168− maybe (return ()) interpretHelp maybePath
183+ allLines = previousLines ++ '\n' : chars
184+ in
185+ case categorize allLines of
186+ Done input -> return input
187+ Continue -> readMore allLines
169
188
170− return Nothing
171
189
172
190
173−interpretHelp :: FilePath -> Runner ()
191+-- CATEGORIZE INPUT
174−interpretHelp path =
175− do interpreter <- RWS.asks fst
176− let proc = (Proc.proc interpreter [path]) { Proc.std_in = Proc.CreatePipe }
177− liftIO $ Proc.withCreateProcess proc $ \_ _ _ handle ->
178− do _ <- Proc.waitForProcess handle
179− Dir.removeFile path
180
192
181
193
194+data CategorizedInput
195+ = Done Input
196+ | Continue
182
197
183−-- INPUT
184
198
199+categorize :: [Char] -> CategorizedInput
200+categorize chars
201+ | all (==' ') chars = Done Skip
202+ | startsWithColon chars = Done (toCommand chars)
203+ | startsWithKeyword "import" chars = attemptImport chars
204+ | otherwise = attemptDeclOrExpr chars
185
205
186−data Input
187− = Skip
188− | Exit
189− | Reset
190− | Help (Maybe String)
191− | Code Elm.Entry
192
206
207+attemptImport :: [Char] -> CategorizedInput
208+attemptImport chars =
209+ let
210+ src = BS_UTF8.fromString (chars ++ "\n")
211+ parser = P.specialize (\_ _ _ -> ()) PM.chompImport
212+ in
213+ case P.fromByteString parser (\_ _ -> ()) src of
214+ Right (Src.Import (A.At _ name) _ _) ->
215+ Done (Import name src)
193
216
194−toInput :: String -> Input
217+ Left () ->
195−toInput string =
218+ if endsWithBlankLine chars
196− case dropWhile (==' ') string of
219+ then Done (Import "ERR" src)
197− ":exit" ->
220+ else Continue
198− Exit
199
221
200− ":help" ->
201− Help Nothing
202
222
223+attemptDeclOrExpr :: [Char] -> CategorizedInput
224+attemptDeclOrExpr chars =
225+ let
226+ src = BS_UTF8.fromString (chars ++ "\n")
227+ exprParser = P.specialize (toExprPosition src) PE.expression
228+ declParser = P.specialize (toDeclPosition src) PD.declaration
229+ in
230+ case P.fromByteString declParser (,) src of
231+ Right (decl, _) ->
232+ case decl of
233+ PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> Done (Decl name src)
234+ PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _ )) -> Done (Type name src)
235+ PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _ )) -> Done (Type name src)
236+ PD.Port _ _ -> Done Port
237+
238+ Left declPosition
239+ | startsWithKeyword "type" chars ->
240+ if endsWithBlankLine chars
241+ then Done (Type "ERR" src)
242+ else Continue
243+
244+ | startsWithKeyword "port" chars ->
245+ Done Port
246+
247+ | otherwise ->
248+ case P.fromByteString exprParser (,) src of
249+ Right _ ->
250+ Done (Expr src)
251+
252+ Left exprPosition ->
253+ if endsWithBlankLine chars
254+ then Done (if declPosition <= exprPosition then Expr src else Decl "ERR" src)
255+ else Continue
256+
257+
258+endsWithBlankLine :: [Char] -> Bool
259+endsWithBlankLine chars =
260+ case reverse (List.lines chars) of
261+ [] -> False
262+ cs:_ -> all (==' ') cs
263+
264+
265+startsWithColon :: [Char] -> Bool
266+startsWithColon chars =
267+ case dropWhile (==' ') chars of
268+ [] -> False
269+ c:_ -> c == ':'
270+
271+
272+toCommand :: [Char] -> Input
273+toCommand chars =
274+ case drop 1 $ dropWhile (==' ') chars of
203− ":reset" ->
275+ "reset" -> Reset
204− Reset
276+ "exit" -> Exit
277+ "quit" -> Exit
278+ "help" -> Help Nothing
279+ rest -> Help (Just (takeWhile (/=' ') rest))
280+
281+
282+startsWithKeyword :: [Char] -> [Char] -> Bool
283+startsWithKeyword keyword line =
284+ List.isPrefixOf keyword line &&
285+ case drop (length keyword) line of
286+ [] -> True
287+ c:_ -> not (Char.isAlphaNum c)
288+
289+
290+toExprPosition :: BS.ByteString -> ES.Expr -> Row -> Col -> (Row, Col)
291+toExprPosition src expr row col =
292+ let
293+ decl = ES.DeclDef N.replValueToPrint (ES.DeclDefBody expr row col) row col
294+ in
295+ toDeclPosition src decl row col
205
296
206− ':' : rest ->
207− Help (Just (takeWhile (/=' ') rest))
208
297
209− "" ->
298+toDeclPosition :: BS.ByteString -> ES.Decl -> Row -> Col -> (Row, Col)
210− Skip
299+toDeclPosition src decl r c =
300+ let
301+ err = ES.ParseError (ES.Declarations decl r c)
302+ report = ES.toReport (Code.toSource src) err
211
303
212− _ ->
304+ (Report.Report _ (A.Region (A.Position row col) _) _ _) = report
213− Code (Elm.parseEntry string)
305+ in
306+ (row, col)
214
307
215
308
216
309
@@ -219,132 +312,156 @@ toInput string =
219
312
220data State =
313data State =
221 State
314 State
222− { _count :: !Int
223− , _imports :: Map.Map Name.Name Text.Text
315+ { _imports :: Map.Map N.Name B.Builder
224− , _types :: Map.Map Name.Name Text.Text
316+ , _types :: Map.Map N.Name B.Builder
225− , _defs :: Map.Map Name.Name Text.Text
317+ , _decls :: Map.Map N.Name B.Builder
226− , _tricks :: [Text.Text]
227− , _localizer :: L.Localizer
228 }
318 }
229
319
230
320
231initialState :: State
321initialState :: State
232initialState =
322initialState =
233− State 0 Map.empty Map.empty Map.empty [] L.replEmpty
323+ State Map.empty Map.empty Map.empty
234
324
235
325
236−compile :: Bool -> Output -> State -> Task.Task (Maybe FilePath)
237−compile noColors output (State count imports types defs tricks localizer) =
238− let
239− header =
240− "module " <> Name.toBuilder Name.replModule <> " exposing (..)\n\n"
241
326
242− elmSourceCode =
327+-- EVAL
243− (<>) header $
244− addLines imports $ addLines types $ addLines defs $
245− List.foldr (<>) mempty (map Text.encodeUtf8Builder tricks)
246
328
247− compileForRepl builder maybeName =
248− Project.compileForRepl noColors localizer (LBS.toStrict (B.toLazyByteString builder)) maybeName
249− in
250− case output of
251− None ->
252− if Map.null types && Map.null defs && null tricks then
253− compileForRepl (elmSourceCode <> "unit = ()") Nothing
254− else
255− compileForRepl elmSourceCode Nothing
256
329
257− Def name ->
330+eval :: Env -> State -> Input -> IO Outcome
258− compileForRepl elmSourceCode (Just name)
331+eval env state@(State imports types decls) input =
332+ Repl.handleInterrupt (putStrLn "<cancelled>" >> return (Loop state)) $
333+ case input of
334+ Skip ->
335+ return (Loop state)
259
336
260− Expr expr ->
337+ Exit ->
261− let
338+ return (End Exit.ExitSuccess)
262− name = Name.fromReplCount count
263− text = Text.replace "\n" "\n " expr
264− def = Name.toBuilder name <> " =\n " <> Text.encodeUtf8Builder text <> "\n"
265− in
266− compileForRepl (elmSourceCode <> def) (Just name)
267
339
340+ Reset ->
341+ do putStrLn "<reset>"
342+ return (Loop initialState)
268
343
269−addLines :: Map.Map Name.Name Text.Text -> B.Builder -> B.Builder
344+ Help maybeUnknownCommand ->
270−addLines dict builder =
345+ do putStrLn (toHelpMessage maybeUnknownCommand)
271− Map.foldr (\text b -> Text.encodeUtf8Builder text <> "\n" <> b) builder dict
346+ return (Loop state)
272
347
348+ Import name src ->
349+ do let newState = state { _imports = Map.insert name (B.byteString src) imports }
350+ Loop <$> attemptEval env state newState OutputNothing
273
351
352+ Type name src ->
353+ do let newState = state { _types = Map.insert name (B.byteString src) types }
354+ Loop <$> attemptEval env state newState OutputNothing
274
355
275−-- SETTINGS
356+ Port ->
357+ do putStrLn "I cannot handle port declarations."
358+ return (Loop state)
276
359
360+ Decl name src ->
361+ do let newState = state { _decls = Map.insert name (B.byteString src) decls }
362+ Loop <$> attemptEval env state newState (OutputDecl name)
277
363
278−initSettings :: IO (Repl.Settings Runner)
364+ Expr src ->
279−initSettings =
365+ Loop <$> attemptEval env state state (OutputExpr src)
280− do cache <- PerUserCache.getReplRoot
281− return $
282− Repl.Settings
283− { Repl.historyFile = Just (cache </> "history")
284− , Repl.autoAddHistory = True
285− , Repl.complete = Repl.completeWord Nothing " \n" lookupCompletions
286− }
287
366
288
367
289−lookupCompletions :: String -> Runner [Repl.Completion]
290−lookupCompletions string =
291− do (State _ imports types defs _ _) <- RWS.get
292− return $
293− addMatches string False defs $
294− addMatches string False types $
295− addMatches string True imports $
296− addMatches string False commands []
297
368
369+-- ATTEMPT EVAL
298
370
299−commands :: Map.Map Name.Name ()
300−commands =
301− Map.fromList [ (":exit", ()), (":quit", ()), (":reset", ()), (":help", ()) ]
302
371
372+data Output
373+ = OutputNothing
374+ | OutputDecl N.Name
375+ | OutputExpr BS.ByteString
303
376
304−addMatches :: String -> Bool -> Map.Map Name.Name v -> [Repl.Completion] -> [Repl.Completion]
305−addMatches string isFinished dict completions =
306− Map.foldrWithKey (addMatch string isFinished) completions dict
307
377
378+attemptEval :: Env -> State -> State -> Output -> IO State
379+attemptEval (Env root interpreter ansi) oldState newState output =
380+ do result <- Task.run $
381+ do details <-
382+ Task.eio Exit.ReplBadDetails $
383+ Details.load Reporting.silent root
308
384
309−addMatch :: String -> Bool -> Name.Name -> v -> [Repl.Completion] -> [Repl.Completion]
385+ artifacts <-
310−addMatch string isFinished name _ completions =
386+ Task.eio id $
311− let suggestion = Name.toString name in
387+ Build.fromRepl root details (toByteString newState output)
312− if List.isPrefixOf string suggestion then
313− Repl.Completion suggestion suggestion isFinished : completions
314− else
315− completions
316
388
389+ traverse (Task.mapError Exit.ReplBadGenerate . Generate.repl root details ansi artifacts) (toPrintName output)
317
390
391+ case result of
392+ Left exit ->
393+ do Exit.toStderr (Exit.replToReport exit)
394+ return oldState
318
395
319−-- WELCOME
396+ Right Nothing ->
397+ return newState
320
398
399+ Right (Just javascript) ->
400+ do exitCode <- interpret interpreter javascript
401+ case exitCode of
402+ Exit.ExitSuccess -> return newState
403+ Exit.ExitFailure _ -> return oldState
321
404
322−printWelcomeMessage :: IO ()
405+
323−printWelcomeMessage =
406+interpret :: FilePath -> B.Builder -> IO Exit.ExitCode
407+interpret interpreter javascript =
324 let
408 let
325− title = "Elm" <+> D.fromString elmVersion
409+ createProcess = (Proc.proc interpreter []) { Proc.std_in = Proc.CreatePipe }
326− dashes = replicate (70 - length elmVersion) '-'
327 in
410 in
328− D.toAnsi IO.stdout $
411+ Proc.withCreateProcess createProcess $ \(Just stdin) _ _ handle ->
329− D.vcat
412+ do B.hPutBuilder stdin javascript
330− [ D.black "----" <+> D.dullcyan title <+> D.black (D.fromString dashes)
413+ IO.hClose stdin
331− , D.black $ D.fromString $ "Say :help for help and :exit to exit! More at " <> D.makeLink "repl"
414+ Proc.waitForProcess handle
332− , D.black "--------------------------------------------------------------------------------"
415+
333− , D.empty
416+
417+
418+-- TO BYTESTRING
419+
420+
421+toByteString :: State -> Output -> BS.ByteString
422+toByteString (State imports types decls) output =
423+ LBS.toStrict $ B.toLazyByteString $
424+ mconcat
425+ [ "module ", N.toBuilder N.replModule, " exposing (..)\n"
426+ , Map.foldr mappend mempty imports
427+ , Map.foldr mappend mempty types
428+ , Map.foldr mappend mempty decls
429+ , outputToBuilder output
334 ]
430 ]
335
431
336
432
337−elmVersion :: String
433+outputToBuilder :: Output -> B.Builder
338−elmVersion =
434+outputToBuilder output =
339− Pkg.versionToString Elm.version
435+ case output of
436+ OutputNothing ->
437+ mempty
438+
439+ OutputDecl _ ->
440+ mempty
441+
442+ OutputExpr expr ->
443+ N.toBuilder N.replValueToPrint <> " ="
444+ <> foldr (\line rest -> "\n " <> B.byteString line <> rest) "\n" (BSC.lines expr)
445+
446+
447+
448+-- TO PRINT NAME
449+
450+
451+toPrintName :: Output -> Maybe N.Name
452+toPrintName output =
453+ case output of
454+ OutputNothing -> Nothing
455+ OutputDecl name -> Just name
456+ OutputExpr _ -> Just N.replValueToPrint
340
457
341
458
342
459
343-- HELP MESSAGES
460-- HELP MESSAGES
344
461
345
462
346−helpMessage :: Maybe String -> String
463+toHelpMessage :: Maybe String -> String
347−helpMessage maybeBadCommand =
464+toHelpMessage maybeBadCommand =
348 case maybeBadCommand of
465 case maybeBadCommand of
349 Nothing ->
466 Nothing ->
350 genericHelpMessage
467 genericHelpMessage
@@ -365,6 +482,35 @@ genericHelpMessage =
365
482
366
483
367
484
485+-- GET ROOT
486+
487+
488+getRoot :: IO FilePath
489+getRoot =
490+ do maybeRoot <- Stuff.findRoot
491+ case maybeRoot of
492+ Just root ->
493+ return root
494+
495+ Nothing ->
496+ do cache <- Stuff.getReplCache
497+ let root = cache </> "tmp"
498+ Dir.createDirectoryIfMissing True (root </> "src")
499+ Outline.write root $ Outline.Pkg $
500+ Outline.PkgOutline
501+ Pkg.dummyName
502+ Outline.defaultSummary
503+ Licenses.bsd3
504+ V.one
505+ (Outline.ExposedList [])
506+ (Map.singleton Pkg.core C.anything)
507+ Map.empty
508+ C.defaultElm
509+
510+ return root
511+
512+
513+
368-- GET INTERPRETER
514-- GET INTERPRETER
369
515
370
516
@@ -399,3 +545,54 @@ exeNotFound name =
399 ++ "I could not find executable `" ++ name ++ "` on your PATH though!\n\n"
545 ++ "I could not find executable `" ++ name ++ "` on your PATH though!\n\n"
400 ++ "You can install node.js from <http://nodejs.org/>. If it is already installed\n"
546 ++ "You can install node.js from <http://nodejs.org/>. If it is already installed\n"
401 ++ "but has a different name, use the --interpreter flag."
547 ++ "but has a different name, use the --interpreter flag."
548+
549+
550+
551+-- SETTINGS
552+
553+
554+initSettings :: IO (Repl.Settings M)
555+initSettings =
556+ do cache <- Stuff.getReplCache
557+ return $
558+ Repl.Settings
559+ { Repl.historyFile = Just (cache </> "history")
560+ , Repl.autoAddHistory = True
561+ , Repl.complete = Repl.completeWord Nothing " \n" lookupCompletions
562+ }
563+
564+
565+lookupCompletions :: String -> M [Repl.Completion]
566+lookupCompletions string =
567+ do (State imports types decls) <- State.get
568+ return $
569+ addMatches string False decls $
570+ addMatches string False types $
571+ addMatches string True imports $
572+ addMatches string False commands []
573+
574+
575+commands :: Map.Map N.Name ()
576+commands =
577+ Map.fromList
578+ [ (":exit", ())
579+ , (":quit", ())
580+ , (":reset", ())
581+ , (":help", ())
582+ ]
583+
584+
585+addMatches :: String -> Bool -> Map.Map N.Name v -> [Repl.Completion] -> [Repl.Completion]
586+addMatches string isFinished dict completions =
587+ Map.foldrWithKey (addMatch string isFinished) completions dict
588+
589+
590+addMatch :: String -> Bool -> N.Name -> v -> [Repl.Completion] -> [Repl.Completion]
591+addMatch string isFinished name _ completions =
592+ let
593+ suggestion = N.toChars name
594+ in
595+ if List.isPrefixOf string suggestion then
596+ Repl.Completion suggestion suggestion isFinished : completions
597+ else
598+ completions