@@ -23,7 +23,7 @@ import Control.Applicative
2323import Control.Monad
2424import Control.Monad.Trans.Class
2525import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26−import Control.Monad.Trans.State
26+import Control.Monad.Trans.State.Strict
2727
2828import Data.List (intercalate, isPrefixOf, nub, sortBy)
2929import Data.Maybe (mapMaybe)
@@ -53,41 +53,38 @@ import qualified System.IO.UTF8 as U (readFile)
5353-- The let bindings are partial,
5454-- because it makes more sense to apply the binding to the final evaluated expression.
5555--
56−data PSCI = PSCI [P.ModuleName] [P.Module] [P.Value -> P.Value]
56+data PSCiState = PSCiState
57+ { psciImportedFilenames :: [FilePath]
58+ , psciImportedModuleNames :: [P.ModuleName]
59+ , psciLoadedModules :: [P.Module]
60+ , psciLetBindings :: [P.Value -> P.Value]
61+ }
5762
5863-- State helpers
5964
6065-- |
61−-- Synonym to be more descriptive.
62−-- This is just @lift@
63−--
64−inputTToState :: InputT IO a -> StateT PSCI (InputT IO) a
65−inputTToState = lift
66−
67−-- |
68−-- Synonym to be more descriptive.
69−-- This is just @lift . lift@
66+-- Updates the state to have more imported modules.
7067--
71−ioToState :: IO a -> StateT PSCI (InputT IO) a
72−ioToState = lift . lift
68+updateImportedFiles :: FilePath -> PSCiState -> PSCiState
69+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
7370
7471-- |
7572-- Updates the state to have more imported modules.
7673--
77−updateImports :: P.ModuleName -> PSCI -> PSCI
78−updateImports name (PSCI i m b) = PSCI (name : i) m b
74+updateImports :: P.ModuleName -> PSCiState -> PSCiState
75+updateImports name st = st { psciImportedModuleNames = name : psciImportedModuleNames st }
7976
8077-- |
8178-- Updates the state to have more loaded files.
8279--
83−updateModules :: [P.Module] -> PSCI -> PSCI
84−updateModules modules (PSCI i m b) = PSCI i (m ++ modules) b
80+updateModules :: [P.Module] -> PSCiState -> PSCiState
81+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
8582
8683-- |
8784-- Updates the state to have more let bindings.
8885--
89−updateLets :: (P.Value -> P.Value) -> PSCI -> PSCI
90−updateLets name (PSCI i m b) = PSCI i m (b ++ [name])
86+updateLets :: (P.Value -> P.Value) -> PSCiState -> PSCiState
87+updateLets name st = st { psciLetBindings = psciLetBindings st ++ [name] }
9188
9289-- File helpers
9390-- |
@@ -165,19 +162,20 @@ quitMessage = "See ya!"
165162-- |
166163-- Loads module, function, and file completions.
167164--
168−completion :: [P.Module] -> CompletionFunc IO
169−completion ms = completeWord Nothing " \t\n\r" findCompletions
165+completion :: CompletionFunc (StateT PSCiState IO)
166+completion = completeWord Nothing " \t\n\r" findCompletions
170167 where
171− findCompletions :: String -> IO [Completion]
168+ findCompletions :: String -> StateT PSCiState IO [Completion]
172169 findCompletions str = do
170+ ms <- psciLoadedModules <$> get
173171 files <- listFiles str
174− let matches = filter (isPrefixOf str) names
172+ let matches = filter (isPrefixOf str) (names ms)
175173 return $ sortBy sorter $ map simpleCompletion matches ++ files
176174 getDeclName :: P.Declaration -> Maybe P.Ident
177175 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
178176 getDeclName _ = Nothing
179− names :: [String]
180− names = nub [ show qual
177+ names :: [P.Module] -> [String]
178+ names ms = nub [ show qual
181179 | P.Module moduleName ds <- ms
182180 , ident <- mapMaybe getDeclName ds
183181 , qual <- [ P.Qualified Nothing ident
@@ -212,14 +210,14 @@ createTemporaryModule exec imports lets value =
212210-- |
213211-- Takes a value declaration and evaluates it with the current state.
214212--
215−handleDeclaration :: P.Value -> PSCI -> InputT IO ()
216−handleDeclaration value (PSCI imports loadedModules lets) = do
217− let m = createTemporaryModule True imports lets value
218− case P.compile options (loadedModules ++ [m]) of
213+handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()
214+handleDeclaration value st = do
215+ let m = createTemporaryModule True (psciImportedModuleNames st) (psciLetBindings st) value
216+ case P.compile options (psciLoadedModules st ++ [m]) of
219217 Left err -> outputStrLn err
220218 Right (js, _, _) -> do
221− process <- lift findNodeProcess
222− result <- lift $ traverse (\node -> readProcessWithExitCode node [] js) process
219+ process <- lift . lift $ findNodeProcess
220+ result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process
223221 case result of
224222 Just (ExitSuccess, out, _) -> outputStrLn out
225223 Just (ExitFailure _, _, err) -> outputStrLn err
@@ -228,10 +226,10 @@ handleDeclaration value (PSCI imports loadedModules lets) = do
228226-- |
229227-- Takes a value and prints its type
230228--
231−handleTypeOf :: P.Value -> PSCI -> InputT IO ()
232−handleTypeOf value (PSCI imports loadedModules lets) = do
233− let m = createTemporaryModule False imports lets value
234− case P.compile options { P.optionsMain = Nothing } (loadedModules ++ [m]) of
229+handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()
230+handleTypeOf value st = do
231+ let m = createTemporaryModule False (psciImportedModuleNames st) (psciLetBindings st) value
232+ case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of
235233 Left err -> outputStrLn err
236234 Right (_, _, env') ->
237235 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of
@@ -243,7 +241,7 @@ handleTypeOf value (PSCI imports loadedModules lets) = do
243241-- |
244242-- Parses the input and returns either a Metacommand or an expression.
245243--
246−getCommand :: InputT IO (Either ParseError (Maybe Command))
244+getCommand :: InputT (StateT PSCiState IO) (Either ParseError (Maybe Command))
247245getCommand = do
248246 firstLine <- getInputLine "> "
249247 case firstLine of
@@ -251,43 +249,34 @@ getCommand = do
251249 Just s@ (':' : _) -> return . either Left (Right . Just) $ parseCommand s -- The start of a command
252250 Just s -> either Left (Right . Just) . parseCommand <$> go [s]
253251 where
254− go :: [String] -> InputT IO String
252+ go :: [String] -> InputT (StateT PSCiState IO) String
255253 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
256254
257255-- |
258256-- Performs an action for each meta-command given, and also for expressions..
259257--
260−handleCommand :: Command -> StateT PSCI (InputT IO) ()
261−handleCommand (Expression val) = get >>= inputTToState . handleDeclaration val
262−handleCommand (Let l) = modify (updateLets l)
263−handleCommand Help = inputTToState $ outputStrLn helpMessage
264−handleCommand (Import moduleName) = modify (updateImports moduleName)
258+handleCommand :: Command -> InputT (StateT PSCiState IO) ()
259+handleCommand (Expression val) = lift get >>= handleDeclaration val
260+handleCommand (Let l) = lift $ modify (updateLets l)
261+handleCommand Help = outputStrLn helpMessage
262+handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)
265263handleCommand (LoadFile filePath) = do
266− absPath <- ioToState $ expandTilde filePath
267− exists <- ioToState $ doesFileExist absPath
268− if exists then
269− either outputTStrLn (modify . updateModules) =<< ioToState (loadModule absPath)
264+ absPath <- lift . lift $ expandTilde filePath
265+ exists <- lift . lift $ doesFileExist absPath
266+ if exists then do
267+ lift $ modify (updateImportedFiles absPath)
268+ either outputStrLn (lift . modify . updateModules) =<< (lift . lift $ loadModule absPath)
270269 else
271− outputTStrLn $ "Couldn't locate: " ++ filePath
270+ outputStrLn $ "Couldn't locate: " ++ filePath
272271handleCommand Reset = do
273− (Right prelude) <- ioToState $ loadModule =<< getPreludeFilename
274− put (PSCI defaultImports prelude [])
275−handleCommand (TypeOf val) = get >>= inputTToState . handleTypeOf val
276−handleCommand _ = outputTStrLn "Unknown command"
277−
278−-- Command helpers
279−
280−-- |
281−-- Lifts the output call to the StateT.
282−--
283−outputTStrLn :: String -> StateT PSCI (InputT IO) ()
284−outputTStrLn = inputTToState . outputStrLn
285−
286−-- |
287−-- The corresponding @print@ version for the StateT.
288−--
289−outprintT :: Show a => a -> StateT PSCI (InputT IO) ()
290−outprintT = outputTStrLn . show
272+ preludeFilename <- lift . lift $ getPreludeFilename
273+ files <- psciImportedFilenames <$> lift get
274+ modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) (preludeFilename : files)
275+ case modulesOrFirstError of
276+ Left err -> lift . lift $ putStrLn err >> exitFailure
277+ Right modules -> lift $ put (PSCiState (preludeFilename : files) defaultImports modules [])
278+handleCommand (TypeOf val) = lift get >>= handleTypeOf val
279+handleCommand _ = outputStrLn "Unknown command"
291280
292281inputFiles :: Cmd.Term [FilePath]
293282inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posDoc = "The input .ps files" }
@@ -304,17 +293,17 @@ loop files = do
304293 Right modules -> do
305294 historyFilename <- getHistoryFilename
306295 let settings = defaultSettings {historyFile = Just historyFilename}
307− runInputT (setComplete (completion modules) settings) $ do
296+ flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do
308297 outputStrLn prologueMessage
309− evalStateT go (PSCI defaultImports modules [])
298+ go
310299 where
311− go :: StateT PSCI (InputT IO) ()
300+ go :: InputT (StateT PSCiState IO) ()
312301 go = do
313− c <- inputTToState getCommand
302+ c <- getCommand
314303 case c of
315− Left err -> outputTStrLn (show err) >> go
304+ Left err -> outputStrLn (show err) >> go
316305 Right Nothing -> go
317− Right (Just Quit) -> outputTStrLn quitMessage
306+ Right (Just Quit) -> outputStrLn quitMessage
318307 Right (Just c') -> handleCommand c' >> go
319308
320309term :: Cmd.Term (IO ())