32b39d8 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Update completion function when a new module is loaded using :m

32b39d8Phil Freeman13 years ago

psci/Main.hs+60−71

compare with golang

unifiedsplit

@@ -23,7 +23,7 @@ import Control.Applicative

23import Control.Monad

24import Control.Monad.Trans.Class

25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

26−import Control.Monad.Trans.State

26+import Control.Monad.Trans.State.Strict

28import Data.List (intercalate, isPrefixOf, nub, sortBy)

29import Data.Maybe (mapMaybe)

@@ -53,41 +53,38 @@ import qualified System.IO.UTF8 as U (readFile)

53-- The let bindings are partial,

54-- because it makes more sense to apply the binding to the final evaluated expression.

55--

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+ }

58-- State helpers

63-- State helpers

60-- |

65-- |

61−-- Synonym to be more descriptive.

66+-- Updates the state to have more imported modules.

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@

70--

67--

71−ioToState :: IO a -> StateT PSCI (InputT IO) a

68+updateImportedFiles :: FilePath -> PSCiState -> PSCiState

72−ioToState = lift . lift

69+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }

74-- |

71-- |

75-- Updates the state to have more imported modules.

72-- Updates the state to have more imported modules.

76--

73--

77−updateImports :: P.ModuleName -> PSCI -> PSCI

74+updateImports :: P.ModuleName -> PSCiState -> PSCiState

78−updateImports name (PSCI i m b) = PSCI (name : i) m b

75+updateImports name st = st { psciImportedModuleNames = name : psciImportedModuleNames st }

80-- |

77-- |

81-- Updates the state to have more loaded files.

78-- Updates the state to have more loaded files.

82--

79--

83−updateModules :: [P.Module] -> PSCI -> PSCI

80+updateModules :: [P.Module] -> PSCiState -> PSCiState

84−updateModules modules (PSCI i m b) = PSCI i (m ++ modules) b

81+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

86-- |

83-- |

87-- Updates the state to have more let bindings.

84-- Updates the state to have more let bindings.

88--

85--

89−updateLets :: (P.Value -> P.Value) -> PSCI -> PSCI

86+updateLets :: (P.Value -> P.Value) -> PSCiState -> PSCiState

90−updateLets name (PSCI i m b) = PSCI i m (b ++ [name])

87+updateLets name st = st { psciLetBindings = psciLetBindings st ++ [name] }

92-- File helpers

89-- File helpers

93-- |

90-- |

@@ -165,19 +162,20 @@ quitMessage = "See ya!"

165-- |

162-- |

166-- Loads module, function, and file completions.

163-- Loads module, function, and file completions.

167--

164--

168−completion :: [P.Module] -> CompletionFunc IO

165+completion :: CompletionFunc (StateT PSCiState IO)

169−completion ms = completeWord Nothing " \t\n\r" findCompletions

166+completion = completeWord Nothing " \t\n\r" findCompletions

170 where

167 where

171− findCompletions :: String -> IO [Completion]

168+ findCompletions :: String -> StateT PSCiState IO [Completion]

172 findCompletions str = do

169 findCompletions str = do

170+ ms <- psciLoadedModules <$> get

173 files <- listFiles str

171 files <- listFiles str

174− let matches = filter (isPrefixOf str) names

172+ let matches = filter (isPrefixOf str) (names ms)

175 return $ sortBy sorter $ map simpleCompletion matches ++ files

173 return $ sortBy sorter $ map simpleCompletion matches ++ files

176 getDeclName :: P.Declaration -> Maybe P.Ident

174 getDeclName :: P.Declaration -> Maybe P.Ident

177 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident

175 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident

178 getDeclName _ = Nothing

176 getDeclName _ = Nothing

179− names :: [String]

177+ names :: [P.Module] -> [String]

