git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1725 from hdgarrood/fix-psci-multiple-module-definitions
3fb0e24Phil Freeman
psci/PSCi.hs+25−26
compare with golang
unifiedsplit
@@ -113,12 +113,12 @@ loadModule filename = do
113-- |
113-- |
114-- Load all modules.
114-- Load all modules.
115--
115--
116−loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])
116+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])
117loadAllModules files = do
117loadAllModules files = do
118 filesAndContent <- forM files $ \filename -> do
118 filesAndContent <- forM files $ \filename -> do
119 content <- readFile filename
119 content <- readFile filename
120− return (Right filename, content)
120+ return (filename, content)
121− return $ P.parseModulesFromFiles (either (const "") id) filesAndContent
121+ return $ P.parseModulesFromFiles id filesAndContent
122
122
123-- |
123-- |
124-- Load all modules, updating the application state
124-- Load all modules, updating the application state
@@ -129,7 +129,7 @@ loadAllImportedModules = do
129 modulesOrFirstError <- psciIO $ loadAllModules files
129 modulesOrFirstError <- psciIO $ loadAllModules files
130 case modulesOrFirstError of
130 case modulesOrFirstError of
131 Left errs -> printErrors errs
131 Left errs -> printErrors errs
132− Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
132+ Right modules -> PSCI . lift . modify $ updateModules modules
133
133
134-- |
134-- |
135-- Expands tilde in path.
135-- Expands tilde in path.
@@ -248,22 +248,24 @@ makeIO f io = do
248 e <- liftIO $ tryIOError io
248 e <- liftIO $ tryIOError io
249 either (throwError . P.singleError . f) return e
249 either (throwError . P.singleError . f) return e
250
250
251−make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> P.Make P.Environment
251+make :: PSCiState -> [P.Module] -> P.Make P.Environment
252−make PSCiState{..} ms = P.make actions' (map snd (psciLoadedModules ++ ms))
252+make st@PSCiState{..} ms = P.make actions' (map snd loadedModules ++ ms)
253 where
253 where
254− filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)
254+ filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules
255 actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
255 actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
256 actions' = actions { P.progress = const (return ()) }
256 actions' = actions { P.progress = const (return ()) }
257+ loadedModules = psciLoadedModules st
258+ allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms
257
259
258-- |
260-- |
259−-- Takes a value declaration and evaluates it with the current state.
261+-- Takes a value expression and evaluates it with the current state.
260--
262--
261−handleDeclaration :: P.Expr -> PSCI ()
263+handleExpression :: P.Expr -> PSCI ()
262−handleDeclaration val = do
264+handleExpression val = do
263 st <- PSCI $ lift get
265 st <- PSCI $ lift get
264 let m = createTemporaryModule True st val
266 let m = createTemporaryModule True st val
265 let nodeArgs = psciNodeFlags st ++ [indexFile]
267 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]
267 case e of
269 case e of
268 Left errs -> printErrors errs
270 Left errs -> printErrors errs
269 Right _ -> do
271 Right _ -> do
@@ -284,7 +286,7 @@ handleDecls ds = do
284 st <- PSCI $ lift get
286 st <- PSCI $ lift get
285 let st' = updateLets ds st
287 let st' = updateLets ds st
286 let m = createTemporaryModule False st' (P.ObjectLiteral [])
288 let m = createTemporaryModule False st' (P.ObjectLiteral [])
287− e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]
289+ e <- psciIO . runMake $ make st' [m]
288 case e of
290 case e of
289 Left err -> printErrors err
291 Left err -> printErrors err
290 Right _ -> PSCI $ lift (put st')
292 Right _ -> PSCI $ lift (put st')
@@ -294,7 +296,7 @@ handleDecls ds = do
294--
296--
295handleShowLoadedModules :: PSCI ()
297handleShowLoadedModules :: PSCI ()
296handleShowLoadedModules = do
298handleShowLoadedModules = do
297− PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
299+ loadedModules <- PSCI $ lift $ gets psciLoadedModules
298 psciIO $ readModules loadedModules >>= putStrLn
300 psciIO $ readModules loadedModules >>= putStrLn
299 return ()
301 return ()
300 where readModules = return . unlines . sort . nub . map toModuleName
302 where readModules = return . unlines . sort . nub . map toModuleName
@@ -340,7 +342,7 @@ handleImport :: ImportedModule -> PSCI ()
340handleImport im = do
342handleImport im = do
341 st <- updateImportedModules im <$> PSCI (lift get)
343 st <- updateImportedModules im <$> PSCI (lift get)
342 let m = createTemporaryModuleForImports st
344 let m = createTemporaryModuleForImports st
343− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
345+ e <- psciIO . runMake $ make st [m]
344 case e of
346 case e of
345 Left errs -> printErrors errs
347 Left errs -> printErrors errs
346 Right _ -> do
348 Right _ -> do
@@ -354,7 +356,7 @@ handleTypeOf :: P.Expr -> PSCI ()
354handleTypeOf val = do
356handleTypeOf val = do
355 st <- PSCI $ lift get
357 st <- PSCI $ lift get
356 let m = createTemporaryModule False st val
358 let m = createTemporaryModule False st val
357− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
359+ e <- psciIO . runMake $ make st [m]
358 case e of
360 case e of
359 Left errs -> printErrors errs
361 Left errs -> printErrors errs
360 Right env' ->
362 Right env' ->
@@ -491,7 +493,7 @@ handleKindOf typ = do
491 st <- PSCI $ lift get
493 st <- PSCI $ lift get
492 let m = createTemporaryModuleForKind st typ
494 let m = createTemporaryModuleForKind st typ
493 mName = P.ModuleName [P.ProperName "$PSCI"]
495 mName = P.ModuleName [P.ProperName "$PSCI"]
494− e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
496+ e <- psciIO . runMake $ make st [m]
495 case e of
497 case e of
496 Left errs -> printErrors errs
498 Left errs -> printErrors errs
497 Right env' ->
499 Right env' ->
@@ -528,16 +530,15 @@ getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
528-- Performs an action for each meta-command given, and also for expressions.
530-- Performs an action for each meta-command given, and also for expressions.
529--
531--
530handleCommand :: Command -> PSCI ()
532handleCommand :: Command -> PSCI ()
531−handleCommand (Expression val) = handleDeclaration val
533+handleCommand (Expression val) = handleExpression val
532handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
534handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
533handleCommand (Import im) = handleImport im
535handleCommand (Import im) = handleImport im
534handleCommand (Decls l) = handleDecls l
536handleCommand (Decls l) = handleDecls l
535handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
537handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
536− PSCI . lift $ modify (updateImportedFiles absPath)
537 m <- psciIO $ loadModule absPath
538 m <- psciIO $ loadModule absPath
538 case m of
539 case m of
539 Left err -> PSCI $ outputStrLn err
540 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))
541handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
542handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
542 foreignsOrError <- psciIO . runMake $ do
543 foreignsOrError <- psciIO . runMake $ do
543 foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)
544 foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readFile absPath)
@@ -546,12 +547,10 @@ handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
546 Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
547 Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
547 Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
548 Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
548handleCommand ResetState = do
549handleCommand ResetState = do
549− files <- psciImportedFilenames <$> PSCI (lift get)
550− PSCI . lift . modify $ \st -> st
550+ PSCI . lift . modify $ \st ->
551− { psciImportedFilenames = files
552− , psciImportedModules = []
551+ st { psciImportedModules = []
553− , psciLetBindings = []
552+ , psciLetBindings = []
554− }
553+ }
555 loadAllImportedModules
554 loadAllImportedModules
556handleCommand (TypeOf val) = handleTypeOf val
555handleCommand (TypeOf val) = handleTypeOf val
557handleCommand (KindOf typ) = handleKindOf typ
556handleCommand (KindOf typ) = handleKindOf typ
@@ -614,7 +613,7 @@ loop PSCiOptions{..} = do
614 case foreignsOrError of
613 case foreignsOrError of
615 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
614 Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
616 Right foreigns ->
615 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
618 outputStrLn prologueMessage
617 outputStrLn prologueMessage
619 traverse_ (traverse_ (runPSCI . handleCommand)) config
618 traverse_ (traverse_ (runPSCI . handleCommand)) config
620 modules' <- lift $ gets psciLoadedModules
619 modules' <- lift $ gets psciLoadedModules
psci/Types.hs+50−16
@@ -15,7 +15,9 @@
15
15
16module Types where
16module Types where
17
17
18+import Control.Arrow (second)
19+import Data.Map (Map)
18−import qualified Data.Map as M
20+import qualified Data.Map as Map
19import qualified Language.PureScript as P
21import qualified Language.PureScript as P
20
22
21data PSCiOptions = PSCiOptions
23data PSCiOptions = PSCiOptions
@@ -32,14 +34,48 @@ data PSCiOptions = PSCiOptions
32-- because it makes more sense to apply the binding to the final evaluated expression.
34-- because it makes more sense to apply the binding to the final evaluated expression.
33--
35--
34data PSCiState = PSCiState
36data PSCiState = PSCiState
35− { psciImportedFilenames :: [FilePath]
36− , psciImportedModules :: [ImportedModule]
37+ { psciImportedModules :: [ImportedModule]
37− , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
38+ , _psciLoadedModules :: Map FilePath [P.Module]
38− , psciForeignFiles :: M.Map P.ModuleName FilePath
39+ , psciForeignFiles :: Map P.ModuleName FilePath
39 , psciLetBindings :: [P.Declaration]
40 , psciLetBindings :: [P.Declaration]
40 , psciNodeFlags :: [String]
41 , psciNodeFlags :: [String]
41 }
42 }
42
43
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+
43-- | All of the data that is contained by an ImportDeclaration in the AST.
79-- | All of the data that is contained by an ImportDeclaration in the AST.
44-- That is:
80-- That is:
45--
81--
@@ -64,12 +100,6 @@ allImportsOf m (PSCiState{psciImportedModules = is}) =
64
100
65-- State helpers
101-- State helpers
66
102
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−
73-- |
103-- |
74-- Updates the state to have more imported modules.
104-- Updates the state to have more imported modules.
75--
105--
@@ -77,10 +107,14 @@ updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
77updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
107updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
78
108
79-- |
109-- |
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).
81--
112--
82−updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
113+updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
83−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
114+updateModules modules st =
115+ st { _psciLoadedModules = Map.union (go modules) (_psciLoadedModules st) }
116+ where
117+ go = Map.fromListWith (++) . map (second (:[]))
84
118
85-- |
119-- |
86-- Updates the state to have more let bindings.
120-- Updates the state to have more let bindings.
@@ -91,8 +125,8 @@ updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
91-- |
125-- |
92-- Updates the state to have more let bindings.
126-- Updates the state to have more let bindings.
93--
127--
94−updateForeignFiles :: M.Map P.ModuleName FilePath -> PSCiState -> PSCiState
128+updateForeignFiles :: Map P.ModuleName FilePath -> PSCiState -> PSCiState
95−updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }
129+updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `Map.union` fs }
96
130
97-- |
131-- |
98-- Valid Meta-commands for PSCI
132-- Valid Meta-commands for PSCI
psci/tests/Main.hs+1−1
@@ -142,7 +142,7 @@ getPSCiState = do
142 print err >> exitFailure
142 print err >> exitFailure
143 Right modules ->
143 Right modules ->
144 let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit True, Nothing)]
144 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 [] [])
146
146
147controlMonadSTasST :: ImportedModule
147controlMonadSTasST :: ImportedModule
148controlMonadSTasST = (s "Control.Monad.ST", P.Implicit True, Just (s "ST"))
148controlMonadSTasST = (s "Control.Monad.ST", P.Implicit True, Just (s "ST"))