da7b120 · rowtype-yoga/purescript-native

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

Merge pull request #956 from hdgarrood/psci-imports

First stab at better imports in psci

commitda7b120732395c7e0455c168e3586df3fc1fcb66 authorPhil Freeman <paf31@cantab.net> dateSun 15 Mar 2015, 14:53 (12 years ago) parent10a5416 d7e0047

9 files changed+173−98

compare with golang

unifiedsplit

psci/Commands.hs+14−3 psci/Directive.hs−3 psci/Main.hs+49−26 psci/Parser.hs+86−49 src/Language/PureScript.hs+1−1 src/Language/PureScript/AST/Declarations.hs+5−5 src/Language/PureScript/Parser/Declarations.hs+13−6 src/Language/PureScript/Pretty/Values.hs+1−1 src/Language/PureScript/Sugar/Names.hs+4−4

psci/Commands.hs+14−3

@@ -32,7 +32,7 @@ data Command

3232 -- |

3333 -- Import a module from a loaded file

3434 --

35− | Import ModuleName

35+ | Import ImportedModule

3636 -- |

3737 -- Browse a module

3838 --

@@ -50,9 +50,9 @@ data Command

5050 --

5151 | Reset

5252 -- |

53− -- Binds a value to a name

53+ -- Add some declarations to the current evaluation context.

5454 --

55− | Let [Declaration]

55+ | Decls [Declaration]

5656 -- |

5757 -- Find the type of an expression

5858 --

@@ -65,3 +65,14 @@ data Command

6565 -- Show command

6666 --

6767 | Show String

68+

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

70+-- That is:

71+--

72+-- * A module name, the name of the module which is being imported

73+-- * An ImportDeclarationType which specifies whether there is an explicit

74+-- import list, a hiding list, or neither.

75+-- * If the module is imported qualified, its qualified name in the importing

76+-- module. Otherwise, Nothing.

77+--

78+type ImportedModule = (ModuleName, ImportDeclarationType, Maybe ModuleName)

psci/Directive.hs−3

@@ -21,7 +21,6 @@ data Directive

2121 = Help

2222 | Quit

2323 | Reset

24− | Import

2524 | Browse

2625 | Load

2726 | Type

@@ -36,7 +35,6 @@ commands :: Directive -> [String]

3635commands Help = ["?", "help"]

3736commands Quit = ["quit"]

3837commands Reset = ["reset"]

39−commands Import = ["import"]

4038commands Browse = ["browse"]

4139commands Load = ["load", "module"]

4240commands Type = ["type"]

@@ -66,7 +64,6 @@ help =

6664 [ (Help, "", "Show this help menu")

6765 , (Quit, "", "Quit PSCi")

6866 , (Reset, "", "Reset")

69− , (Import, "<module>", "Import <module> for use in PSCI")

7067 , (Browse, "<module>", "Browse <module>")

7168 , (Load, "<file>", "Load <file> for importing")

7269 , (Type, "<expr>", "Show the type of <expr>")

psci/Main.hs+49−26

@@ -72,12 +72,16 @@ data PSCiOptions = PSCiOptions

7272--

7373data PSCiState = PSCiState

7474 { psciImportedFilenames :: [FilePath]

75− , psciImportedModuleNames :: [P.ModuleName]

75+ , psciImportedModules :: [C.ImportedModule]

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

7777 , psciLetBindings :: [P.Declaration]

7878 , psciNodeFlags :: [String]

7979 }

8080

81+psciImportedModuleNames :: PSCiState -> [P.ModuleName]

82+psciImportedModuleNames (PSCiState{psciImportedModules = is}) =

83+ map (\(mn, _, _) -> mn) is

84+

8185-- State helpers

8286

8387-- |

@@ -89,8 +93,8 @@ updateImportedFiles filename st = st { psciImportedFilenames = filename : psciIm

8993-- |

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

9195--

92−updateImports :: P.ModuleName -> PSCiState -> PSCiState

93−updateImports name st = st { psciImportedModuleNames = name : psciImportedModuleNames st }

96+updateImportedModules :: C.ImportedModule -> PSCiState -> PSCiState

97+updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }

9498

9599-- |

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

@@ -108,8 +112,8 @@ updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }

108112-- |

109113-- Load the necessary modules.

110114--

111−defaultImports :: [P.ModuleName]

112−defaultImports = [P.ModuleName [P.ProperName "Prelude"]]

