3fb0e24 · rowtype-yoga/purescript-native

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

Merge pull request #1725 from hdgarrood/fix-psci-multiple-module-definitions

Ensure no duplicates appear in the PSCiState

commit3fb0e24863db35a0613f17c7b1870d1b47aebf7f authorPhil Freeman <paf31@cantab.net> dateSat 19 Dec 2015, 16:51 (11 years ago) parent65087aa 500fb11

3 files changed+76−43

compare with golang

unifiedsplit

psci/PSCi.hs+25−26 psci/Types.hs+50−16 psci/tests/Main.hs+1−1

psci/PSCi.hs+25−26

@@ -113,12 +113,12 @@ loadModule filename = do

113113-- |

114114-- Load all modules.

115115--

116−loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])

116+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])

117117loadAllModules files = do

118118 filesAndContent <- forM files $ \filename -> do

119119 content <- readFile filename

120− return (Right filename, content)

121− return $ P.parseModulesFromFiles (either (const "") id) filesAndContent

120+ return (filename, content)

121+ return $ P.parseModulesFromFiles id filesAndContent

122122

123123-- |

124124-- Load all modules, updating the application state

@@ -129,7 +129,7 @@ loadAllImportedModules = do

129129 modulesOrFirstError <- psciIO $ loadAllModules files

130130 case modulesOrFirstError of

131131 Left errs -> printErrors errs

132− Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }

132+ Right modules -> PSCI . lift . modify $ updateModules modules

133133

134134-- |

135135-- Expands tilde in path.

@@ -248,22 +248,24 @@ makeIO f io = do

248248 e <- liftIO $ tryIOError io

249249 either (throwError . P.singleError . f) return e

250250

251−make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> P.Make P.Environment

252−make PSCiState{..} ms = P.make actions' (map snd (psciLoadedModules ++ ms))

251+make :: PSCiState -> [P.Module] -> P.Make P.Environment

252+make st@PSCiState{..} ms = P.make actions' (map snd loadedModules ++ ms)

253253 where

254− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)

254+ filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules

255255 actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False

256256 actions' = actions { P.progress = const (return ()) }

257+ loadedModules = psciLoadedModules st

258+ allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms

257259

258260-- |

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

261+-- Takes a value expression and evaluates it with the current state.

260262--

261−handleDeclaration :: P.Expr -> PSCI ()

262−handleDeclaration val = do

263+handleExpression :: P.Expr -> PSCI ()

264+handleExpression val = do

263265 st <- PSCI $ lift get

264266 let m = createTemporaryModule True st val

265267 let nodeArgs = psciNodeFlags st ++ [indexFile]

266− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]

268+ e <- psciIO . runMake $ make st [supportModule, m]

267269 case e of

268270 Left errs -> printErrors errs

269271 Right _ -> do

@@ -284,7 +286,7 @@ handleDecls ds = do

284286 st <- PSCI $ lift get

285287 let st' = updateLets ds st

286288 let m = createTemporaryModule False st' (P.ObjectLiteral [])

287− e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]

289+ e <- psciIO . runMake $ make st' [m]

288290 case e of

289291 Left err -> printErrors err

290292 Right _ -> PSCI $ lift (put st')

@@ -294,7 +296,7 @@ handleDecls ds = do

294296--

295297handleShowLoadedModules :: PSCI ()

296298handleShowLoadedModules = do

297− PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get

299+ loadedModules <- PSCI $ lift $ gets psciLoadedModules

298300 psciIO $ readModules loadedModules >>= putStrLn

299301 return ()

300302 where readModules = return . unlines . sort . nub . map toModuleName

@@ -340,7 +342,7 @@ handleImport :: ImportedModule -> PSCI ()

340342handleImport im = do

341343 st <- updateImportedModules im <$> PSCI (lift get)

342344 let m = createTemporaryModuleForImports st

343− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

345+ e <- psciIO . runMake $ make st [m]

344346 case e of

345347 Left errs -> printErrors errs

346348 Right _ -> do

@@ -354,7 +356,7 @@ handleTypeOf :: P.Expr -> PSCI ()

354356handleTypeOf val = do

355357 st <- PSCI $ lift get

356358 let m = createTemporaryModule False st val

357− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

359+ e <- psciIO . runMake $ make st [m]

358360 case e of

359361 Left errs -> printErrors errs

360362 Right env' ->

@@ -491,7 +493,7 @@ handleKindOf typ = do

491493 st <- PSCI $ lift get

492494 let m = createTemporaryModuleForKind st typ

493495 mName = P.ModuleName [P.ProperName "$PSCI"]

494− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]

496+ e <- psciIO . runMake $ make st [m]

495497 case e of

496498 Left errs -> printErrors errs

497499 Right env' ->

@@ -528,16 +530,15 @@ getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do

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

529531--

530532handleCommand :: Command -> PSCI ()

531−handleCommand (Expression val) = handleDeclaration val

533+handleCommand (Expression val) = handleExpression val

532534handleCommand ShowHelp = PSCI $ outputStrLn helpMessage

533535handleCommand (Import im) = handleImport im

534536handleCommand (Decls l) = handleDecls l

535537handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do

536− PSCI . lift $ modify (updateImportedFiles absPath)

537538 m <- psciIO $ loadModule absPath

538539 case m of

539540 Left err -> PSCI $ outputStrLn err

540− Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))

541+ Right mods -> PSCI . lift $ modify (updateModules (map (absPath,) mods))