180− names = nub [ show qual

178+ names ms = nub [ show qual

181 | P.Module moduleName ds <- ms

179 | P.Module moduleName ds <- ms

182 , ident <- mapMaybe getDeclName ds

180 , ident <- mapMaybe getDeclName ds

183 , qual <- [ P.Qualified Nothing ident

181 , qual <- [ P.Qualified Nothing ident

@@ -212,14 +210,14 @@ createTemporaryModule exec imports lets value =

212-- |

210-- |

213-- Takes a value declaration and evaluates it with the current state.

211-- Takes a value declaration and evaluates it with the current state.

214--

212--

215−handleDeclaration :: P.Value -> PSCI -> InputT IO ()

213+handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

216−handleDeclaration value (PSCI imports loadedModules lets) = do

214+handleDeclaration value st = do

217− let m = createTemporaryModule True imports lets value

215+ let m = createTemporaryModule True (psciImportedModuleNames st) (psciLetBindings st) value

218− case P.compile options (loadedModules ++ [m]) of

216+ case P.compile options (psciLoadedModules st ++ [m]) of

219 Left err -> outputStrLn err

217 Left err -> outputStrLn err

220 Right (js, _, _) -> do

218 Right (js, _, _) -> do

221− process <- lift findNodeProcess

219+ process <- lift . lift $ findNodeProcess

222− result <- lift $ traverse (\node -> readProcessWithExitCode node [] js) process

220+ result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process

223 case result of

221 case result of

224 Just (ExitSuccess, out, _) -> outputStrLn out

222 Just (ExitSuccess, out, _) -> outputStrLn out

225 Just (ExitFailure _, _, err) -> outputStrLn err

223 Just (ExitFailure _, _, err) -> outputStrLn err

@@ -228,10 +226,10 @@ handleDeclaration value (PSCI imports loadedModules lets) = do

228-- |

226-- |

229-- Takes a value and prints its type

227-- Takes a value and prints its type

230--

228--

231−handleTypeOf :: P.Value -> PSCI -> InputT IO ()

229+handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

232−handleTypeOf value (PSCI imports loadedModules lets) = do

230+handleTypeOf value st = do

233− let m = createTemporaryModule False imports lets value

231+ let m = createTemporaryModule False (psciImportedModuleNames st) (psciLetBindings st) value

234− case P.compile options { P.optionsMain = Nothing } (loadedModules ++ [m]) of

232+ case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of

235 Left err -> outputStrLn err

233 Left err -> outputStrLn err

236 Right (_, _, env') ->

234 Right (_, _, env') ->

237 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

235 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

243-- |

241-- |

244-- Parses the input and returns either a Metacommand or an expression.

242-- Parses the input and returns either a Metacommand or an expression.

245--

243--

246−getCommand :: InputT IO (Either ParseError (Maybe Command))

244+getCommand :: InputT (StateT PSCiState IO) (Either ParseError (Maybe Command))

247getCommand = do

245getCommand = do

248 firstLine <- getInputLine "> "

246 firstLine <- getInputLine "> "

249 case firstLine of

247 case firstLine of

@@ -251,43 +249,34 @@ getCommand = do

251 Just s@ (':' : _) -> return . either Left (Right . Just) $ parseCommand s -- The start of a command

249 Just s@ (':' : _) -> return . either Left (Right . Just) $ parseCommand s -- The start of a command

252 Just s -> either Left (Right . Just) . parseCommand <$> go [s]

250 Just s -> either Left (Right . Just) . parseCommand <$> go [s]

253 where

251 where

254− go :: [String] -> InputT IO String

252+ go :: [String] -> InputT (StateT PSCiState IO) String

255 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "

253 go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "

256

254

257-- |

255-- |

258-- Performs an action for each meta-command given, and also for expressions..

256-- Performs an action for each meta-command given, and also for expressions..

259--

257--

260−handleCommand :: Command -> StateT PSCI (InputT IO) ()

258+handleCommand :: Command -> InputT (StateT PSCiState IO) ()

261−handleCommand (Expression val) = get >>= inputTToState . handleDeclaration val

259+handleCommand (Expression val) = lift get >>= handleDeclaration val

262−handleCommand (Let l) = modify (updateLets l)

260+handleCommand (Let l) = lift $ modify (updateLets l)

263−handleCommand Help = inputTToState $ outputStrLn helpMessage

261+handleCommand Help = outputStrLn helpMessage

264−handleCommand (Import moduleName) = modify (updateImports moduleName)

262+handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)

265handleCommand (LoadFile filePath) = do

263handleCommand (LoadFile filePath) = do

266− absPath <- ioToState $ expandTilde filePath

264+ absPath <- lift . lift $ expandTilde filePath

267− exists <- ioToState $ doesFileExist absPath

265+ exists <- lift . lift $ doesFileExist absPath

268− if exists then

266+ if exists then do

267+ lift $ modify (updateImportedFiles absPath)

269− either outputTStrLn (modify . updateModules) =<< ioToState (loadModule absPath)

268+ either outputStrLn (lift . modify . updateModules) =<< (lift . lift $ loadModule absPath)

270 else

269 else

271− outputTStrLn $ "Couldn't locate: " ++ filePath

270+ outputStrLn $ "Couldn't locate: " ++ filePath

272handleCommand Reset = do

271handleCommand Reset = do

273− (Right prelude) <- ioToState $ loadModule =<< getPreludeFilename

272+ preludeFilename <- lift . lift $ getPreludeFilename

274− put (PSCI defaultImports prelude [])

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 [])

275−handleCommand (TypeOf val) = get >>= inputTToState . handleTypeOf val

278+handleCommand (TypeOf val) = lift get >>= handleTypeOf val

276−handleCommand _ = outputTStrLn "Unknown command"

279+handleCommand _ = outputStrLn "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

291

280

292inputFiles :: Cmd.Term [FilePath]

281inputFiles :: Cmd.Term [FilePath]

293inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posDoc = "The input .ps files" }

282inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posDoc = "The input .ps files" }

@@ -304,17 +293,17 @@ loop files = do

304 Right modules -> do

293 Right modules -> do

305 historyFilename <- getHistoryFilename

294 historyFilename <- getHistoryFilename

306 let settings = defaultSettings {historyFile = Just historyFilename}

295 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

308 outputStrLn prologueMessage

297 outputStrLn prologueMessage

309− evalStateT go (PSCI defaultImports modules [])

298+ go

310 where

299 where

311− go :: StateT PSCI (InputT IO) ()

300+ go :: InputT (StateT PSCiState IO) ()

312 go = do

301 go = do

313− c <- inputTToState getCommand

302+ c <- getCommand

314 case c of

303 case c of

315− Left err -> outputTStrLn (show err) >> go

304+ Left err -> outputStrLn (show err) >> go

316 Right Nothing -> go

305 Right Nothing -> go

317− Right (Just Quit) -> outputTStrLn quitMessage

306+ Right (Just Quit) -> outputStrLn quitMessage

318 Right (Just c') -> handleCommand c' >> go

307 Right (Just c') -> handleCommand c' >> go

319

308

320term :: Cmd.Term (IO ())

309term :: Cmd.Term (IO ())