115+defaultImports :: [C.ImportedModule]

116+defaultImports = [(P.ModuleName [P.ProperName "Prelude"], D.Implicit, Nothing)]

113117

114118-- |

115119-- Locates the node executable.

@@ -181,7 +185,7 @@ helpMessage = "The following commands are available:\n\n " ++

181185 , replicate (11 - length arg) ' '

182186 , desc

183187 ]

184− where cmd = ":" ++ head (D.commands dir)

188+ where cmd = ":" ++ head (D.commands dir)

185189

186190-- |

187191-- The welcome prologue.

@@ -223,7 +227,6 @@ completionContext (':' : cmd) word =

223227 dstr = takeWhile (not . isSpace) cmd

224228

225229 context :: D.Directive -> Maybe CompletionContext

226− context D.Import = Just Module

227230 context D.Browse = Just Module

228231 context D.Load = Just $ FilePath word

229232 context D.Quit = Nothing

@@ -370,10 +373,9 @@ mkdirp = createDirectoryIfMissing True . takeDirectory

370373-- Makes a volatile module to execute the current expression.

371374--

372375createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module

373−createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} val =

376+createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =

374377 let

375378 moduleName = P.ModuleName [P.ProperName "$PSCI"]

376− importDecl m = P.ImportDeclaration m P.Unqualified Nothing

377379 traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]

378380 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))

379381 mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

@@ -388,10 +390,9 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

388390-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.

389391--

390392createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module

391−createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =

393+createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =

392394 let

393395 moduleName = P.ModuleName [P.ProperName "$PSCI"]

394− importDecl m = P.ImportDeclaration m P.Unqualified Nothing

395396 itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ

396397 in

397398 P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing

@@ -400,13 +401,15 @@ createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =

400401-- Makes a volatile module to execute the current imports.

401402--

402403createTemporaryModuleForImports :: PSCiState -> P.Module

403−createTemporaryModuleForImports PSCiState{psciImportedModuleNames = imports} =

404+createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =

404405 let

405406 moduleName = P.ModuleName [P.ProperName "$PSCI"]

406− importDecl m = P.ImportDeclaration m P.Unqualified Nothing

407407 in

408408 P.Module [] moduleName (importDecl `map` imports) Nothing

409409

410+importDecl :: C.ImportedModule -> P.Declaration

411+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ

412+

410413modulesDir :: FilePath

411414modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"

412415

@@ -434,11 +437,11 @@ handleDeclaration val = do

434437 Nothing -> PSCI $ outputStrLn "Couldn't find node.js"

435438

436439-- |

437−-- Takes a let declaration and updates the environment, then run a make. If the declaration fails,

438−-- restore the pre-let environment.

440+-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,

441+-- restore the original environment.

439442--

440−handleLet :: [P.Declaration] -> PSCI ()

441−handleLet ds = do

443+handleDecls :: [P.Declaration] -> PSCI ()

444+handleDecls ds = do

442445 st <- PSCI $ lift get

443446 let st' = updateLets ds st

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

@@ -463,17 +466,37 @@ handleShowLoadedModules = do

463466--

464467handleShowImportedModules :: PSCI ()

465468handleShowImportedModules = do

466− PSCiState { psciImportedModuleNames = importedModuleNames } <- PSCI $ lift get

467− psciIO $ readModules importedModuleNames >>= putStrLn

469+ PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get

470+ psciIO $ showModules importedModules >>= putStrLn

468471 return ()

469− where readModules = return . unlines . sort . map N.runModuleName

472+ where

473+ showModules = return . unlines . sort . map showModule

474+ showModule (mn, declType, asQ) =

475+ "import " ++ case asQ of

476+ Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'

477+ Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType

478+

479+ showDeclType D.Implicit = ""

480+ showDeclType (D.Explicit refs) = refsList refs

481+ showDeclType (D.Hiding refs) = "hiding " ++ refsList refs

482+ refsList refs = "(" ++ commaList (map showRef refs) ++ ")"

483+

484+ showRef :: P.DeclarationRef -> String

