bb8aaa8 · rowtype-yoga/purescript-native

psci/Completion.hs+1−1

compare with golang

unifiedsplit

@@ -171,7 +171,7 @@ getAllQualifications sho m (declName, decl) = do

171 qualificationsUsing (_, importType, asQ') =

172 let q = qualifyWith asQ'

173 in case importType of

174− P.Implicit -> [q]

174+ P.Implicit _ -> [q]

175 P.Explicit refs -> [q | referencedBy refs]

176 P.Hiding refs -> [q | not $ referencedBy refs]

177

psci/PSCi.hs+4−3

@@ -315,10 +315,11 @@ handleShowImportedModules = do

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

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

317

318− showDeclType P.Implicit = ""

318+ showDeclType (P.Implicit True) = " (..)"

319+ showDeclType (P.Implicit False) = ""

319 showDeclType (P.Explicit refs) = refsList refs

320 showDeclType (P.Explicit refs) = refsList refs

320− showDeclType (P.Hiding refs) = "hiding " ++ refsList refs

321+ showDeclType (P.Hiding refs) = " hiding " ++ refsList refs

321− refsList refs = "(" ++ commaList (map showRef refs) ++ ")"

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

322

323

323 showRef :: P.DeclarationRef -> String

324 showRef :: P.DeclarationRef -> String

324 showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"

325 showRef (P.TypeRef pn dctors) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"

psci/tests/Main.hs+2−2

@@ -141,11 +141,11 @@ getPSCiState = do

141 Left err ->

142 print err >> exitFailure

143 Right modules ->

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

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

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

146

147controlMonadSTasST :: ImportedModule

148−controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))

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

149 where

150 s = P.moduleNameFromString

151

src/Language/PureScript/AST/Declarations.hs+20−2

@@ -41,6 +41,18 @@ data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [Decla

41getModuleName :: Module -> ModuleName

42getModuleName (Module _ _ name _ _) = name

43

44+-- |

45+-- Add an import declaration for a module if it does not already explicitly import it.

46+--

47+addDefaultImport :: ModuleName -> Module -> Module

48+addDefaultImport toImport m@(Module ss coms mn decls exps) =

49+ if isExistingImport `any` decls || mn == toImport then m

50+ else Module ss coms mn (ImportDeclaration toImport (Implicit True) Nothing False : decls) exps

51+ where

52+ isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

53+ isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

54+ isExistingImport _ = False

55+

44-- |

56-- |

45-- An item in a list of explicit imports or exports

57-- An item in a list of explicit imports or exports

46--

58--

@@ -118,9 +130,11 @@ findDuplicateRefs refs =

118--

130--

119data ImportDeclarationType

131data ImportDeclarationType

120 -- |

132 -- |

121− -- An import with no explicit list: `import M`

133+ -- An import with no explicit list: `import M`. The boolean signifies whether

134+ -- the import was imported with `(..)` or not. Without `(..)` a warning is

135+ -- raised for each member implicitly imported.

122 --

136 --

123− = Implicit

137+ = Implicit Bool

124 -- |

138 -- |

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

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

126 --

140 --

@@ -131,6 +145,10 @@ data ImportDeclarationType

131 | Hiding [DeclarationRef]

145 | Hiding [DeclarationRef]

132 deriving (Eq, Show, Read, D.Data, D.Typeable)

146 deriving (Eq, Show, Read, D.Data, D.Typeable)

133

147

148+isImplicit :: ImportDeclarationType -> Bool

149+isImplicit (Implicit _) = True

150+isImplicit _ = False

151+

134-- |

152-- |

135-- The data type of declarations

153-- The data type of declarations

136--

154--

src/Language/PureScript/Docs/ParseAndDesugar.hs+1−10

@@ -105,17 +105,8 @@ fileInfoToString :: FileInfo -> FilePath

105fileInfoToString (Local fn) = fn

106fileInfoToString (FromDep _ fn) = fn

107

108−addDefaultImport :: P.ModuleName -> P.Module -> P.Module

109−addDefaultImport toImport m@(P.Module ss coms mn decls exps) =

110− if isExistingImport `any` decls || mn == toImport then m

111− else P.Module ss coms mn (P.ImportDeclaration toImport P.Implicit Nothing False : decls) exps

112− where

113− isExistingImport (P.ImportDeclaration mn' _ _ _) | mn' == toImport = True

114− isExistingImport (P.PositionedDeclaration _ _ d) = isExistingImport d

115− isExistingImport _ = False

116−

117importPrim :: P.Module -> P.Module

108importPrim :: P.Module -> P.Module

118−importPrim = addDefaultImport (P.ModuleName [P.ProperName C.prim])

109+importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

119

110

120desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]

111desugar :: [P.Module] -> Either P.MultipleErrors [P.Module]

121desugar = P.evalSupplyT 0 . desugar'

112desugar = P.evalSupplyT 0 . desugar'

src/Language/PureScript/Errors.hs+11−2

@@ -138,6 +138,7 @@ data SimpleErrorMessage

138 | DuplicateExportRef String

139 | IntOutOfRange Integer String Integer Integer

140 | RedundantEmptyHidingImport ModuleName

141+ | ImplicitImport ModuleName [DeclarationRef]

141 deriving (Show)

142 deriving (Show)

142

143

143-- | Error message hints, providing more detailed information about failure.

144-- | Error message hints, providing more detailed information about failure.

@@ -282,6 +283,7 @@ errorCode em = case unwrapErrorMessage em of

282 DuplicateExportRef{} -> "DuplicateExportRef"

283 DuplicateExportRef{} -> "DuplicateExportRef"

283 IntOutOfRange{} -> "IntOutOfRange"

284 IntOutOfRange{} -> "IntOutOfRange"

284 RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"

285 RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"

286+ ImplicitImport{} -> "ImplicitImport"

285

287

286

288

287-- |

289-- |

@@ -819,6 +821,11 @@ prettyPrintSingleError full level e = do

819 renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =

821 renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =

820 line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."

822 line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."

821

823

824+ renderSimpleErrorMessage (ImplicitImport mn refs) =

825+ paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "

826+ , indent $ line $ "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

827+ ]