541542handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do

542543 foreignsOrError <- psciIO . runMake $ do

543544 foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)

@@ -546,12 +547,10 @@ handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do

546547 Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err

547548 Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)

548549handleCommand ResetState = do

549− files <- psciImportedFilenames <$> PSCI (lift get)

550− PSCI . lift . modify $ \st -> st

551− { psciImportedFilenames = files

552− , psciImportedModules = []

553− , psciLetBindings = []

554− }

550+ PSCI . lift . modify $ \st ->

551+ st { psciImportedModules = []

552+ , psciLetBindings = []

553+ }

555554 loadAllImportedModules

556555handleCommand (TypeOf val) = handleTypeOf val

557556handleCommand (KindOf typ) = handleKindOf typ

@@ -614,7 +613,7 @@ loop PSCiOptions{..} = do

614613 case foreignsOrError of

615614 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure

616615 Right foreigns ->

617− flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do

616+ flip evalStateT (mkPSCiState [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do

618617 outputStrLn prologueMessage

619618 traverse_ (traverse_ (runPSCI . handleCommand)) config

620619 modules' <- lift $ gets psciLoadedModules

psci/Types.hs+50−16

@@ -15,7 +15,9 @@

1515

1616module Types where

1717

18−import qualified Data.Map as M

18+import Control.Arrow (second)

19+import Data.Map (Map)

20+import qualified Data.Map as Map

1921import qualified Language.PureScript as P

2022

2123data PSCiOptions = PSCiOptions

@@ -32,14 +34,48 @@ data PSCiOptions = PSCiOptions

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

3335--

3436data PSCiState = PSCiState

35− { psciImportedFilenames :: [FilePath]

36− , psciImportedModules :: [ImportedModule]

37− , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]

38− , psciForeignFiles :: M.Map P.ModuleName FilePath

37+ { psciImportedModules :: [ImportedModule]

38+ , _psciLoadedModules :: Map FilePath [P.Module]

39+ , psciForeignFiles :: Map P.ModuleName FilePath

3940 , psciLetBindings :: [P.Declaration]

4041 , psciNodeFlags :: [String]

4142 }

4243

44+initialPSCiState :: PSCiState

45+initialPSCiState =

46+ PSCiState [] Map.empty Map.empty [] []

47+

48+mkPSCiState :: [ImportedModule]

49+ -> [(FilePath, P.Module)]

50+ -> Map P.ModuleName FilePath

51+ -> [P.Declaration]

52+ -> [String]

53+ -> PSCiState

54+mkPSCiState imported loaded foreign lets nodeFlags =

55+ (initialPSCiState

56+ |> each imported updateImportedModules

57+ |> updateModules loaded)

58+ { psciForeignFiles = foreign

59+ , psciLetBindings = lets

60+ , psciNodeFlags = nodeFlags

61+ }

62+ where

63+ x |> f = f x

64+ each xs f st = foldl (flip f) st xs

65+

66+-- Public psci state accessors

67+

68+-- | Get the imported filenames as a list.

69+psciImportedFilenames :: PSCiState -> [FilePath]

70+psciImportedFilenames = Map.keys . _psciLoadedModules

71+

72+-- | Get the loaded modules as a list.

73+psciLoadedModules :: PSCiState -> [(FilePath, P.Module)]

74+psciLoadedModules = collect . Map.toList . _psciLoadedModules

75+ where

76+ collect :: [(k, [v])] -> [(k, v)]

77+ collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]

78+

4379-- | All of the data that is contained by an ImportDeclaration in the AST.

4480-- That is:

4581--

@@ -64,12 +100,6 @@ allImportsOf m (PSCiState{psciImportedModules = is}) =

64100

65101-- State helpers

66102

67−-- |

68−-- Updates the state to have more imported modules.

69−--

70−updateImportedFiles :: FilePath -> PSCiState -> PSCiState

71−updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }

72−

73103-- |

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

75105--

@@ -77,10 +107,14 @@ updateImportedModules :: ImportedModule -> PSCiState -> PSCiState

77107updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }

78108

79109-- |

80−-- Updates the state to have more loaded files.

110+-- Updates the state to have more loaded modules (available for import, but

111+-- not necessarily imported).

81112--

82−updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState

83−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }

113+updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState

114+updateModules modules st =

115+ st { _psciLoadedModules = Map.union (go modules) (_psciLoadedModules st) }

116+ where

117+ go = Map.fromListWith (++) . map (second (:[]))

84118

85119-- |

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

@@ -91,8 +125,8 @@ updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }

91125-- |

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

93127--

94−updateForeignFiles :: M.Map P.ModuleName FilePath -> PSCiState -> PSCiState

95−updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }

128+updateForeignFiles :: Map P.ModuleName FilePath -> PSCiState -> PSCiState

129+updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `Map.union` fs }

96130

97131-- |

98132-- Valid Meta-commands for PSCI

psci/tests/Main.hs+1−1

@@ -142,7 +142,7 @@ getPSCiState = do

142142 print err >> exitFailure

143143 Right modules ->

144144 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit True, Nothing)]

145− in return (PSCiState [] imports modules foreigns [] [])

145+ in return (mkPSCiState imports modules foreigns [] [])

146146

147147controlMonadSTasST :: ImportedModule

148148controlMonadSTasST = (s "Control.Monad.ST", P.Implicit True, Just (s "ST"))