485+ showRef (D.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"

486+ showRef (D.ValueRef ident) = show ident

487+ showRef (D.TypeClassRef pn) = show pn

488+ showRef (D.TypeInstanceRef ident) = show ident

489+ showRef (D.PositionedDeclarationRef _ _ ref) = showRef ref

490+

491+ commaList :: [String] -> String

492+ commaList = intercalate ", "

470493

471494-- |

472495-- Imports a module, preserving the initial state on failure.

473496--

474−handleImport :: P.ModuleName -> PSCI ()

475−handleImport moduleName = do

476− st <- updateImports moduleName <$> PSCI (lift get)

497+handleImport :: C.ImportedModule -> PSCI ()

498+handleImport im = do

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

477500 let m = createTemporaryModuleForImports st

478501 e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []

479502 case e of

@@ -575,8 +598,8 @@ getCommand singleLineMode = do

575598handleCommand :: C.Command -> PSCI ()

576599handleCommand (C.Expression val) = handleDeclaration val

577600handleCommand C.Help = PSCI $ outputStrLn helpMessage

578−handleCommand (C.Import moduleName) = handleImport moduleName

579−handleCommand (C.Let l) = handleLet l

601+handleCommand (C.Import im) = handleImport im

602+handleCommand (C.Decls l) = handleDecls l

580603handleCommand (C.LoadFile filePath) = do

581604 absPath <- psciIO $ expandTilde filePath

582605 exists <- psciIO $ doesFileExist absPath

@@ -592,7 +615,7 @@ handleCommand C.Reset = do

592615 files <- psciImportedFilenames <$> PSCI (lift get)

593616 PSCI . lift . modify $ \st -> st

594617 { psciImportedFilenames = files

595− , psciImportedModuleNames = defaultImports

618+ , psciImportedModules = defaultImports

596619 , psciLetBindings = []

597620 }

598621 loadAllImportedModules

psci/Parser.hs+86−49

@@ -13,8 +13,8 @@

1313--

1414-----------------------------------------------------------------------------

1515

16−module Parser (

17− parseCommand

16+module Parser

17+ ( parseCommand

1818 ) where

1919

2020import Prelude hiding (lex)

@@ -38,51 +38,88 @@ parseCommand :: String -> Either String C.Command

3838parseCommand cmdString =

3939 case cmdString of

4040 (':' : cmd) -> parseDirective cmd

41− _ -> parseRest (psciLet <|> psciExpression) cmdString

41+ _ -> parseRest psciCommand cmdString

42+

43+parseRest :: P.TokenParser a -> String -> Either String a

44+parseRest p s = either (Left . show) Right $ do

45+ ts <- P.lex "" s

46+ P.runTokenParser "" (p <* eof) ts

47+

48+psciCommand :: P.TokenParser C.Command

49+psciCommand = choice (map try parsers)

4250 where

43− parseRest :: P.TokenParser a -> String -> Either String a

44− parseRest p s = either (Left . show) Right $ do

45− ts <- P.lex "" s

46− P.runTokenParser "" (p <* eof) ts

47−

48− trim :: String -> String

49− trim = trimEnd . trimStart

50−

51− trimStart :: String -> String

52− trimStart = dropWhile isSpace

53−

54− trimEnd :: String -> String

55− trimEnd = reverse . trimStart . reverse

56−

57− parseDirective :: String -> Either String C.Command

58− parseDirective cmd =

59− case D.parseDirective dstr of

60− Just D.Help -> return C.Help

61− Just D.Quit -> return C.Quit

62− Just D.Reset -> return C.Reset

63− Just D.Import -> C.Import <$> parseRest P.moduleName arg

64− Just D.Browse -> C.Browse <$> parseRest P.moduleName arg

65− Just D.Load -> return $ C.LoadFile (trim arg)

66− Just D.Show -> return $ C.Show (trim arg)

67− Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg

68− Just D.Kind -> C.KindOf <$> parseRest P.parseType arg

69− Nothing -> Left $ "Unrecognized command. Type :? for help."

70− where (dstr, arg) = break isSpace cmd

71−

72− -- |

73− -- Parses expressions entered at the PSCI repl.

74− --

75− psciExpression :: P.TokenParser C.Command

76− psciExpression = C.Expression <$> P.parseValue

77−

78− -- |

79− -- PSCI version of @let@.

80− -- This is essentially let from do-notation.

81− -- However, since we don't support the @Eff@ monad,

82− -- we actually want the normal @let@.

83− --

84− psciLet :: P.TokenParser C.Command

85− psciLet = C.Let <$> (P.reserved "let" *> P.indented *> manyDecls)

86− where

87− manyDecls :: P.TokenParser [P.Declaration]

88− manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))

51+ parsers =

52+ [ psciLet

53+ , psciImport

54+ , psciOtherDeclaration

55+ , psciExpression

56+ ]

