aec0ece · rowtype-yoga/purescript-native

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

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

Add package information to re-exports

commitaec0ece116a056b4f41e003028f247a30bbd4414 authorHarry Garrood <harry@garrood.me> dateWed 28 Dec 2016, 00:28 (10 years ago) parent1c5a431 df8b1ae

6 files changed+66−16

compare with golang

unifiedsplit

purescript.cabal+1 src/Language/PureScript/Docs/AsMarkdown.hs+3−2 src/Language/PureScript/Docs/Convert.hs+17−5 src/Language/PureScript/Docs/Convert/ReExports.hs+4−3 src/Language/PureScript/Docs/Types.hs+15−3 tests/TestDocs.hs+26−3

purescript.cabal+1

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

511511 aeson -any,

512512 aeson-better-errors -any,

513513 base-compat -any,

514+ bower-json -any,

514515 boxes -any,

515516 bytestring -any,

516517 containers -any,

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

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

3333 [P.Module] ->

3434 m Text

3535renderModulesAsMarkdown =

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

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

3737

3838modulesAsMarkdown :: [Module] -> Docs

3939modulesAsMarkdown = mapM_ moduleAsMarkdown

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

4545 for_ modComments tell'

4646 mapM_ (declAsMarkdown modName) modDeclarations

4747 spacer

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

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

49+ let mn = ignorePackage mn'

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

5051 spacer

5152 mapM_ (declAsMarkdown mn) decls

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

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

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

1616import Control.Monad.State (runStateT)

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

18+import Data.List (find)

1819import qualified Data.Map as Map

1920import Data.Text (Text)

2021

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

4243 map P.getModuleName (takeLocals modules)

4344 go =

4445 map ignorePackage

45− >>> convertModules

46+ >>> convertModules withPackage

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

4748

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+

4858-- |

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

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

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

6171--

6272convertModules ::

6373 (MonadError P.MultipleErrors m) =>

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

6475 [P.Module] ->

6576 m [Module]

66−convertModules =

77+convertModules withPackage =

6778 P.sortModules

6879 >>> fmap (fst >>> map importPrim)

69− >=> convertSorted

80+ >=> convertSorted withPackage

7081

7182importPrim :: P.Module -> P.Module

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

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

7687--

7788convertSorted ::

7889 (MonadError P.MultipleErrors m) =>

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

7991 [P.Module] ->

8092 m [Module]

81−convertSorted modules = do

93+convertSorted withPackage modules = do

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

8395

8496 modulesWithTypes <- typeCheckIfNecessary modules convertedModules

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

8698

8799 let traversalOrder = map P.getModuleName modules

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

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

89101

90102-- |

91103-- 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

55import Prelude.Compat

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

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

88import Control.Monad

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

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

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

3535updateReExports ::

3636 P.Env ->

3737 [P.ModuleName] ->

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

3839 Map P.ModuleName Module ->

3940 Map P.ModuleName Module

40−updateReExports env order = execState action

41+updateReExports env order withPackage = execState action

4142 where

4243 action =

4344 void (traverse go order)

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

4546 go mn = do

4647 mdl <- lookup' mn

4748 reExports <- getReExports env mn

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

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

4950 modify (Map.insert mn mdl')

5051

5152 lookup' mn = do

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

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

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

1010import Control.Monad (when)

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

1112

1213import Data.Aeson ((.=))

1314import Data.Aeson.BetterErrors

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

7576 , modComments :: Maybe Text

7677 , modDeclarations :: [Declaration]

7778 -- Re-exported values from other modules

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

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

7980 }

8081 deriving (Show, Eq, Ord)

8182

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

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

383384 <*> key "info" asDeclarationInfo

384385

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

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

386387asReExport =

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

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

388389 <*> 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)

389401

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

391403asInPackage inner =

tests/TestDocs.hs+26−3

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

88import Prelude ()

99import Prelude.Compat

1010

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

11+import Control.Arrow (first)

1212

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

1314import Data.Monoid

1415import Data.Maybe (fromMaybe)

1516import Data.List ((\\))

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

2425import qualified Language.PureScript.Publish as Publish

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

2627

28+import Web.Bower.PackageMeta (parsePackageName)

29+

2730import TestUtils

2831

2932publishOpts :: Publish.PublishOptions

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

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

7477 -- containing a particular string

7578 | 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)

7682 deriving (Show)

7783

7884newtype ShowFn a = ShowFn a

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

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

106112 | TypeSynonymMismatch P.ModuleName Text Text Text

107113 -- | 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

109115 | 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]

110119 deriving (Show)

111120

112121data AssertionResult

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

194203 then Pass

195204 else Fail (DocCommentMissing mn decl declComments)

196205

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+

197214 where

198215 declarationsFor mn =

199216 if mn == modName

200217 then modDeclarations

201− else fromMaybe [] (lookup mn modReExports)

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

202219

203220 findChildren title =

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

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

247264 -- From local files

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

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

267+

268+ -- Re-exports

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

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

250271 ])

272+

251273 , ("Example2",

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

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

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

336358

337359 where

338360 n = P.moduleNameFromString . T.pack

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

339362

340363 hasTypeVar varName =

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