aec0ece · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #2503 from purescript/add-package-info-to-reexports

aec0eceHarry Garrood10 years ago

purescript.cabal+1

compare with golang

unifiedsplit

@@ -511,6 +511,7 @@ test-suite tests

511 aeson -any,

512 aeson-better-errors -any,

513 base-compat -any,

514+ bower-json -any,

514 boxes -any,

515 boxes -any,

515 bytestring -any,

516 bytestring -any,

516 containers -any,

517 containers -any,

src/Language/PureScript/Docs/AsMarkdown.hs+3−2

@@ -33,7 +33,7 @@ renderModulesAsMarkdown ::

33 [P.Module] ->

34 m Text

35renderModulesAsMarkdown =

36− fmap (runDocs . modulesAsMarkdown) . Convert.convertModules

36+ fmap (runDocs . modulesAsMarkdown) . Convert.convertModules Local

38modulesAsMarkdown :: [Module] -> Docs

39modulesAsMarkdown = mapM_ moduleAsMarkdown

@@ -45,7 +45,8 @@ moduleAsMarkdown Module{..} = do

45 for_ modComments tell'

46 mapM_ (declAsMarkdown modName) modDeclarations

47 spacer

48− for_ modReExports $ \(mn, decls) -> do

48+ for_ modReExports $ \(mn', decls) -> do

49+ let mn = ignorePackage mn'

49 headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"

50 headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"

50 spacer

51 spacer

51 mapM_ (declAsMarkdown mn) decls

52 mapM_ (declAsMarkdown mn) decls

src/Language/PureScript/Docs/Convert.hs+17−5

@@ -15,6 +15,7 @@ import Control.Monad

15import Control.Monad.Error.Class (MonadError)

16import Control.Monad.State (runStateT)

17import Control.Monad.Writer.Strict (runWriterT)

18+import Data.List (find)

18import qualified Data.Map as Map

19import qualified Data.Map as Map

19import Data.Text (Text)

20import Data.Text (Text)

@@ -42,9 +43,18 @@ convertModulesInPackage modules =

42 map P.getModuleName (takeLocals modules)

43 map P.getModuleName (takeLocals modules)

43 go =

44 go =

44 map ignorePackage

45 map ignorePackage

45− >>> convertModules

46+ >>> convertModules withPackage

46 >>> fmap (filter ((`elem` localNames) . modName))

47 >>> fmap (filter ((`elem` localNames) . modName))

49+ withPackage :: P.ModuleName -> InPackage P.ModuleName

50+ withPackage mn =

51+ case find ((== mn) . P.getModuleName . ignorePackage) modules of

52+ Just m ->

53+ fmap P.getModuleName m

54+ Nothing ->

55+ P.internalError $ "withPackage: missing module:" ++

56+ show (P.runModuleName mn)

57+

48-- |

58-- |

49-- Convert a group of modules to the intermediate format, designed for

59-- Convert a group of modules to the intermediate format, designed for

50-- producing documentation from. It is also necessary to pass an Env containing

60-- producing documentation from. It is also necessary to pass an Env containing

@@ -61,12 +71,13 @@ convertModulesInPackage modules =

61--

71--

62convertModules ::

72convertModules ::

63 (MonadError P.MultipleErrors m) =>

73 (MonadError P.MultipleErrors m) =>

74+ (P.ModuleName -> InPackage P.ModuleName) ->

64 [P.Module] ->

75 [P.Module] ->

65 m [Module]

76 m [Module]

66−convertModules =

77+convertModules withPackage =

67 P.sortModules

78 P.sortModules

68 >>> fmap (fst >>> map importPrim)

79 >>> fmap (fst >>> map importPrim)

69− >=> convertSorted

80+ >=> convertSorted withPackage

71importPrim :: P.Module -> P.Module

82importPrim :: P.Module -> P.Module

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

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

@@ -76,16 +87,17 @@ importPrim = P.addDefaultImport (P.ModuleName [P.ProperName C.prim])

76--

87--

77convertSorted ::

88convertSorted ::

78 (MonadError P.MultipleErrors m) =>

89 (MonadError P.MultipleErrors m) =>

90+ (P.ModuleName -> InPackage P.ModuleName) ->

79 [P.Module] ->

91 [P.Module] ->

80 m [Module]

92 m [Module]

81−convertSorted modules = do

93+convertSorted withPackage modules = do

82 (env, convertedModules) <- second (map convertSingleModule) <$> partiallyDesugar modules

94 (env, convertedModules) <- second (map convertSingleModule) <$> partiallyDesugar modules

84 modulesWithTypes <- typeCheckIfNecessary modules convertedModules

96 modulesWithTypes <- typeCheckIfNecessary modules convertedModules

85 let moduleMap = Map.fromList (map (modName &&& id) modulesWithTypes)

97 let moduleMap = Map.fromList (map (modName &&& id) modulesWithTypes)

87 let traversalOrder = map P.getModuleName modules

99 let traversalOrder = map P.getModuleName modules

88− pure (Map.elems (updateReExports env traversalOrder moduleMap))

100+ pure (Map.elems (updateReExports env traversalOrder withPackage moduleMap))

101

90-- |

102-- |

91-- If any exported value declarations have either wildcard type signatures, or

103-- If any exported value declarations have either wildcard type signatures, or

src/Language/PureScript/Docs/Convert/ReExports.hs+4−3

@@ -4,7 +4,7 @@ module Language.PureScript.Docs.Convert.ReExports

5import Prelude.Compat

7−import Control.Arrow ((&&&), second)

7+import Control.Arrow ((&&&), first, second)

8import Control.Monad

9import Control.Monad.Reader.Class (MonadReader, ask)

10import Control.Monad.State.Class (MonadState, gets, modify)

@@ -35,9 +35,10 @@ import qualified Language.PureScript as P

35updateReExports ::

36 P.Env ->

37 [P.ModuleName] ->

38+ (P.ModuleName -> InPackage P.ModuleName) ->

38 Map P.ModuleName Module ->

39 Map P.ModuleName Module ->

39 Map P.ModuleName Module

40 Map P.ModuleName Module

40−updateReExports env order = execState action

41+updateReExports env order withPackage = execState action

41 where

42 where

42 action =

43 action =

43 void (traverse go order)

44 void (traverse go order)

@@ -45,7 +46,7 @@ updateReExports env order = execState action

45 go mn = do

46 go mn = do

46 mdl <- lookup' mn

47 mdl <- lookup' mn

47 reExports <- getReExports env mn

48 reExports <- getReExports env mn

48− let mdl' = mdl { modReExports = reExports }

49+ let mdl' = mdl { modReExports = map (first withPackage) reExports }

49 modify (Map.insert mn mdl')

50 modify (Map.insert mn mdl')

51 lookup' mn = do

52 lookup' mn = do

src/Language/PureScript/Docs/Types.hs+15−3

@@ -8,6 +8,7 @@ import Prelude.Compat

9import Control.Arrow (first, (***))

10import Control.Monad (when)

11+import Control.Monad.Error.Class (catchError)

12import Data.Aeson ((.=))

13import Data.Aeson ((.=))

13import Data.Aeson.BetterErrors

14import Data.Aeson.BetterErrors

@@ -75,7 +76,7 @@ data Module = Module

75 , modComments :: Maybe Text

76 , modComments :: Maybe Text

76 , modDeclarations :: [Declaration]

77 , modDeclarations :: [Declaration]

77 -- Re-exported values from other modules

78 -- Re-exported values from other modules

78− , modReExports :: [(P.ModuleName, [Declaration])]

79+ , modReExports :: [(InPackage P.ModuleName, [Declaration])]

79 }

80 }

80 deriving (Show, Eq, Ord)

81 deriving (Show, Eq, Ord)

@@ -382,10 +383,21 @@ asDeclaration =

382 <*> key "children" (eachInArray asChildDeclaration)

383 <*> key "children" (eachInArray asChildDeclaration)

383 <*> key "info" asDeclarationInfo

384 <*> key "info" asDeclarationInfo

384

385

385−asReExport :: Parse PackageError (P.ModuleName, [Declaration])

386+asReExport :: Parse PackageError (InPackage P.ModuleName, [Declaration])

386asReExport =

387asReExport =

387− (,) <$> key "moduleName" fromAesonParser

388+ (,) <$> key "moduleName" asReExportModuleName

388 <*> key "declarations" (eachInArray asDeclaration)

389 <*> key "declarations" (eachInArray asDeclaration)

390+ where

391+ -- This is to preserve backwards compatibility with 0.10.3 and earlier versions

392+ -- of the compiler, where the modReExports field had the type

393+ -- [(P.ModuleName, [Declaration])]. This should eventually be removed,

394+ -- possibly at the same time as the next breaking change to this JSON format.

395+ asReExportModuleName :: Parse PackageError (InPackage P.ModuleName)

396+ asReExportModuleName =

397+ asInPackage fromAesonParser .! ErrorInPackageMeta

398+ <|> fmap Local fromAesonParser

399+

400+ (<|>) p q = catchError p (const q)

389

401

390asInPackage :: Parse BowerError a -> Parse BowerError (InPackage a)

402asInPackage :: Parse BowerError a -> Parse BowerError (InPackage a)

391asInPackage inner =

403asInPackage inner =

tests/TestDocs.hs+26−3

@@ -8,8 +8,9 @@ module TestDocs where

8import Prelude ()

9import Prelude.Compat

11−import Data.Version (Version(..))

11+import Control.Arrow (first)

13+import Data.Version (Version(..))

13import Data.Monoid

14import Data.Monoid

14import Data.Maybe (fromMaybe)

15import Data.Maybe (fromMaybe)

15import Data.List ((\\))

16import Data.List ((\\))

@@ -24,6 +25,8 @@ import Language.PureScript.Docs.AsMarkdown (codeToString)

24import qualified Language.PureScript.Publish as Publish

25import qualified Language.PureScript.Publish as Publish

25import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

26import qualified Language.PureScript.Publish.ErrorsWarnings as Publish

28+import Web.Bower.PackageMeta (parsePackageName)

29+

27import TestUtils

30import TestUtils

29publishOpts :: Publish.PublishOptions

32publishOpts :: Publish.PublishOptions

@@ -73,6 +76,9 @@ data Assertion

73 -- | Assert that a documented declaration includes a documentation comment

76 -- | Assert that a documented declaration includes a documentation comment

74 -- containing a particular string

77 -- containing a particular string

75 | ShouldHaveDocComment P.ModuleName Text Text

78 | ShouldHaveDocComment P.ModuleName Text Text

79+ -- | Assert that there should be some declarations re-exported from a

80+ -- particular module in a particular package.

81+ | ShouldHaveReExport (Docs.InPackage P.ModuleName)

76 deriving (Show)

82 deriving (Show)

78newtype ShowFn a = ShowFn a

84newtype ShowFn a = ShowFn a

@@ -105,8 +111,11 @@ data AssertionFailure

105 -- Fields: module name, declaration name, expected rendering, actual rendering

111 -- Fields: module name, declaration name, expected rendering, actual rendering

106 | TypeSynonymMismatch P.ModuleName Text Text Text

112 | TypeSynonymMismatch P.ModuleName Text Text Text

107 -- | A doc comment was not found or did not match what was expected

113 -- | A doc comment was not found or did not match what was expected

108− -- Fields: declaration title, expected substring, actual comments

114+ -- Fields: module name, expected substring, actual comments

109 | DocCommentMissing P.ModuleName Text (Maybe Text)

115 | DocCommentMissing P.ModuleName Text (Maybe Text)

116+ -- | A module was missing re-exports from a particular module.

117+ -- Fields: module name, expected re-export, actual re-exports.

118+ | ReExportMissing P.ModuleName (Docs.InPackage P.ModuleName) [Docs.InPackage P.ModuleName]

110 deriving (Show)

119 deriving (Show)

111

120

112data AssertionResult

121data AssertionResult

@@ -194,11 +203,19 @@ runAssertion assertion Docs.Module{..} =

194 then Pass

203 then Pass

195 else Fail (DocCommentMissing mn decl declComments)

204 else Fail (DocCommentMissing mn decl declComments)

196

205

206+ ShouldHaveReExport reExp ->

207+ let

208+ reExps = map fst modReExports

209+ in

210+ if reExp `elem` reExps

211+ then Pass

212+ else Fail (ReExportMissing modName reExp reExps)

213+

197 where

214 where

198 declarationsFor mn =

215 declarationsFor mn =

199 if mn == modName

216 if mn == modName

200 then modDeclarations

217 then modDeclarations

201− else fromMaybe [] (lookup mn modReExports)

218+ else fromMaybe [] (lookup mn (map (first Docs.ignorePackage) modReExports))

202

219

203 findChildren title =

220 findChildren title =

204 fmap childrenTitles . find ((==) title . Docs.declTitle)

221 fmap childrenTitles . find ((==) title . Docs.declTitle)

@@ -247,7 +264,12 @@ testCases =

247 -- From local files

264 -- From local files

248 , ShouldBeDocumented (n "Example2") "one" []

265 , ShouldBeDocumented (n "Example2") "one" []

249 , ShouldNotBeDocumented (n "Example2") "two"

266 , ShouldNotBeDocumented (n "Example2") "two"

267+

268+ -- Re-exports

269+ , ShouldHaveReExport (Docs.FromDep (pkg "purescript-prelude") (n "Prelude"))

270+ , ShouldHaveReExport (Docs.Local (n "Example2"))

250 ])

271 ])

272+

251 , ("Example2",

273 , ("Example2",

252 [ ShouldBeDocumented (n "Example2") "one" []

274 [ ShouldBeDocumented (n "Example2") "one" []

253 , ShouldBeDocumented (n "Example2") "two" []

275 , ShouldBeDocumented (n "Example2") "two" []

@@ -336,6 +358,7 @@ testCases =

336

358

337 where

359 where

338 n = P.moduleNameFromString . T.pack

360 n = P.moduleNameFromString . T.pack

361+ pkg str = let Right p = parsePackageName str in p

339

362

340 hasTypeVar varName =

363 hasTypeVar varName =

341 getAny . P.everythingOnTypes (<>) (Any . isVar varName)

364 getAny . P.everythingOnTypes (<>) (Any . isVar varName)