git.iko.soy/elk
on 8f7c3cd help sign in
elk/cli/src/Repl.hs
386 lines 9.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Repl where
6import Prelude hiding (lines, read)
7import Control.Applicative ((<|>))
8import Control.Monad.RWS (lift, liftIO)
9import qualified Control.Monad.RWS as RWS
10import qualified Data.ByteString.Builder as B
11import qualified Data.ByteString.Char8 as BS
12import qualified Data.ByteString.Lazy as LBS
13import qualified Data.List as List
14import qualified Data.Map as Map
15import Data.Monoid ((<>))
16import qualified Data.Text as Text
17import qualified Data.Text.Encoding as Text
18import qualified System.Console.Haskeline as Repl
19import qualified System.Directory as Dir
20import qualified System.Exit as Exit
21import System.FilePath ((</>))
22import qualified System.IO as IO
23import qualified System.Process as Proc
25import qualified Elm.Compiler as Elm (version)
26import qualified Elm.Name as N
27import qualified Elm.Project as Project
28import qualified Elm.Package as Pkg
29import qualified Elm.PerUserCache as PerUserCache
30import qualified Elm.Utils as Elm
31import qualified Reporting.Task as Task
32import qualified Reporting.Progress.Repl as Repl
34import qualified CommandLine.Args as Args
38-- RUN
41run :: Args.ReplFlags -> IO ()
42run (Args.ReplFlags maybeAlternateInterpreter) =
43 do interpreter <- getInterpreter maybeAlternateInterpreter
44 _ <- Project.getRootWithReplFallback
45 putStrLn welcomeMessage
46 settings <- initSettings
47 let manager = Repl.runInputT settings (Repl.withInterrupt loop)
48 (exitCode,_,_) <- RWS.runRWST manager interpreter initalState
49 Exit.exitWith exitCode
52type Runner =
53 RWS.RWST FilePath () State IO
57-- LOOP
60loop :: Repl.InputT Runner Exit.ExitCode
61loop =
62 do input <- Repl.handleInterrupt (return Skip) read
63 maybe loop return =<< lift (eval input)
67-- READ
70read :: Repl.InputT Runner Input
71read =
72 readHelp "> " []
75readHelp :: String -> [String] -> Repl.InputT Runner Input
76readHelp starter lines =
77 do input <- Repl.getInputLine starter
78 case input of
79 Nothing ->
80 return Exit
82 Just line ->
83 if not (null line) && last line == '\\'
84 then readHelp "| " (init line : lines)
85 else return $ toInput $ List.intercalate "\n" $ reverse (line : lines)
89-- EVAL
92eval :: Input -> Runner (Maybe Exit.ExitCode)
93eval input =
94 case input of
95 Skip ->
96 return Nothing
98 Exit ->
99 return (Just Exit.ExitSuccess)
101 Reset ->
102 do RWS.put initalState
103 report "<reset>"
105 Help info ->
106 report (helpMessage info)
108 Code entry ->
109 Repl.handleInterrupt (report "<cancelled>") $
110 do state@(State _ imports types defs tricks) <- RWS.get
111 case entry of
112 Elm.Import name src ->
113 interpret None $ state { _imports = Map.insert name src imports }
115 Elm.Type name src ->
116 interpret None $ state { _types = Map.insert name src types }
118 Elm.Def (Just name) src ->
119 interpret (Def name) $ state { _defs = Map.insert name src defs }
121 Elm.Def Nothing src ->
122 interpret None $ state { _tricks = src : tricks }
124 Elm.Other src ->
125 interpret (Expr src) state
127 Elm.Annotation ->
128 report "I cannot handle type annotations."
130 Elm.Port ->
131 report "I cannot handle port declarations."
134toUtf8 :: String -> BS.ByteString
135toUtf8 string =
136 LBS.toStrict (B.toLazyByteString (B.stringUtf8 string))
139report :: String -> Runner (Maybe a)
140report msg =
141 do liftIO (putStrLn msg)
142 return Nothing
145data Output = None | Def N.Name | Expr Text.Text
148interpret :: Output -> State -> Runner (Maybe a)
149interpret def state =
150 do reporter <- liftIO $ Repl.create
151 result <- liftIO $ Task.run reporter $ compile def state
153 case result of
154 Nothing ->
155 return ()
157 Just maybePath ->
158 do RWS.put (state { _count = _count state + 1 })
159 maybe (return ()) interpretHelp maybePath
161 return Nothing
164interpretHelp :: FilePath -> Runner ()
165interpretHelp path =
166 do interpreter <- RWS.ask
167 let proc = (Proc.proc interpreter [path]) { Proc.std_in = Proc.CreatePipe }
168 liftIO $ Proc.withCreateProcess proc $ \_ _ _ handle ->
169 do _ <- Proc.waitForProcess handle
170 Dir.removeFile path
174-- INPUT
177data Input
178 = Skip
179 | Exit
180 | Reset
181 | Help (Maybe String)
182 | Code Elm.Entry
185toInput :: String -> Input
186toInput string =
187 case dropWhile (==' ') string of
188 ":exit" ->
189 Exit
191 ":help" ->
192 Help Nothing
194 ":reset" ->
195 Reset
197 ':' : rest ->
198 Help (Just (takeWhile (/=' ') rest))
200 "" ->
201 Skip
203 _ ->
204 Code (Elm.parseEntry string)
208-- STATE
211data State =
212 State
213 { _count :: !Int
214 , _imports :: Map.Map N.Name Text.Text
215 , _types :: Map.Map N.Name Text.Text
216 , _defs :: Map.Map N.Name Text.Text
217 , _tricks :: [Text.Text]
218 }
221initalState :: State
222initalState =
223 State 0 Map.empty Map.empty Map.empty []
226compile :: Output -> State -> Task.Task (Maybe FilePath)
227compile output (State count imports types defs tricks) =
228 let
229 elmSourceCode =
230 (<>) "module ElmRepl exposing (..)\n\n" $
231 addLines imports $ addLines types $ addLines defs $
232 List.foldr (<>) mempty (map Text.encodeUtf8Builder tricks)
233 in
234 case output of
235 None ->
236 if Map.null types && Map.null defs && null tricks then
237 evaluate (elmSourceCode <> "unit = ()") Nothing
238 else
239 evaluate elmSourceCode Nothing
241 Def name ->
242 evaluate elmSourceCode (Just name)
244 Expr expr ->
245 let
246 name = N.addIndex "repl_value_" count
247 text = Text.replace "\n" "\n " expr
248 def = N.toBuilder name <> " =\n " <> Text.encodeUtf8Builder text <> "\n"
249 in
250 evaluate (elmSourceCode <> def) (Just name)
253addLines :: Map.Map N.Name Text.Text -> B.Builder -> B.Builder
254addLines dict builder =
255 Map.foldr (\text b -> Text.encodeUtf8Builder text <> b) builder dict
258evaluate :: B.Builder -> Maybe N.Name -> Task.Task (Maybe FilePath)
259evaluate builder maybeName =
260 Project.compileForRepl (LBS.toStrict (B.toLazyByteString builder)) maybeName
264-- SETTINGS
267initSettings :: IO (Repl.Settings Runner)
268initSettings =
269 do cache <- PerUserCache.getReplRoot
270 return $
271 Repl.Settings
272 { Repl.historyFile = Just (cache </> "history")
273 , Repl.autoAddHistory = True
274 , Repl.complete = Repl.completeWord Nothing " \n" lookupCompletions
275 }
278lookupCompletions :: String -> Runner [Repl.Completion]
279lookupCompletions string =
280 do (State _ imports types defs _) <- RWS.get
281 return $
282 addMatches string False defs $
283 addMatches string False types $
284 addMatches string True imports $
285 addMatches string False commands []
288commands :: Map.Map N.Name ()
289commands =
290 Map.fromList [ (":exit", ()), (":quit", ()), (":reset", ()), (":help", ()) ]
293addMatches :: String -> Bool -> Map.Map N.Name v -> [Repl.Completion] -> [Repl.Completion]
294addMatches string isFinished dict completions =
295 Map.foldrWithKey (addMatch string isFinished) completions dict
298addMatch :: String -> Bool -> N.Name -> v -> [Repl.Completion] -> [Repl.Completion]
299addMatch string isFinished name _ completions =
300 let suggestion = N.toString name in
301 if List.isPrefixOf string suggestion then
302 Repl.Completion (drop (length string) suggestion) suggestion isFinished : completions
303 else
304 completions
308-- WELCOME
311welcomeMessage :: String
312welcomeMessage =
313 let
314 starter =
315 "---- Elm " ++ elmVersion ++ " "
316 in
317 starter ++ replicate (80 - length starter) '-' ++ "\n"
318 ++ " :help for help, :exit to exit, more at <https://github.com/elm-lang/elm-repl>\n"
319 ++ "--------------------------------------------------------------------------------"
322elmVersion :: String
323elmVersion =
324 Pkg.versionToString Elm.version
328-- HELP MESSAGES
331helpMessage :: Maybe String -> String
332helpMessage maybeBadCommand =
333 case maybeBadCommand of
334 Nothing ->
335 genericHelpMessage
337 Just command ->
338 "I do not recognize the :" ++ command ++ " command. " ++ genericHelpMessage
341genericHelpMessage :: String
342genericHelpMessage =
343 "Valid commands include:\n\
344 \\n\
345 \ :exit Exit the REPL\n\
346 \ :help Show this information\n\
347 \ :reset Clear all previous imports and definitions\n\
348 \\n\
349 \More info at <https://github.com/elm-lang/elm/blob/" ++ elmVersion ++ "/help/repl.md>\n"
353-- GET INTERPRETER
356getInterpreter :: Maybe String -> IO FilePath
357getInterpreter maybeName =
358 case maybeName of
359 Just name ->
360 getInterpreterHelp name (Dir.findExecutable name)
362 Nothing ->
363 getInterpreterHelp "node` or `nodejs" $
364 do exe1 <- Dir.findExecutable "node"
365 exe2 <- Dir.findExecutable "nodejs"
366 return (exe1 <|> exe2)
369getInterpreterHelp :: String -> IO (Maybe FilePath) -> IO FilePath
370getInterpreterHelp name findExe =
371 do maybePath <- findExe
372 case maybePath of
373 Just path ->
374 return path
376 Nothing ->
377 do IO.hPutStrLn IO.stderr (exeNotFound name)
378 Exit.exitFailure
381exeNotFound :: String -> String
382exeNotFound name =
383 "The REPL relies on node.js to execute JavaScript code outside the browser.\n"
384 ++ "I could not find executable `" ++ name ++ "` on your PATH though!\n\n"
385 ++ "You can install node.js from <http://nodejs.org/>. If it is already installed\n"
386 ++ "but has a different name, use the --interpreter flag."