828+

822 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

829 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

823 renderHint (ErrorUnifyingTypes t1 t2) detail =

830 renderHint (ErrorUnifyingTypes t1 t2) detail =

824 paras [ detail

831 paras [ detail

@@ -954,9 +961,10 @@ prettyPrintSingleError full level e = do

954

961

955 prettyPrintRef :: DeclarationRef -> String

962 prettyPrintRef :: DeclarationRef -> String

956 prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"

963 prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"

964+ prettyPrintRef (TypeRef pn (Just [])) = runProperName pn

957 prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"

965 prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"

958 prettyPrintRef (ValueRef ident) = showIdent ident

966 prettyPrintRef (ValueRef ident) = showIdent ident

959− prettyPrintRef (TypeClassRef pn) = runProperName pn

967+ prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn

960 prettyPrintRef (ProperRef pn) = runProperName pn

968 prettyPrintRef (ProperRef pn) = runProperName pn

961 prettyPrintRef (TypeInstanceRef ident) = showIdent ident

969 prettyPrintRef (TypeInstanceRef ident) = showIdent ident

962 prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name

970 prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name

@@ -965,7 +973,8 @@ prettyPrintSingleError full level e = do

965 prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String

973 prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String

966 prettyPrintImport mn idt qual =

974 prettyPrintImport mn idt qual =

967 let i = case idt of

975 let i = case idt of

976+ Implicit True -> runModuleName mn ++ " (..)"

968− Implicit -> runModuleName mn

977+ Implicit False -> runModuleName mn

969 Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

978 Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"

970 Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"

979 Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"

971 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual

980 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual

src/Language/PureScript/Linter/Imports.hs+41−3

@@ -16,6 +16,7 @@ import Data.Foldable (forM_)

16

17import Language.PureScript.AST.Declarations

18import Language.PureScript.AST.SourcePos

19+import Language.PureScript.Crash

19import Language.PureScript.Names as P

20import Language.PureScript.Names as P

20

21

21import Language.PureScript.Errors

22import Language.PureScript.Errors

@@ -30,6 +31,19 @@ data Name

30 | TypeName (Qualified ProperName)

31 | TypeName (Qualified ProperName)

31 | DctorName (Qualified ProperName)

32 | DctorName (Qualified ProperName)

32 | ClassName (Qualified ProperName)

33 | ClassName (Qualified ProperName)

34+ deriving (Eq)

35+

36+getIdentName :: Name -> Maybe Ident

37+getIdentName (IdentName (Qualified _ name)) = Just name

38+getIdentName _ = Nothing

39+

40+getTypeName :: Name -> Maybe ProperName

41+getTypeName (TypeName (Qualified _ name)) = Just name

42+getTypeName _ = Nothing

43+

44+getClassName :: Name -> Maybe ProperName

45+getClassName (ClassName (Qualified _ name)) = Just name

46+getClassName _ = Nothing

33

47

34-- | Map of module name to list of imported names from that module which have been used.

48-- | Map of module name to list of imported names from that module which have been used.

35type UsedImports = M.Map ModuleName [Name]

49type UsedImports = M.Map ModuleName [Name]

@@ -44,11 +58,21 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

44 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $

58 forM_ (M.toAscList imps) $ \(mni, decls) -> unless (mni `elem` alwaysUsedModules) $

45 forM_ decls $ \(ss, declType, qualifierName) ->

59 forM_ decls $ \(ss, declType, qualifierName) ->

46 censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $

60 censor (onErrorMessages $ addModuleLocError ss) $ unless (qnameUsed qualifierName) $

47− let names = sugarNames mni ++ M.findWithDefault [] mni usedImps

61+ let names = nub $ sugarNames mni ++ M.findWithDefault [] mni usedImps

48 usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names

62 usedNames = mapMaybe (matchName (typeForDCtor mni) qualifierName) names

49 usedDctors = mapMaybe (matchDctor qualifierName) names

63 usedDctors = mapMaybe (matchDctor qualifierName) names

50 in case declType of

64 in case declType of

51− Implicit -> when (null usedNames) $ tell $ errorMessage $ UnusedImport mni

65+ Implicit _ | null usedNames -> tell $ errorMessage $ UnusedImport mni

66+ Implicit False ->

67+ let classRefs = TypeClassRef <$> mapMaybe getClassName names

68+ valueRefs = ValueRef <$> mapMaybe getIdentName names

69+ types = mapMaybe getTypeName names

70+ typesWithDctors = reconstructTypeRefs mni usedDctors

71+ typesWithoutDctors = filter (`M.notMember` typesWithDctors) types

72+ typesRefs

73+ = map (flip TypeRef (Just [])) typesWithoutDctors

74+ ++ map (\(ty, ds) -> TypeRef ty (Just ds)) (M.toList typesWithDctors)

75+ in tell $ errorMessage $ ImplicitImport mni (classRefs ++ typesRefs ++ valueRefs)

52 Explicit declrefs -> do

76 Explicit declrefs -> do

53 let idents = nub (mapMaybe runDeclRef declrefs)

77 let idents = nub (mapMaybe runDeclRef declrefs)

54 let diff = idents \\ usedNames

78 let diff = idents \\ usedNames

@@ -76,6 +100,20 @@ findUnusedImports (Module _ _ _ mdecls mexports) env usedImps = do

76 sugarNames (ModuleName [ProperName n]) | n == C.prelude = [ IdentName $ Qualified Nothing (Ident C.bind) ]

100 sugarNames (ModuleName [ProperName n]) | n == C.prelude = [ IdentName $ Qualified Nothing (Ident C.bind) ]

77 sugarNames _ = []

101 sugarNames _ = []

78

102

103+ reconstructTypeRefs :: ModuleName -> [ProperName] -> M.Map ProperName [ProperName]

104+ reconstructTypeRefs mni = foldr accumDctors M.empty

105+ where

106+ accumDctors dctor = M.alter (Just . maybe [dctor] (dctor :)) (findTypeForDctor mni dctor)

107+

108+ findTypeForDctor :: ModuleName -> ProperName -> ProperName

109+ findTypeForDctor mn dctor =

110+ case mn `M.lookup` env of

111+ Just (_, _, exps) ->

112+ case find (elem dctor . snd . fst) (exportedTypes exps) of

113+ Just ((ty, _), _) -> ty

114+ Nothing -> internalError $ "missing type for data constructor " ++ runProperName dctor ++ " in findTypeForDctor"

115+ Nothing -> internalError $ "missing module " ++ runModuleName mn ++ " in findTypeForDctor"

116+

79 -- rely on exports being elaborated by this point

117 -- rely on exports being elaborated by this point

80 alwaysUsedModules :: [ ModuleName ]

118 alwaysUsedModules :: [ ModuleName ]

81 alwaysUsedModules = ModuleName [ProperName C.prim] : maybe [] (mapMaybe extractModule) mexports

119 alwaysUsedModules = ModuleName [ProperName C.prim] : maybe [] (mapMaybe extractModule) mexports

@@ -121,7 +159,7 @@ runDeclRef :: DeclarationRef -> Maybe String

121runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

159runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

122runDeclRef (ValueRef ident) = Just $ showIdent ident

160runDeclRef (ValueRef ident) = Just $ showIdent ident

123runDeclRef (TypeRef pn _) = Just $ runProperName pn

161runDeclRef (TypeRef pn _) = Just $ runProperName pn

124−runDeclRef (TypeClassRef pn) = Just $ runProperName pn

162+runDeclRef (TypeClassRef pn) = Just $ "class " ++ runProperName pn

125runDeclRef _ = Nothing

163runDeclRef _ = Nothing

126

164

127getTypeRef :: DeclarationRef -> Maybe (ProperName, Maybe [ProperName])

165getTypeRef :: DeclarationRef -> Maybe (ProperName, Maybe [ProperName])

src/Language/PureScript/Make.hs−12

@@ -266,18 +266,6 @@ make MakeActions{..} ms = do

266 guard $ efVersion externs == showVersion Paths.version

267 return externs

268

269−-- |

270−-- Add an import declaration for a module if it does not already explicitly import it.

271−--

272−addDefaultImport :: ModuleName -> Module -> Module

273−addDefaultImport toImport m@(Module ss coms mn decls exps) =

274− if isExistingImport `any` decls || mn == toImport then m

275− else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps

276− where

277− isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True

278− isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d

279− isExistingImport _ = False

280−

281importPrim :: Module -> Module

269importPrim :: Module -> Module

282importPrim = addDefaultImport (ModuleName [ProperName C.prim])

270importPrim = addDefaultImport (ModuleName [ProperName C.prim])

283

271

src/Language/PureScript/Parser/Declarations.hs+4−2

@@ -152,8 +152,10 @@ parseImportDeclaration' = do

152 qName <- qualifiedName

153 return (moduleName', declType, Just qName, True)

154 qualifyingList expectedType = do

155+ declType <- P.optionMaybe

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

156+ $ P.try (expectedType <$> (indented *> parens (commaSep parseDeclarationRef)))

157+ <|> (const (Implicit True) <$> (indented *> parens (symbol' "..")))

156− return $ fromMaybe Implicit (expectedType <$> idents)

158+ return $ fromMaybe (Implicit False) declType

157

159

158

160

159parseDeclarationRef :: TokenParser DeclarationRef

161parseDeclarationRef :: TokenParser DeclarationRef

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

@@ -79,7 +79,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

79 warned' <- (warned ++) <$>

80 if (length unqual < 2)

81 then return []

82− else case find (\(_, typ, _) -> typ == Implicit) unqual of

82+ else case find (\(_, typ, _) -> isImplicit typ) unqual of

83 Just i ->

84 for (delete i unqual) $ \i'@(pos, typ, _) -> do

85 warn pos $ RedundantUnqualifiedImport mn typ

@@ -98,7 +98,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

98

99 return ()

100

101− let scope = M.insert currentModule [(Nothing, Implicit, Nothing)] imports

101+ let scope = M.insert currentModule [(Nothing, Implicit True, Nothing)] imports

102 resolved <- foldM (resolveModuleImport currentModule env) nullImports (M.toList scope)

103 return (Module ss coms currentModule decls' exps, resolved)

104

@@ -138,7 +138,7 @@ resolveImports env (Module ss coms currentModule decls exps) =

138 updateImportRef (ImportDeclaration mn typ qual isOldSyntax) = do

139 modExports <- getExports env mn

140 typ' <- case typ of

141− Implicit -> return Implicit

141+ Implicit b -> return $ Implicit b

142 Explicit refs -> Explicit <$> updateProperRef mn modExports `traverse` refs

143 Hiding refs -> Hiding <$> updateProperRef mn modExports `traverse` refs

144 return $ ImportDeclaration mn typ' qual isOldSyntax

@@ -193,7 +193,7 @@ resolveImport currentModule importModule exps imps impQual = resolveByType

193 where

194

195 resolveByType :: ImportDeclarationType -> m Imports

196− resolveByType Implicit = importAll importExplicit

196+ resolveByType (Implicit _) = importAll importExplicit

197 resolveByType (Explicit refs) = checkRefs False refs >> foldM importExplicit imps refs

198 resolveByType (Hiding refs) = do

199 imps' <- checkRefs True refs >> importAll (importNonHidden refs)