@@ -1,5 +1,6 @@
11{-# LANGUAGE RecordWildCards #-}
22{-# LANGUAGE ViewPatterns #-}
3+{-# LANGUAGE LambdaCase #-}
34{-# LANGUAGE DataKinds #-}
45{-# LANGUAGE OverloadedStrings #-}
56
@@ -44,11 +45,12 @@ main = pushd "examples/docs" $ do
4445 res <- Publish.preparePackage publishOpts
4546 case res of
4647 Left e -> Publish.printErrorToStdout e >> exitFailure
47− Right Docs.Package{..} ->
48+ Right pkg@Docs.Package{..} ->
4849 forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->
4950 let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))
5051 (find ((==) mn . Docs.modName) pkgModules)
51− in forM_ pragmas (`runAssertionIO` mdl)
52+ linksCtx = Docs.getLinksContext pkg
53+ in forM_ pragmas (\a -> runAssertionIO a linksCtx mdl)
5254
5355
5456takeJust :: String -> Maybe a -> a
@@ -82,6 +84,11 @@ data Assertion
8284 -- | Assert that there should be some declarations re-exported from a
8385 -- particular module in a particular package.
8486 | ShouldHaveReExport (Docs.InPackage P.ModuleName)
87+ -- | Assert that a link to some specific declaration exists within the
88+ -- rendered code for a declaration. Fields are: local module, local
89+ -- declaration title, title of linked declaration, namespace of linked
90+ -- declaration, destination of link.
91+ | ShouldHaveLink P.ModuleName Text Text Docs.Namespace Docs.LinkLocation
8592 deriving (Show)
8693
8794newtype ShowFn a = ShowFn a
@@ -119,6 +126,17 @@ data AssertionFailure
119126 -- | A module was missing re-exports from a particular module.
120127 -- Fields: module name, expected re-export, actual re-exports.
121128 | ReExportMissing P.ModuleName (Docs.InPackage P.ModuleName) [Docs.InPackage P.ModuleName]
129+ -- | Expected to find some other declaration mentioned in this declaration's
130+ -- rendered code, but did not find anything.
131+ -- Fields: module name, declaration title, title of declaration which was
132+ -- expected but not found in.
133+ | LinkedDeclarationMissing P.ModuleName Text Text
134+ -- | Expected one link location for a declaration mentioned in some other
135+ -- declaration's rendered code, but found a different one. Fields: module
136+ -- name, title of the local declaration which links to some other
137+ -- declaration, title of the linked declaration, expected location, actual
138+ -- location.
139+ | BadLinkLocation P.ModuleName Text Text Docs.LinkLocation Docs.LinkLocation
122140 deriving (Show)
123141
124142data AssertionResult
@@ -126,8 +144,8 @@ data AssertionResult
126144 | Fail AssertionFailure
127145 deriving (Show)
128146
129−runAssertion :: Assertion -> Docs.Module -> AssertionResult
130−runAssertion assertion Docs.Module{..} =
147+runAssertion :: Assertion -> Docs.LinksContext -> Docs.Module -> AssertionResult
148+runAssertion assertion linksCtx Docs.Module{..} =
131149 case assertion of
132150 ShouldBeDocumented mn decl children ->
133151 case findChildren decl (declarationsFor mn) of
@@ -214,6 +232,19 @@ runAssertion assertion Docs.Module{..} =
214232 then Pass
215233 else Fail (ReExportMissing modName reExp reExps)
216234
235+ ShouldHaveLink mn decl destTitle destNs expectedLoc ->
236+ findDecl mn decl $ \decl' ->
237+ let
238+ rendered = Docs.renderDeclaration decl'
239+ in
240+ case extract rendered destNs destTitle of
241+ Just (Docs.linkLocation -> actualLoc) ->
242+ if expectedLoc == actualLoc
243+ then Pass
244+ else Fail (BadLinkLocation mn decl destTitle expectedLoc actualLoc)
245+ Nothing ->
246+ Fail (LinkedDeclarationMissing mn decl destTitle)
247+
217248 where
218249 declarationsFor mn =
219250 if mn == modName
@@ -232,6 +263,17 @@ runAssertion assertion Docs.Module{..} =
232263
233264 childrenTitles = map Docs.cdeclTitle . Docs.declChildren
234265
266+ extract :: Docs.RenderedCode -> Docs.Namespace -> Text -> Maybe Docs.DocLink
267+ extract rc ns title = getFirst (Docs.outputWith (First . go) rc) >>= getLink
268+ where
269+ getLink =
270+ Docs.getLink linksCtx (P.moduleNameFromString "$DocsTest") ns title
271+ go = \case
272+ Docs.Symbol ns' title' (Docs.Link containingMod)
273+ | ns' == ns && title' == title -> Just containingMod
274+ _ ->
275+ Nothing
276+
235277checkConstrained :: P.Type -> Text -> Bool
236278checkConstrained ty tyClass =
237279 -- Note that we don't recurse on ConstrainedType if none of the constraints
@@ -248,10 +290,10 @@ checkConstrained ty tyClass =
248290 matches className =
249291 (==) className . P.runProperName . P.disqualify . P.constraintClass
250292
251−runAssertionIO :: Assertion -> Docs.Module -> IO ()
252−runAssertionIO assertion mdl = do
293+runAssertionIO :: Assertion -> Docs.LinksContext -> Docs.Module -> IO ()
294+runAssertionIO assertion linksCtx mdl = do
253295 putStrLn ("In " ++ T.unpack (P.runModuleName (Docs.modName mdl)) ++ ": " ++ show assertion)
254− case runAssertion assertion mdl of
296+ case runAssertion assertion linksCtx mdl of
255297 Pass -> pure ()
256298 Fail reason -> do
257299 putStrLn ("Failed: " <> show reason)
@@ -276,6 +318,8 @@ testCases =
276318 , ("Example2",
277319 [ ShouldBeDocumented (n "Example2") "one" []
278320 , ShouldBeDocumented (n "Example2") "two" []
321+
322+ , ShouldHaveLink (n "Example2") "one" "Int" Docs.TypeLevel (Docs.BuiltinModule (n "Prim"))
279323 ])
280324
281325 , ("UTF8",
@@ -359,7 +403,7 @@ testCases =
359403 ]
360404
361405 where
362− n = P.moduleNameFromString . T.pack
406+ n = P.moduleNameFromString
363407 pkg str = let Right p = parsePackageName str in p
364408
365409 hasTypeVar varName =