57+

58+trim :: String -> String

59+trim = trimEnd . trimStart

60+

61+trimStart :: String -> String

62+trimStart = dropWhile isSpace

63+

64+trimEnd :: String -> String

65+trimEnd = reverse . trimStart . reverse

66+

67+parseDirective :: String -> Either String C.Command

68+parseDirective cmd =

69+ case D.parseDirective dstr of

70+ Just D.Help -> return C.Help

71+ Just D.Quit -> return C.Quit

72+ Just D.Reset -> return C.Reset

73+ Just D.Browse -> C.Browse <$> parseRest P.moduleName arg

74+ Just D.Load -> return $ C.LoadFile (trim arg)

75+ Just D.Show -> return $ C.Show (trim arg)

76+ Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg

77+ Just D.Kind -> C.KindOf <$> parseRest P.parseType arg

78+ Nothing -> Left $ "Unrecognized command. Type :? for help."

79+ where (dstr, arg) = break isSpace cmd

80+

81+-- |

82+-- Parses expressions entered at the PSCI repl.

83+--

84+psciExpression :: P.TokenParser C.Command

85+psciExpression = C.Expression <$> P.parseValue

86+

87+-- |

88+-- PSCI version of @let@.

89+-- This is essentially let from do-notation.

90+-- However, since we don't support the @Eff@ monad,

91+-- we actually want the normal @let@.

92+--

93+psciLet :: P.TokenParser C.Command

94+psciLet = C.Decls <$> (P.reserved "let" *> P.indented *> manyDecls)

95+ where

96+ manyDecls :: P.TokenParser [P.Declaration]

97+ manyDecls = C.mark (many1 (C.same *> P.parseLocalDeclaration))

98+

99+-- | Imports must be handled separately from other declarations, so that

100+-- :show import works, for example.

101+psciImport :: P.TokenParser C.Command

102+psciImport = C.Import <$> P.parseImportDeclaration'

103+

104+-- | Any other declaration that we don't need a 'special case' parser for

105+-- (like let or import declarations).

106+psciOtherDeclaration :: P.TokenParser C.Command

107+psciOtherDeclaration = C.Decls . (:[]) <$> do

108+ decl <- discardPositionInfo <$> P.parseDeclaration

109+ if acceptable decl

110+ then return decl

111+ else fail "this kind of declaration is not supported in psci"

112+

113+discardPositionInfo :: P.Declaration -> P.Declaration

114+discardPositionInfo (P.PositionedDeclaration _ _ d) = d

115+discardPositionInfo d = d

116+

117+acceptable :: P.Declaration -> Bool

118+acceptable (P.DataDeclaration _ _ _ _) = True

119+acceptable (P.TypeSynonymDeclaration _ _ _) = True

120+acceptable (P.ExternDeclaration _ _ _ _) = True

121+acceptable (P.ExternDataDeclaration _ _) = True

122+acceptable (P.ExternInstanceDeclaration _ _ _ _) = True

123+acceptable (P.TypeClassDeclaration _ _ _ _) = True

124+acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True

125+acceptable _ = False

src/Language/PureScript.hs+1−1

@@ -257,7 +257,7 @@ reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]

257257addDefaultImport :: ModuleName -> Module -> Module

258258addDefaultImport toImport m@(Module coms mn decls exps) =

259259 if isExistingImport `any` decls || mn == toImport then m

260− else Module coms mn (ImportDeclaration toImport Unqualified Nothing : decls) exps

260+ else Module coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps

261261 where

262262 isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True

263263 isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

src/Language/PureScript/AST/Declarations.hs+5−5

@@ -127,15 +127,15 @@ instance Eq DeclarationRef where

127127--

128128data ImportDeclarationType

129129 -- |

130− -- Unqualified import

130+ -- An import with no explicit list: `import M`

131131 --

132− = Unqualified

132+ = Implicit

133133 -- |

134− -- Qualified import with a list of references to import

134+ -- An import with an explicit list of references to import: `import M (foo)`

135135 --

136− | Qualifying [DeclarationRef]

136+ | Explicit [DeclarationRef]

137137 -- |

138− -- Import with hiding clause with a list of references to hide

138+ -- An import with a list of references to hide: `import M hiding (foo)`

139139 --

140140 | Hiding [DeclarationRef]

141141 deriving (Show, D.Data, D.Typeable)

src/Language/PureScript/Parser/Declarations.hs+13−6

