content: module TestDocs where
  
  import Prelude
  import Protolude (tailDef)
  
  import Data.Bifunctor (first)
  import Data.List (findIndex)
  import Data.Foldable (find, forM_)
  import Safe (headMay)
  import Data.Map qualified as Map
  import Data.Maybe (fromMaybe, isNothing, mapMaybe)
  import Data.Monoid (Any(..), First(..))
  import Data.Text (Text)
  import Data.Text qualified as T
  import Text.PrettyPrint.Boxes qualified as Boxes
  
  import Language.PureScript qualified as P
  import Language.PureScript.Docs qualified as Docs
  import Language.PureScript.Docs.AsMarkdown (codeToString)
  import Language.PureScript.Publish.ErrorsWarnings qualified as Publish
  
  import Web.Bower.PackageMeta (parsePackageName, runPackageName)
  
  import TestPscPublish (preparePackage)
  
  import Test.Hspec (Spec, beforeAll, context, expectationFailure, it)
  
  spec :: Spec
  spec = beforeAll (handleDocPrepFailure <$> preparePackage "tests/purs/docs" "purs.json" "resolutions.json") $
    context "Language.PureScript.Docs" $ do
      context "Doc generation tests:" $
        mkSpec testCases displayAssertion $ \a pkg mdl ->
          case runAssertion a (Docs.getLinksContext pkg) mdl of
            Pass ->
              pure ()
            Fail reason ->
              expectationFailure (T.unpack (displayAssertionFailure reason))
  
      context "Tag generation tests:" $
        mkSpec testTagsCases displayTagsAssertion $ \a _ mdl ->
          case runTagsAssertion a (Map.fromList $ Docs.tags mdl) of
            TagsPass ->
              pure ()
            TagsFail reason ->
              expectationFailure (T.unpack (displayTagsAssertionFailure reason))
    where
    handleDocPrepFailure = first (expectationFailure . ("failed to produce docs: " <>) . Boxes.render . Publish.renderError)
  
    mkSpec cases displayAssertion' runner =
      forM_ cases $ \(mnString, assertions) -> do
        let mn = P.moduleNameFromString mnString
        context ("in module " ++ T.unpack mnString) $
          forM_ assertions $ \a ->
            it (T.unpack (displayAssertion' a)) . either id $ \pkg@Docs.Package{..} ->
              case find ((==) mn . Docs.modName) pkgModules of
                Nothing ->
                  expectationFailure ("module not found in docs: " ++ T.unpack mnString)
                Just mdl ->
                  runner a pkg mdl
  
  data DocsAssertion
    -- | Assert that a particular declaration is documented with the given
    -- children
    = ShouldBeDocumented P.ModuleName Text [Text]
    -- | Assert that a particular declaration is not documented
    | ShouldNotBeDocumented P.ModuleName Text
    -- | Assert that a particular declaration exists, but without a particular
    -- child.
    | ChildShouldNotBeDocumented P.ModuleName Text Text
    -- | Assert that a particular declaration has a particular type class
    -- constraint.
    | ShouldBeConstrained P.ModuleName Text Text
    -- | Assert that a particular typeclass declaration has a functional
    -- dependency list.
    | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]
    -- | Assert that a particular value declaration exists, and its type
    -- satisfies the given predicate.
    | ValueShouldHaveTypeSignature P.ModuleName Text (Docs.Type' -> Bool)
    -- | Assert that a particular instance declaration exists under some class or
    -- type declaration, and that its type satisfies the given predicate.
    | InstanceShouldHaveTypeSignature P.ModuleName Text Text (Docs.Type' -> Bool)
    -- | Assert that a particular type alias exists, and its corresponding
    -- type, when rendered, matches a given string exactly
    -- fields: module, type synonym name, expected type
    | TypeSynonymShouldRenderAs P.ModuleName Text Text
    -- | Assert that a documented declaration includes a documentation comment
    -- containing a particular string
    | ShouldHaveDocComment P.ModuleName Text Text
    -- | Assert that a documented data declaration includes a documentation comment
    -- | containing a particular string
    | ShouldHaveDataConstructorDocComment P.ModuleName Text Text Text
    -- | Assert that a documented data declaration has no documentation comment
    | ShouldHaveNoDataConstructorDocComment P.ModuleName Text Text
    -- | Assert that a documented class method includes a documentation comment
    -- | containing a particular string
    | ShouldHaveClassMethodDocComment P.ModuleName Text Text Text
    -- | Assert that a class method has no documentation comment
    | ShouldNotHaveClassMethodDocComment P.ModuleName Text Text
    -- | Assert that there should be some declarations re-exported from a
    -- particular module in a particular package.
    | ShouldHaveReExport (Docs.InPackage P.ModuleName)
    -- | Assert that a link to some specific declaration exists within the
    -- rendered code for a declaration. Fields are: local module, local
    -- declaration title, title of linked declaration, namespace of linked
    -- declaration, destination of link.
    | ShouldHaveLink P.ModuleName Text Text Docs.Namespace Docs.LinkLocation
    -- | Assert that a given declaration comes before another in the output
    | ShouldComeBefore P.ModuleName Text Text
    -- | Assert that a given declaration has the given kind signature
    | ShouldHaveKindSignature P.ModuleName Text Text
    -- | Assert that a given declaration does not have a kind signature
    | ShouldNotHaveKindSignature P.ModuleName Text
    -- | Assert that a given declaration with doc-comments on its
    -- kind signature, type declaration, and role declaration are properly
    -- merged into one doc-comment.
    | ShouldMergeDocComments P.ModuleName Text (Maybe Text)
    -- | Assert that a given declaration's type parameters have the
    -- given role annotations
    | ShouldHaveRoleAnnotation P.ModuleName Text [P.Role]
    -- | Assert that a given module has the expected doc comments
    | ShouldHaveModuleDocs P.ModuleName (Maybe Text)
  
  data TagsAssertion
    -- | Assert that a particular declaration is tagged
    = ShouldBeTagged Text Int
    -- | Assert that a particular declaration is not tagged
    | ShouldNotBeTagged Text
  
  displayAssertion :: DocsAssertion -> Text
  displayAssertion = \case
    ShouldBeDocumented mn decl children ->
      showQual mn decl <> " should be documented" <>
      (if not (null children)
         then " with children: " <> T.pack (show children)
         else "")
    ShouldNotBeDocumented mn decl ->
      showQual mn decl <> " should not be documented"
    ChildShouldNotBeDocumented mn decl child ->
      showQual mn decl <> " should not have " <> child <> " as a child declaration"
    ShouldBeConstrained mn decl constraint ->
      showQual mn decl <> " should have a " <> constraint <> " constraint"
    ShouldHaveFunDeps mn decl fundeps ->
      showQual mn decl <> " should have fundeps: " <> T.pack (show fundeps)
    ValueShouldHaveTypeSignature mn decl _ ->
      "the type signature for " <> showQual mn decl <>
      " should satisfy the given predicate"
    InstanceShouldHaveTypeSignature _ parent instName _ ->
      "the instance " <> instName <> " (under " <> parent <> ") should have" <>
      " a type signature satisfying the given predicate"
    TypeSynonymShouldRenderAs mn synName code ->
      "the RHS of the type synonym " <> showQual mn synName <>
      " should be rendered as " <> code
    ShouldHaveDocComment mn decl excerpt ->
      "the string " <> T.pack (show excerpt) <> " should appear in the" <>
      " doc-comments for " <> showQual mn decl
    ShouldHaveDataConstructorDocComment mn decl constr excerpt ->
      "the string " <> T.pack (show excerpt) <> " should appear in the" <>
      " doc-comments for data constructor " <> T.pack (show constr) <> " for " <> showQual mn decl
    ShouldHaveNoDataConstructorDocComment mn decl constr ->
      "Doc-comments for data constructor " <> T.pack (show constr) <> " for " <> showQual mn decl <>
      " should be empty"
    ShouldHaveClassMethodDocComment mn decl method excerpt ->
      "the string " <> T.pack (show excerpt) <> " should appear in the" <>
      " doc-comment for class method " <> T.pack (show method) <> " for " <> showQual mn decl
    ShouldNotHaveClassMethodDocComment mn decl method ->
      "Doc-comments for class method " <> T.pack (show method) <> " for " <> showQual mn decl <>
      " should be empty"
    ShouldHaveReExport inPkg ->
      "there should be some re-exports from " <>
      showInPkg P.runModuleName inPkg
    ShouldHaveLink mn decl targetTitle targetNs _ ->
      "the rendered code for " <> showQual mn decl <> " should contain a link" <>
      " to " <> targetTitle <> " (" <> T.pack (show targetNs) <> ")"
    ShouldComeBefore mn declA declB ->
      showQual mn declA <> " should come before " <> showQual mn declB <>
      " in the docs"
    ShouldHaveKindSignature mn decl expected ->
      showQual mn decl <> " should have the kind signature `" <> expected <> "`"
    ShouldNotHaveKindSignature mn decl ->
      showQual mn decl <> " should not have a kind signature."
    ShouldMergeDocComments mn decl _ ->
      showQual mn decl <> " should merge the doc-comments of its kind " <>
      "declaration (if any), type declaration, and role declaration (if any) " <>
      "into one doc-comment."
    ShouldHaveRoleAnnotation mn decl expected ->
      showQual mn decl <> " should have the expected role annotations: " <>
      T.intercalate ", " (fmap P.displayRole expected)
    ShouldHaveModuleDocs mn expected ->
      "Module doc comments for module `" <> P.runModuleName mn <> "` should be " <>
        maybe "empty" (\t -> "'" <> t <> "`") expected
  
  displayTagsAssertion :: TagsAssertion -> Text
  displayTagsAssertion = \case
    ShouldBeTagged decl l ->
      decl <> " should be tagged at line " <> T.pack (show l)
    ShouldNotBeTagged decl ->
      decl <> " should not be tagged"
  
  data DocsAssertionFailure
    -- | A declaration was not documented, but should have been
    = NotDocumented P.ModuleName Text
    -- | The expected list of child declarations did not match the actual list
    | ChildrenNotDocumented P.ModuleName Text [Text]
    -- | A declaration was documented, but should not have been
    | Documented P.ModuleName Text
    -- | A child declaration was documented, but should not have been
    | ChildDocumented P.ModuleName Text Text
    -- | A constraint was missing.
    | ConstraintMissing P.ModuleName Text Text
    -- | A functional dependency was missing.
    | FunDepMissing P.ModuleName Text [([Text], [Text])]
    -- | A declaration had the wrong "type" (ie, value, type, type class)
    -- Fields: declaration title, expected "type", actual "type".
    | WrongDeclarationType P.ModuleName Text Text Text
    -- | A declaration had the wrong type (in the sense of "type checking"), eg,
    -- because the inferred type was used when the explicit type should have
    -- been.
    -- Fields: module name, declaration name, actual type.
    | DeclarationWrongType P.ModuleName Text Docs.Type'
    -- | A Type synonym has been rendered in an unexpected format
    -- Fields: module name, declaration name, expected rendering, actual rendering
    | TypeSynonymMismatch P.ModuleName Text Text Text
    -- | A doc comment was not found or did not match what was expected
    -- Fields: module name, declaration, actual comments
    | DocCommentMissing P.ModuleName Text (Maybe Text)
    -- | A doc comment was found where none was expected
    -- Fields: module name, declaration, actual comments
    | DocCommentPresent P.ModuleName Text (Maybe Text)
    -- | A module was missing re-exports from a particular module.
    -- Fields: module name, expected re-export, actual re-exports.
    | ReExportMissing P.ModuleName (Docs.InPackage P.ModuleName) [Docs.InPackage P.ModuleName]
    -- | Expected to find some other declaration mentioned in this declaration's
    -- rendered code, but did not find anything.
    -- Fields: module name, declaration title, title of declaration which was
    -- expected but not found in.
    | LinkedDeclarationMissing P.ModuleName Text Text
    -- | Expected one link location for a declaration mentioned in some other
    -- declaration's rendered code, but found a different one. Fields: module
    -- name, title of the local declaration which links to some other
    -- declaration, title of the linked declaration, expected location, actual
    -- location.
    | BadLinkLocation P.ModuleName Text Text Docs.LinkLocation Docs.LinkLocation
    -- | Declarations were in the wrong order
    | WrongOrder P.ModuleName Text Text
    -- | Expected a kind signature for a declaration, but did not find one
    -- Fields: module name, declaration title.
    | KindSignatureMissing P.ModuleName Text
    -- | The rendered kind signature did not match the expected one.
    -- Fields: module name, declaration title, expected kind signature (text),
    -- actual kind signature (text), actual kind signature (structure)
    | KindSignatureMismatch P.ModuleName Text Text Text (P.Type ())
    -- | A kind signature was found where none was expected.
    -- Fields: module name, declaration title, actual kind signature (text),
    -- actual kind signature (structure)
    | KindSignaturePresent P.ModuleName Text Text (P.Type ())
    -- | The doc comments for the kind signature (if any), type declaration, and
    -- role declaration (if any) were not properly merged into the expected one.
    -- Fields: module name, declaration title, expected doc-comments,
    -- actual doc-comments
    | DocCommentMergeFailure P.ModuleName Text Text Text
    -- | The given declaration cannot have role annotations.
    -- Fields: module name, declaration title
    | CannotHaveRoles P.ModuleName Text
    -- | The list of expected roles did not match the list of actual roles
    -- fields: module name, declaration title, expected role list,
    -- actual role list
    | RoleMismatch P.ModuleName Text [P.Role] [P.Role]
    -- | The module's doc comments should be the expected
    -- fields: module name, expected docs, actual docs
    | WrongModuleDocs P.ModuleName (Maybe Text) (Maybe Text)
  
  data TagsAssertionFailure
    -- | A declaration was not tagged, but should have been
    = NotTagged Text
    -- | A declaration was tagged, but should not have been
    | Tagged Text Int
    -- | A declaration was tagged on the wrong line
    | TaggedWrongLine Text Int Int
  
  displayAssertionFailure :: DocsAssertionFailure -> Text
  displayAssertionFailure = \case
    NotDocumented _ decl ->
      decl <> " was not documented, but should have been"
    ChildrenNotDocumented _ decl children ->
      decl <> " had the wrong children; got " <> T.pack (show children)
    Documented _ decl ->
      decl <> " was documented, but should not have been"
    ChildDocumented _ decl child ->
      decl <> " had " <> child <> " as a child"
    ConstraintMissing _ decl constraint ->
      decl <> " did not have a " <> constraint <> " constraint"
    FunDepMissing _ decl fundeps ->
      decl <> " had the wrong fundeps; got " <> T.pack (show fundeps)
    WrongDeclarationType _ decl expected actual ->
      "expected " <> decl <> " to be a " <> expected <> " declaration, but it" <>
      " was a " <> actual <> " declaration"
    DeclarationWrongType _ decl actual ->
      decl <> " had the wrong type; got " <> T.pack (P.prettyPrintType maxBound actual)
    TypeSynonymMismatch _ decl expected actual ->
      "expected the RHS of " <> decl <> " to be " <> expected <>
      "; got " <> actual
    DocCommentMissing _ decl actual ->
      "the doc-comment for " <> decl <> " did not contain the expected substring;" <>
      " got " <> T.pack (show actual)
    DocCommentPresent _ decl actual ->
      "the doc-comment for " <> decl <> " was not empty. Got " <> T.pack (show actual)
    ReExportMissing _ expected actuals ->
      "expected to see some re-exports from " <>
      showInPkg P.runModuleName expected <>
      "; instead only saw re-exports from " <>
      T.pack (show (map (showInPkg P.runModuleName) actuals))
    LinkedDeclarationMissing _ decl target ->
      "expected to find a link to " <> target <> " within the rendered code" <>
      " for " <> decl <> ", but no such link was found"
    BadLinkLocation _ decl target expected actual ->
      "in rendered code for " <> decl <> ", bad link location for " <> target <>
      ": expected " <> T.pack (show expected) <>
      " got " <> T.pack (show actual)
    WrongOrder _ before' after' ->
      "expected to see " <> before' <> " before " <> after'
    KindSignatureMissing _ decl ->
      "the kind signature for " <> decl <> " is missing."
    KindSignatureMismatch _ decl expected actualTxt actualKind ->
      "expected the kind signature for " <> decl <> "\n" <>
      "to be `" <> expected <> "`\n" <>
      "  got `" <> actualTxt <> "`\n" <>
      "Structure of kind: " <> T.pack (show actualKind)
    KindSignaturePresent _ decl actualTxt actualKind ->
      "the kind signature for " <> decl <> " was not empty.\n" <>
      "got `" <> actualTxt <> "`\n" <>
      "Structure of kind: " <> T.pack (show actualKind)
    DocCommentMergeFailure _ decl expected actual ->
      "Expected the doc-comment for " <> decl <> " to merge comments and be `" <>
      expected <> "`; got `" <> actual <> "`"
    CannotHaveRoles _ decl ->
      decl <> " is a type of declaration that cannot have roles."
    RoleMismatch _ decl expected actual ->
      "Expected the role annotations for " <> decl <> " to be \n" <>
      "`" <> displayRoleList expected <> "`, but got\n" <>
      "`" <> displayRoleList actual <> "`"
      where
        displayRoleList = T.intercalate ", " . fmap P.displayRole
    WrongModuleDocs mn expected actual ->
      "Expected module docs for " <> P.runModuleName mn <> "\n" <>
      "to be `" <> fromMaybe "<Nothing>" expected <> "`\n" <>
      "  got `" <> fromMaybe "<Nothing>" actual <> "`"
  
  displayTagsAssertionFailure :: TagsAssertionFailure -> Text
  displayTagsAssertionFailure = \case
    NotTagged decl ->
      decl <> " was not tagged, but should have been"
    Tagged decl line ->
      decl <> " was tagged at line " <> T.pack (show line) <>
      ", but should not have been"
    TaggedWrongLine decl taggedLine desiredLine ->
      decl <> " was tagged at line " <> T.pack (show taggedLine) <>
      ", but should have been tagged at line " <> T.pack (show desiredLine)
  
  data DocsAssertionResult
    = Pass
    | Fail DocsAssertionFailure
  
  data TagsAssertionResult
    = TagsPass
    | TagsFail TagsAssertionFailure
  
  runAssertion :: DocsAssertion -> Docs.LinksContext -> Docs.Module -> DocsAssertionResult
  runAssertion assertion linksCtx Docs.Module{..} =
    case assertion of
      ShouldBeDocumented mn decl children ->
        case findChildren decl (declarationsFor mn) of
          Nothing ->
            Fail (NotDocumented mn decl)
          Just actualChildren ->
            if children == actualChildren
              then Pass
              else Fail (ChildrenNotDocumented mn decl actualChildren)
  
      ShouldNotBeDocumented mn decl ->
        case findChildren decl (declarationsFor mn) of
          Just _ ->
            Fail (Documented mn decl)
          Nothing ->
            Pass
  
      ChildShouldNotBeDocumented mn decl child ->
        case findChildren decl (declarationsFor mn) of
          Just children ->
            if child `elem` children
              then Fail (ChildDocumented mn decl child)
              else Pass
          Nothing ->
            Fail (NotDocumented mn decl)
  
      ShouldBeConstrained mn decl tyClass ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          case declInfo of
            Docs.ValueDeclaration ty ->
              if checkConstrained ty tyClass
                then Pass
                else Fail (ConstraintMissing mn decl tyClass)
            _ ->
              Fail (WrongDeclarationType mn decl "value"
                     (Docs.declInfoToString declInfo))
  
      ShouldHaveFunDeps mn decl fds ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          case declInfo of
            Docs.TypeClassDeclaration _ _ fundeps ->
              if fundeps == fds
                then Pass
                else Fail (FunDepMissing mn decl fds)
            _ ->
              Fail (WrongDeclarationType mn decl "value"
                     (Docs.declInfoToString declInfo))
  
      ValueShouldHaveTypeSignature mn decl tyPredicate ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          case declInfo of
            Docs.ValueDeclaration ty ->
              if tyPredicate ty
                then Pass
                else Fail (DeclarationWrongType mn decl ty)
            _ ->
              Fail (WrongDeclarationType mn decl "value"
                     (Docs.declInfoToString declInfo))
  
      InstanceShouldHaveTypeSignature mn parent decl tyPredicate ->
        case find ((==) parent . Docs.declTitle) (declarationsFor mn) >>= findTarget of
          Just ty ->
            if tyPredicate ty
              then Pass
              else Fail (DeclarationWrongType mn decl ty)
          Nothing ->
            Fail (NotDocumented mn decl)
  
        where
        findTarget =
          headMay .
          mapMaybe (extractInstanceType . Docs.cdeclInfo) .
          filter (\cdecl -> Docs.cdeclTitle cdecl == decl) .
          Docs.declChildren
  
        extractInstanceType = \case
          (Docs.ChildInstance _ ty) ->
            Just ty
          _ ->
            Nothing
  
      TypeSynonymShouldRenderAs mn decl expected ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          case declInfo of
            Docs.TypeSynonymDeclaration [] ty ->
              let actual = codeToString (Docs.renderType ty) in
              if actual == expected
                 then Pass
                 else Fail (TypeSynonymMismatch mn decl expected actual)
            _ ->
              Fail (WrongDeclarationType mn decl "synonym"
                    (Docs.declInfoToString declInfo))
  
      ShouldHaveDocComment mn decl expected ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          if maybe False (expected `T.isInfixOf`) declComments
            then Pass
            else Fail (DocCommentMissing mn decl declComments)
  
      ShouldHaveDataConstructorDocComment mn decl constr expected ->
        findDeclChildrenComment mn decl constr expected
  
      ShouldHaveNoDataConstructorDocComment mn decl constr ->
        findDeclChildrenNoComment mn decl constr
  
      ShouldHaveClassMethodDocComment mn decl constr expected ->
        findDeclChildrenComment mn decl constr expected
  
      ShouldNotHaveClassMethodDocComment mn decl method ->
        findDeclChildrenNoComment mn decl method
  
      ShouldHaveReExport reExp ->
        let
          reExps = map fst modReExports
        in
          if reExp `elem` reExps
            then Pass
            else Fail (ReExportMissing modName reExp reExps)
  
      ShouldHaveLink mn decl destTitle destNs expectedLoc ->
        findDecl mn decl $ \decl' ->
          let
            rendered = Docs.renderDeclaration decl'
          in
            case extract rendered destNs destTitle of
              Just (Docs.linkLocation -> actualLoc) ->
                if expectedLoc == actualLoc
                  then Pass
                  else Fail (BadLinkLocation mn decl destTitle expectedLoc actualLoc)
              Nothing ->
                Fail (LinkedDeclarationMissing mn decl destTitle)
  
      ShouldComeBefore mn before' after' ->
        let
          decls = declarationsFor mn
  
          indexOf :: Text -> Maybe Int
          indexOf title = findIndex ((==) title . Docs.declTitle) decls
        in
          case (indexOf before', indexOf after') of
            (Just i, Just j) ->
              if i < j
                then Pass
                else Fail (WrongOrder mn before' after')
            (Nothing, _) ->
              Fail (NotDocumented mn before')
            (_, Nothing) ->
              Fail (NotDocumented mn after')
  
      ShouldHaveKindSignature mn decl expected ->
        findDeclKinds mn decl $ \case
          Just Docs.KindInfo{..} ->
            if expected /= actual
                then Fail (KindSignatureMismatch mn decl expected actual kiKind)
                else Pass
            where
              actual = codeToString $ Docs.renderKindSig decl $
                Docs.KindInfo kiKeyword kiKind
          Nothing -> Fail (KindSignatureMissing mn decl)
  
      ShouldNotHaveKindSignature mn decl ->
        findDeclKinds mn decl $ \case
          Just Docs.KindInfo{..} ->
            Fail (KindSignaturePresent mn decl actual kiKind)
            where
              actual = codeToString $ Docs.renderKindSig decl $
                Docs.KindInfo kiKeyword kiKind
          Nothing -> Pass
  
      ShouldMergeDocComments mn decl expected ->
        findDecl mn decl $ \Docs.Declaration{..} ->
          if expected == declComments
              then Pass
              else Fail (DocCommentMergeFailure mn decl (display expected) (display declComments))
          where
            display = fromMaybe ""
  
      ShouldHaveRoleAnnotation mn decl expected ->
        findDeclRoles mn decl $ \actual ->
          if expected == actual
            then Pass
            else Fail (RoleMismatch mn decl expected actual)
  
      ShouldHaveModuleDocs mn expected ->
        if expected == modComments then
          Pass
        else
          Fail (WrongModuleDocs mn expected modComments)
    where
    declarationsFor mn =
      if mn == modName
        then modDeclarations
        else fromMaybe [] (lookup mn (map (first Docs.ignorePackage) modReExports))
  
    findChildren title =
      fmap childrenTitles . find ((==) title . Docs.declTitle)
  
    findDecl mn title f =
        case find ((==) title . Docs.declTitle) (declarationsFor mn) of
          Nothing ->
            Fail (NotDocumented mn title)
          Just decl ->
            f decl
  
    findDeclKinds mn title f =
        case find ((==) title . Docs.declTitle) (declarationsFor mn) of
          Nothing ->
            Fail (NotDocumented mn title)
          Just Docs.Declaration{..} ->
            f declKind
  
    findDeclRoles mn title f =
        case find ((==) title . Docs.declTitle) (declarationsFor mn) of
          Nothing ->
            Fail (NotDocumented mn title)
          Just Docs.Declaration{..} ->
            case getRoles declInfo of
              Nothing ->
                Fail (CannotHaveRoles mn title)
              Just roles ->
                f roles
  
    findDeclChildren mn title child f =
      findDecl mn title $ \Docs.Declaration{..} ->
        case find ((==) child . Docs.cdeclTitle) declChildren of
          Nothing ->
            Fail (NotDocumented mn child)
          Just decl ->
            f decl
  
    findDeclChildrenComment mn decl constr expected =
      findDeclChildren mn decl constr $ \Docs.ChildDeclaration{..} ->
        if maybe False (expected `T.isInfixOf`) cdeclComments
          then Pass
          else Fail (DocCommentMissing mn constr cdeclComments)
  
    findDeclChildrenNoComment mn decl constr =
      findDeclChildren mn decl constr $ \Docs.ChildDeclaration{..} ->
        if isNothing cdeclComments
        then Pass
        else Fail (DocCommentPresent mn constr cdeclComments)
  
    childrenTitles = map Docs.cdeclTitle . Docs.declChildren
  
    getRoles :: Docs.DeclarationInfo -> Maybe [P.Role]
    getRoles = \case
      Docs.DataDeclaration _ _ roles -> Just roles
      _ -> Nothing
  
    extract :: Docs.RenderedCode -> Docs.Namespace -> Text -> Maybe Docs.DocLink
    extract rc ns title = getFirst (Docs.outputWith (First . go) rc) >>= getLink
      where
        getLink =
          Docs.getLink linksCtx (P.moduleNameFromString "$DocsTest") ns title
        go = \case
          Docs.Symbol ns' title' (Docs.Link containingMod)
            | ns' == ns && title' == title -> Just containingMod
          _ ->
            Nothing
  
  runTagsAssertion :: TagsAssertion -> Map.Map String Int -> TagsAssertionResult
  runTagsAssertion assertion tags =
    case assertion of
      ShouldBeTagged decl line ->
        case Map.lookup (T.unpack decl) tags of
          Just taggedLine ->
            if taggedLine == line
              then TagsPass
              else TagsFail $ TaggedWrongLine decl taggedLine line
          Nothing -> TagsFail $ NotTagged decl
  
      ShouldNotBeTagged decl ->
        case Map.lookup (T.unpack decl) tags of
          Just taggedLine -> TagsFail $ Tagged decl taggedLine
          Nothing -> TagsPass
  
  checkConstrained :: P.Type a -> Text -> Bool
  checkConstrained ty tyClass =
    case ty of
      P.ConstrainedType _ c ty'
        | matches tyClass c -> True
        | otherwise -> checkConstrained ty' tyClass
      P.ForAll _ _ _ _ ty' _ ->
        checkConstrained ty' tyClass
      _ ->
        False
    where
    matches className =
      (==) className . P.runProperName . P.disqualify . P.constraintClass
  
  testCases :: [(Text, [DocsAssertion])]
  testCases =
    [ ("Example",
        [ -- From dependencies
          ShouldBeDocumented    (n "Prelude") "Unit" []
        , ShouldNotBeDocumented (n "Prelude") "unit"
  
          -- From local files
        , ShouldBeDocumented    (n "Example2") "one" []
        , ShouldNotBeDocumented (n "Example2") "two"
  
          -- Re-exports
        , ShouldHaveReExport (Docs.FromDep (pkg "purescript-prelude") (n "Prelude"))
        , ShouldHaveReExport (Docs.Local (n "Example2"))
        ])
  
    , ("Example2",
        [ ShouldBeDocumented (n "Example2") "one" []
        , ShouldBeDocumented (n "Example2") "two" []
  
        , ShouldHaveLink (n "Example2") "one" "Int" Docs.TypeLevel (Docs.BuiltinModule (n "Prim"))
        ])
  
    , ("UTF8",
        [ ShouldBeDocumented (n "UTF8") "thing" []
        ])
  
    , ("Transitive1",
        [ ShouldBeDocumented (n "Transitive2") "transitive3" []
        ])
  
    , ("NotAllCtors",
        [ ShouldBeDocumented         (n "Prelude") "Boolean2" ["True"]
        , ChildShouldNotBeDocumented (n "Prelude") "Boolean2" "False"
        ])
  
    , ("DuplicateNames",
        [ ShouldBeDocumented    (n "Prelude")        "Unit" []
        , ShouldBeDocumented    (n "DuplicateNames") "unit" []
        , ShouldNotBeDocumented (n "Prelude")        "unit"
        ])
  
    , ("MultiVirtual",
        [ ShouldBeDocumented (n "MultiVirtual1") "foo" []
        , ShouldBeDocumented (n "MultiVirtual2") "bar" []
        , ShouldBeDocumented (n "MultiVirtual2") "baz" []
        ])
  
    , ("Clash",
        [ ShouldBeDocumented (n "Clash1") "value" []
        , ShouldBeDocumented (n "Clash1") "Type'" []
        , ShouldBeDocumented (n "Clash1") "TypeClass" ["typeClassMember"]
        ])
  
    , ("SolitaryTypeClassMember",
        [ ShouldBeDocumented    (n "SomeTypeClass") "member" []
        , ShouldNotBeDocumented (n "SomeTypeClass") "SomeClass"
        , ShouldBeConstrained   (n "SomeTypeClass") "member" "SomeClass"
        ])
  
    , ("ReExportedTypeClass",
        [ ShouldBeDocumented (n "SomeTypeClass") "SomeClass" ["member"]
        ])
  
    , ("TypeClassWithoutMembers",
        [ ShouldBeDocumented         (n "TypeClassWithoutMembersIntermediate") "SomeClass" []
        , ChildShouldNotBeDocumented (n "TypeClassWithoutMembersIntermediate") "SomeClass" "member"
        ])
  
    , ("TypeClassWithFunDeps",
        [ ShouldHaveFunDeps          (n "TypeClassWithFunDeps") "TypeClassWithFunDeps" [(["a","b"], ["c"]), (["c"], ["d","e"])]
        ])
  
    , ("NewOperators",
        [ ShouldBeDocumented (n "NewOperators2") "(>>>)" []
        ])
  
    , ("ExplicitTypeSignatures",
        [ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (hasTypeVar "something")
        , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt"    (P.tyInt `P.eqType`)
        , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber"  (P.tyNumber `P.eqType`)
        ])
  
    , ("ConstrainedArgument",
        [ TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithoutArgs" "forall a. (Partial => a) -> a"
        , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "WithArgs" "forall a. (Foo a => a) -> a"
        , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithoutArgs" "forall a. (Partial => Partial => a) -> a"
        , TypeSynonymShouldRenderAs (n "ConstrainedArgument") "MultiWithArgs" "forall a b. (Foo a => Foo b => a) -> a"
        ])
  
    , ("TypeOpAliases",
        [ ValueShouldHaveTypeSignature (n "TypeOpAliases") "test1" (renderedType "forall a b. a ~> b")
        , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test2" (renderedType "forall a b c. a ~> b ~> c")
        , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test3" (renderedType "forall a b c d. a ~> (b ~> c) ~> d")
        , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")
        , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")
  
        , ShouldBeDocumented (n "TypeOpAliases") "Tuple" ["Tuple","showTuple", "testLEither", "testREither"]
        , ShouldBeDocumented (n "TypeOpAliases") "Either" ["Left", "Right","testLEither", "testREither"]
        , ShouldBeDocumented (n "TypeOpAliases") "Show" ["show","showTuple"]
  
        , InstanceShouldHaveTypeSignature (n "TypeOpAliases") "Either" "testLEither" (renderedType "TestL (Either Int (Tuple Int String))")
        , InstanceShouldHaveTypeSignature (n "TypeOpAliases") "Either" "testREither" (renderedType "TestR (Either (Tuple Int Int) String)")
        ])
  
    , ("DocComments",
        [ ShouldHaveDocComment (n "DocComments") "example" "    example == 0"
        ])
  
    , ("DocCommentsDataConstructor",
        [ ShouldHaveDataConstructorDocComment (n "DocCommentsDataConstructor") "Foo" "Bar" "data constructor comment"
        , ShouldHaveNoDataConstructorDocComment (n "DocCommentsDataConstructor") "Foo" "Baz"
        , ShouldHaveNoDataConstructorDocComment (n "DocCommentsDataConstructor") "ComplexFoo" "ComplexBar"
        , ShouldHaveDataConstructorDocComment (n "DocCommentsDataConstructor") "ComplexFoo" "ComplexBaz" "another data constructor comment"
        , ShouldHaveDataConstructorDocComment (n "DocCommentsDataConstructor") "NewtypeFoo" "NewtypeFoo" "newtype data constructor comment"
        ])
  
    , ("DocCommentsClassMethod",
        [ ShouldHaveClassMethodDocComment (n "DocCommentsClassMethod") "Foo" "bar" "class method comment"
        , ShouldNotHaveClassMethodDocComment (n "DocCommentsClassMethod") "Foo" "baz"
        ])
  
    , ("TypeLevelString",
        [ ShouldBeDocumented (n "TypeLevelString") "Foo" ["fooBar"]
        ])
  
    , ("Desugar",
        [ ValueShouldHaveTypeSignature (n "Desugar") "test" (renderedType "forall a b. X (a -> b) a -> b")
        ])
  
    , ("ChildDeclOrder",
        [ ShouldBeDocumented (n "ChildDeclOrder") "Two" ["First", "Second", "showTwo", "fooTwo"]
        , ShouldBeDocumented (n "ChildDeclOrder") "Foo" ["foo1", "foo2", "fooTwo", "fooInt"]
        ])
  
    , ("DeclOrder",
        shouldBeOrdered (n "DeclOrder")
          ["A", "x1", "X2", "x3", "X4", "B"])
  
    , ("DeclOrderNoExportList",
        shouldBeOrdered (n "DeclOrderNoExportList")
          [ "x1", "x3", "X2", "X4", "A", "B" ])
  
    , ("Ado",
        [ ValueShouldHaveTypeSignature (n "Ado") "test" (renderedType "Int")
        ]
      )
  
    , ("TypeSynonymInstance",
        [ ShouldBeDocumented (n "TypeSynonymInstance") "MyNT" ["MyNT", "ntMyNT"]
        ]
      )
    , ("KindSignatureDocs",
        -- expected kind signatures
        [ ShouldHaveKindSignature (n "KindSignatureDocs") "DKindAndType" "data DKindAndType :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "TKindAndType" "type TKindAndType :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "NKindAndType" "newtype NKindAndType :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "CKindAndType" "class CKindAndType :: forall k. (k -> Type) -> k -> Constraint"
  
        , ShouldHaveKindSignature (n "KindSignatureDocs") "DKindOnly" "data DKindOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "TKindOnly" "type TKindOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "NKindOnly" "newtype NKindOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "CKindOnly" "class CKindOnly :: forall k. (k -> Type) -> k -> Constraint"
  
        , ShouldHaveKindSignature (n "KindSignatureDocs") "DTypeOnly" "data DTypeOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "TTypeOnly" "type TTypeOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "NTypeOnly" "newtype NTypeOnly :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "CTypeOnly" "class CTypeOnly :: forall k. (k -> Type) -> k -> Constraint"
  
        -- Declarations with no explicit kind signatures should still have
        -- their inferred kind signatures displayed as long as at least one
        -- type parameter does not have kind `Type`.
        , ShouldHaveKindSignature (n "KindSignatureDocs") "DImplicit" "data DImplicit :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "TImplicit" "type TImplicit :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "NImplicit" "newtype NImplicit :: forall k. k -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "CImplicit" "class CImplicit :: forall k1. (k1 -> Type) -> k1 -> Constraint"
  
        -- Declarations with no explicit kind signatures should not be displayed
        -- if each type parameter in their inferred kind signature
        -- has kind `Type`.
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DHidden"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DNothing"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "THidden"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "NHidden"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "CHidden"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "CNothing"
  
        -- FFI declarations always have an explicit kind signature
        -- but only show them if they are "interesting."
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "FFI_Hidden"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "FFI_Shown" "data FFI_Shown :: (Type -> Type) -> Type"
  
        -- Declarations with an explicit kind signature that is wrapped
        -- in parenthesis at various points, but which "desugars" so to speak
        -- to an uninteresting kind signature should not be displayed.
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "FFI_RedundantParenthesis"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataRedundantParenthesis"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "ClassRedundantParenthesis"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataHeadParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataTailParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataWholeParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataSelfParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "ClassSelfParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataKindAnnotation"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "DataKindAnnotationWithParens"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "FunctionParens1"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "FunctionParens2"
        , ShouldNotHaveKindSignature (n "KindSignatureDocs") "FunctionParens3"
  
        -- Declarations with no explicit kind signatures should be displayed
        -- if at least one type parameter has a kind other than `Type`
        -- despite all others having kind `Type`.
        , ShouldHaveKindSignature (n "KindSignatureDocs") "DShown" "data DShown :: Type -> Type -> (Type -> Type) -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "TShown" "type TShown :: (Type -> Type) -> Type -> Type -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "NShown" "newtype NShown :: Type -> (Type -> Type) -> Type -> Type"
        , ShouldHaveKindSignature (n "KindSignatureDocs") "CShown" "class CShown :: (Type -> Type) -> Type -> Type -> Constraint"
        ]
      )
    , ("RoleAnnotationDocs",
        [ ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "D_RNP" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "D_NPR" [P.Nominal, P.Phantom, P.Representational]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "D_PRN" [P.Phantom, P.Representational, P.Nominal]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_NNN" [P.Nominal, P.Nominal, P.Nominal]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_RNP" [P.Representational, P.Nominal, P.Phantom]
  
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_Higher1" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_Higher2" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_Higher3" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_Higher4" [P.Representational, P.Nominal, P.Phantom]
  
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_HeadParens" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_TailParens" [P.Representational, P.Nominal, P.Phantom]
        , ShouldHaveRoleAnnotation (n "RoleAnnotationDocs") "FFI_WholeParens" [P.Representational, P.Nominal, P.Phantom]
        ]
      )
    , ("DocCommentsMerge",
        [ ShouldMergeDocComments (n "DocCommentsMerge") "DataOnly" $ Just "decl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyData" $ Just "kind\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindAndData" $ Just "kind\n\ndecl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "DataRoleOnly" $ Just "role\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "DataAndRole" $ Just "decl\n\nrole\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyDataRoleOnly" $ Just "kind\n\nrole\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindDataAndRole" $ Just "kind\n\ndecl\n\nrole\n"
  
        , ShouldMergeDocComments (n "DocCommentsMerge") "FFIOnly" $ Just "decl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "FFIRoleOnly" $ Just "role\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "FFIAndRole" $ Just "decl\n\nrole\n"
  
        , ShouldMergeDocComments (n "DocCommentsMerge") "NewtypeOnly" $ Just "decl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyNewtype" $ Just "kind\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindAndNewtype" $ Just "kind\n\ndecl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "NewtypeRoleOnly" $ Just "role\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "NewtypeAndRole" $ Just "decl\n\nrole\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyNewtypeRoleOnly" $ Just "kind\n\nrole\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindNewtypeAndRole" $ Just "kind\n\ndecl\n\nrole\n"
  
        , ShouldMergeDocComments (n "DocCommentsMerge") "TypeOnly" $ Just "decl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyType" $ Just "kind\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindAndType" $ Just "kind\n\ndecl\n"
  
        , ShouldMergeDocComments (n "DocCommentsMerge") "ClassOnly" $ Just "decl\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindOnlyClass" $ Just "kind\n"
        , ShouldMergeDocComments (n "DocCommentsMerge") "KindAndClass" $ Just "kind\n\ndecl\n"
        ]
      )
    , ("Shebang1Undocumented",
        [ ShouldHaveModuleDocs (n "Shebang1Undocumented") Nothing
        ]
      )
    , ("Shebang2Undocumented",
        [ ShouldHaveModuleDocs (n "Shebang2Undocumented") Nothing
        ]
      )
    , ("Shebang3Undocumented",
        [ ShouldHaveModuleDocs (n "Shebang3Undocumented") $ Just "Normal doc comment\n"
        ]
      )
    , ("Shebang4Undocumented",
        [ ShouldHaveModuleDocs (n "Shebang4Undocumented") $ Just "Normal doc comment\n"
        ]
      )
    ]
  
    where
    n = P.moduleNameFromString
    pkg str = let Right p = parsePackageName str in p
  
    hasTypeVar varName =
      getAny . P.everythingOnTypes (<>) (Any . isVar varName)
  
    isVar varName (P.TypeVar _ name) | varName == T.unpack name = True
    isVar _ _ = False
  
    renderedType expected ty =
      codeToString (Docs.renderType ty) == expected
  
    shouldBeOrdered mn declNames =
      zipWith (ShouldComeBefore mn) declNames (tailDef mempty declNames)
  
  testTagsCases :: [(Text, [TagsAssertion])]
  testTagsCases =
    [ ("DeclOrder",
        [ -- explicit exports
          ShouldBeTagged "x1" 10
        , ShouldBeTagged "x3" 11
        , ShouldBeTagged "X2" 13
        , ShouldBeTagged "X4" 14
        , ShouldBeTagged "A" 16
        , ShouldBeTagged "B" 17
        ])
    , ("Example2",
        [ -- all symbols exported
          ShouldBeTagged "one" 3
        , ShouldBeTagged "two" 6
        ])
    , ("ExplicitExport",
        [ -- only one of two symbols exported
          ShouldBeTagged "one" 3
        , ShouldNotBeTagged "two"
        ])
    ]
  
  showQual :: P.ModuleName -> Text -> Text
  showQual mn decl =
    P.runModuleName mn <> "." <> decl
  
  showInPkg :: (a -> Text) -> Docs.InPackage a -> Text
  showInPkg f = \case
    Docs.Local x ->
      f x <> " (local)"
    Docs.FromDep pkgName x ->
      f x <> " (from dep: " <> runPackageName pkgName <> ")"
  