df8b1ae · rowtype-yoga/purescript-native

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

Add package information to re-exports

This gets us most of the way towards fixing the following issue: https://github.com/purescript/pursuit/issues/209 This change preserves backwards-compatibility in the parser by pretending that all re-exports come from local modules (i.e. in the same package) in JSON produced by older compilers. This is obviously not ideal but it's most likely going to be temporary and it's better than any alternatives I can think of.

commitdf8b1aed4977b79498101d2f8901e92c5a693192 authorHarry Garrood <harry@garrood.me> dateMon 26 Dec 2016, 21:40 (10 years ago) parent1c5a431

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)