@@ -24,6 +24,8 @@ module Language.PureScript.Parser.Declarations (

2424 parseGuard,

2525 parseBinder,

2626 parseBinderNoParens,

27+ parseImportDeclaration',

28+ parseLocalDeclaration

2729) where

2830

2931import Prelude hiding (lex)

@@ -146,6 +148,11 @@ parseFixityDeclaration = do

146148

147149parseImportDeclaration :: TokenParser Declaration

148150parseImportDeclaration = do

151+ (mn, declType, asQ) <- parseImportDeclaration'

152+ return $ ImportDeclaration mn declType asQ

153+

154+parseImportDeclaration' :: TokenParser (ModuleName, ImportDeclarationType, (Maybe ModuleName))

155+parseImportDeclaration' = do

149156 reserved "import"

150157 indented

151158 qualImport <|> stdImport

@@ -157,21 +164,21 @@ parseImportDeclaration = do

157164 stdImportHiding mn = do

158165 reserved "hiding"

159166 declType <- importDeclarationType Hiding

160− return $ ImportDeclaration mn declType Nothing

167+ return (mn, declType, Nothing)

161168 stdImportQualifying mn = do

162− declType <- importDeclarationType Qualifying

163− return $ ImportDeclaration mn declType Nothing

169+ declType <- importDeclarationType Explicit

170+ return (mn, declType, Nothing)

164171 qualImport = do

165172 reserved "qualified"

166173 indented

167174 moduleName' <- moduleName

168− declType <- importDeclarationType Qualifying

175+ declType <- importDeclarationType Explicit

169176 reserved "as"

170177 asQ <- moduleName

171− return $ ImportDeclaration moduleName' declType (Just asQ)

178+ return (moduleName', declType, Just asQ)

172179 importDeclarationType expectedType = do

173180 idents <- P.optionMaybe $ indented *> (parens $ commaSep parseDeclarationRef)

174− return $ fromMaybe Unqualified (expectedType <$> idents)

181+ return $ fromMaybe Implicit (expectedType <$> idents)

175182

176183

177184parseDeclarationRef :: TokenParser DeclarationRef

src/Language/PureScript/Pretty/Values.hs+1−1

@@ -1,7 +1,7 @@

11-----------------------------------------------------------------------------

22--

33-- Module : Language.PureScript.Pretty.Values

4−-- Copyright : Kinds.hs(c) Phil Freeman 2013

4+-- Copyright : (c) Phil Freeman 2013

55-- License : MIT

66--

77-- Maintainer : Phil Freeman <paf31@cantab.net>

src/Language/PureScript/Sugar/Names.hs+4−4

@@ -199,7 +199,7 @@ elaborateImports (Module coms mn decls exps) = Module coms mn decls' exps

199199 fqValues (Var (Qualified (Just mn') _)) = [mn']

200200 fqValues _ = []

201201 mkImport :: ModuleName -> Declaration

202− mkImport mn' = ImportDeclaration mn' (Qualifying []) Nothing

202+ mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing

203203

204204-- |

205205-- Replaces all local names with qualified names within a module and checks that all existing

@@ -417,7 +417,7 @@ resolveImports env (Module _ currentModule decls _) =

417417 -- module (where Nothing indicates everything is to be imported), and optionally a qualified name

418418 -- for the module

419419 scope :: M.Map ModuleName (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)

420− scope = M.insert currentModule (Nothing, Unqualified, Nothing) (findImports decls)

420+ scope = M.insert currentModule (Nothing, Implicit, Nothing) (findImports decls)

421421

422422 resolveImport' :: ImportEnvironment -> (ModuleName, (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)) -> m ImportEnvironment

423423 resolveImport' imp (mn, (pos, typ, impQual)) = do

@@ -437,8 +437,8 @@ resolveImport currentModule importModule exps imps impQual =

437437 where

438438

439439 resolveByType :: ImportDeclarationType -> m ImportEnvironment

440− resolveByType Unqualified = importAll importExplicit

441− resolveByType (Qualifying explImports) = (checkedRefs >=> foldM importExplicit imps) explImports

440+ resolveByType Implicit = importAll importExplicit

441+ resolveByType (Explicit explImports) = (checkedRefs >=> foldM importExplicit imps) explImports

442442 resolveByType (Hiding hiddenImports) = do

443443 hiddenImports' <- checkedRefs hiddenImports

444444 importAll (importNonHidden hiddenImports')