elm-review/tests/Docs/ReviewLinksAndSections.elm
2022-08-24 18:31:28 +02:00

804 lines
26 KiB
Elm

module Docs.ReviewLinksAndSections exposing (rule)
{-|
@docs rule
-}
import Dict exposing (Dict)
import Docs.Utils.Link as Link
import Docs.Utils.Slug as Slug
import Elm.Module
import Elm.Package
import Elm.Project
import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.Documentation exposing (Documentation)
import Elm.Syntax.Exposing as Exposing
import Elm.Syntax.Module as Module
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Range exposing (Range)
import Elm.Version
import Regex exposing (Regex)
import Review.Rule as Rule exposing (Rule)
import Set exposing (Set)
{-| Reports problems with links and sections in Elm projects.
config =
[ Docs.ReviewLinksAndSections.rule
]
## Fail
Links to missing modules or sections are reported.
{-| Link to [missing module](Unknown-Module).
-}
a =
1
{-| Link to [missing section](#unknown).
-}
a =
1
In packages, links that would appear in the public documentation and that link to sections not part of the public documentation are reported.
module Exposed exposing (a)
import Internal
{-| Link to [internal details](Internal#section).
-}
a =
1
Sections that would have the same generated id are reported,
so that links don't inadvertently point to the wrong location.
module A exposing (element, section)
{-|
# Section
The above conflicts with the id generated
for the `section` value.
-}
element =
1
section =
1
## Success
module Exposed exposing (a, b)
import Internal
{-| Link to [exposed b](#b).
-}
a =
1
b =
2
## When (not) to enable this rule
For packages, this rule will be useful to prevent having dead links in the package documentation.
For applications, this rule will be useful if you have the habit of writing documentation the way you do in Elm packages,
and want to prevent it from going out of date.
This rule will not be useful if your project is an application and no-one in the team has the habit of writing
package-like documentation.
## Try it out
You can try this rule out by running the following command:
```bash
elm-review --template jfmengels/elm-review-documentation/example --rules Docs.ReviewLinksAndSections
```
## Thanks
Thanks to @lue-bird for helping out with this rule.
-}
rule : Rule
rule =
Rule.newProjectRuleSchema "Docs.ReviewLinksAndSections" initialProjectContext
|> Rule.withElmJsonProjectVisitor elmJsonVisitor
|> Rule.withReadmeProjectVisitor readmeVisitor
|> Rule.withModuleVisitor moduleVisitor
|> Rule.withModuleContextUsingContextCreator
{ fromProjectToModule = fromProjectToModule
, fromModuleToProject = fromModuleToProject
, foldProjectContexts = foldProjectContexts
}
|> Rule.withFinalProjectEvaluation finalEvaluation
|> Rule.fromProjectRuleSchema
type alias ProjectContext =
{ fileLinksAndSections : List FileLinksAndSections
, packageNameAndVersion : Maybe { name : String, version : String }
, exposedModules : Set ModuleName
}
initialProjectContext : ProjectContext
initialProjectContext =
{ fileLinksAndSections = []
, packageNameAndVersion = Nothing
, exposedModules = Set.empty
}
type alias FileLinksAndSections =
{ moduleName : ModuleName
, fileKey : FileKey
, sections : List Section
, links : List MaybeExposedLink
}
type FileKey
= ModuleKey Rule.ModuleKey
| ReadmeKey Rule.ReadmeKey
type alias ModuleContext =
{ isModuleExposed : Bool
, exposedElements : Set String
, moduleName : ModuleName
, commentSections : List SectionWithRange
, sections : List Section
, links : List MaybeExposedLink
}
type alias Section =
{ slug : String
, isExposed : Bool
}
type MaybeExposedLink
= MaybeExposedLink MaybeExposedLinkData
type alias MaybeExposedLinkData =
{ link : Link.Link
, linkRange : Range
, isExposed : Bool
}
fromProjectToModule : Rule.ContextCreator ProjectContext ModuleContext
fromProjectToModule =
Rule.initContextCreator
(\ast moduleName projectContext ->
let
exposedElements : Set String
exposedElements =
case Module.exposingList (Node.value ast.moduleDefinition) of
Exposing.All _ ->
Set.fromList (List.filterMap nameOfDeclaration ast.declarations)
Exposing.Explicit explicitlyExposed ->
Set.fromList (List.map exposedName explicitlyExposed)
in
{ isModuleExposed = Set.member moduleName projectContext.exposedModules
, exposedElements = exposedElements
, moduleName = moduleName
, commentSections = []
, sections = []
, links = []
}
)
|> Rule.withFullAst
|> Rule.withModuleName
fromModuleToProject : Rule.ContextCreator ModuleContext ProjectContext
fromModuleToProject =
Rule.initContextCreator
(\moduleKey moduleContext ->
{ fileLinksAndSections =
[ { moduleName = moduleContext.moduleName
, fileKey = ModuleKey moduleKey
, sections = moduleContext.sections
, links = moduleContext.links
}
]
, packageNameAndVersion = Nothing
, exposedModules = Set.empty
}
)
|> Rule.withModuleKey
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts newContext previousContext =
{ fileLinksAndSections = List.append newContext.fileLinksAndSections previousContext.fileLinksAndSections
, packageNameAndVersion = previousContext.packageNameAndVersion
, exposedModules = previousContext.exposedModules
}
moduleVisitor : Rule.ModuleRuleSchema schemaState ModuleContext -> Rule.ModuleRuleSchema { schemaState | hasAtLeastOneVisitor : () } ModuleContext
moduleVisitor schema =
schema
|> Rule.withModuleDocumentationVisitor moduleDocumentationVisitor
|> Rule.withDeclarationListVisitor declarationListVisitor
-- ELM.JSON VISITOR
elmJsonVisitor : Maybe { a | project : Elm.Project.Project } -> ProjectContext -> ( List nothing, ProjectContext )
elmJsonVisitor maybeElmJson projectContext =
case Maybe.map .project maybeElmJson of
Just (Elm.Project.Package { name, version, exposed }) ->
( []
, { projectContext
| packageNameAndVersion = Just { name = Elm.Package.toString name, version = Elm.Version.toString version }
, exposedModules = listExposedModules exposed
}
)
_ ->
( [], projectContext )
listExposedModules : Elm.Project.Exposed -> Set ModuleName
listExposedModules exposed =
let
exposedModules : List ModuleName
exposedModules =
exposedModulesFromPackageAsList exposed
|> List.map (Elm.Module.toString >> String.split ".")
in
Set.fromList ([] :: exposedModules)
exposedModulesFromPackageAsList : Elm.Project.Exposed -> List Elm.Module.Name
exposedModulesFromPackageAsList exposed =
case exposed of
Elm.Project.ExposedList list ->
list
Elm.Project.ExposedDict list ->
List.concatMap Tuple.second list
-- README VISITOR
readmeVisitor : Maybe { readmeKey : Rule.ReadmeKey, content : String } -> ProjectContext -> ( List (Rule.Error { useErrorForModule : () }), ProjectContext )
readmeVisitor maybeReadmeInfo projectContext =
case maybeReadmeInfo of
Just { readmeKey, content } ->
let
isReadmeExposed : Bool
isReadmeExposed =
Set.member [] projectContext.exposedModules
sectionsAndLinks : { titleSections : List SectionWithRange, links : List MaybeExposedLink }
sectionsAndLinks =
findSectionsAndLinks
[]
isReadmeExposed
{ content = content
, startRow = 1
}
in
( duplicateSectionErrors Set.empty sectionsAndLinks.titleSections
|> List.map (Rule.errorForReadme readmeKey duplicateSectionErrorDetails)
, { fileLinksAndSections =
{ moduleName = []
, fileKey = ReadmeKey readmeKey
, sections = List.map removeRangeFromSection sectionsAndLinks.titleSections
, links = sectionsAndLinks.links
}
:: projectContext.fileLinksAndSections
, packageNameAndVersion = projectContext.packageNameAndVersion
, exposedModules = projectContext.exposedModules
}
)
Nothing ->
( [], projectContext )
-- MODULE DEFINITION VISITOR
exposedName : Node Exposing.TopLevelExpose -> String
exposedName node =
case Node.value node of
Exposing.InfixExpose string ->
string
Exposing.FunctionExpose string ->
string
Exposing.TypeOrAliasExpose string ->
string
Exposing.TypeExpose exposedType ->
exposedType.name
-- MODULE DOCUMENTATION VISITOR
moduleDocumentationVisitor : Maybe (Node String) -> ModuleContext -> ( List (Rule.Error {}), ModuleContext )
moduleDocumentationVisitor moduleDocumentation context =
let
sectionsAndLinks : { titleSections : List SectionWithRange, links : List MaybeExposedLink }
sectionsAndLinks =
case moduleDocumentation of
Just (Node range content) ->
findSectionsAndLinks
context.moduleName
context.isModuleExposed
{ content = content, startRow = range.start.row }
Nothing ->
{ titleSections = [], links = [] }
in
( []
, { isModuleExposed = context.isModuleExposed
, exposedElements = context.exposedElements
, moduleName = context.moduleName
, commentSections = sectionsAndLinks.titleSections
, sections =
List.append
(List.map removeRangeFromSection sectionsAndLinks.titleSections)
context.sections
, links = List.append sectionsAndLinks.links context.links
}
)
-- DECLARATION VISITOR
declarationListVisitor : List (Node Declaration) -> ModuleContext -> ( List (Rule.Error {}), ModuleContext )
declarationListVisitor declarations context =
let
knownSections : List { slug : String, isExposed : Bool }
knownSections =
List.append
(List.map (\slug -> { slug = slug, isExposed = True }) (Set.toList context.exposedElements))
context.sections
sectionsAndLinks : List { titleSections : List SectionWithRange, links : List MaybeExposedLink }
sectionsAndLinks =
List.map
(findSectionsAndLinksForDeclaration
context.moduleName
(if context.isModuleExposed then
context.exposedElements
else
Set.empty
)
)
declarations
titleSections : List SectionWithRange
titleSections =
List.concatMap .titleSections sectionsAndLinks
in
( duplicateSectionErrors context.exposedElements (List.append titleSections context.commentSections)
|> List.map (Rule.error duplicateSectionErrorDetails)
, { isModuleExposed = context.isModuleExposed
, exposedElements = context.exposedElements
, moduleName = context.moduleName
, commentSections = context.commentSections
, sections = List.append (List.map removeRangeFromSection titleSections) knownSections
, links = List.append (List.concatMap .links sectionsAndLinks) context.links
}
)
duplicateSectionErrors : Set String -> List SectionWithRange -> List Range
duplicateSectionErrors exposedElements sections =
List.foldl
(\{ slug, range } { errors, knownSections } ->
if Set.member slug knownSections then
{ errors = range :: errors
, knownSections = knownSections
}
else
{ errors = errors
, knownSections = Set.insert slug knownSections
}
)
{ errors = [], knownSections = exposedElements }
sections
|> .errors
extractSlugsFromHeadings : { content : String, startRow : Int } -> List (Node String)
extractSlugsFromHeadings doc =
doc.content
|> String.lines
|> List.indexedMap
(\lineNumber line ->
Regex.find specialsToHash line
|> List.concatMap .submatches
|> List.filterMap identity
|> List.map
(\slug ->
Node
{ start = { row = lineNumber + doc.startRow, column = 1 }
, end = { row = lineNumber + doc.startRow, column = String.length line + 1 }
}
(Slug.toSlug slug)
)
)
|> List.concat
specialsToHash : Regex
specialsToHash =
"^#{1,6}\\s+(.*)$"
|> Regex.fromString
|> Maybe.withDefault Regex.never
nameOfDeclaration : Node Declaration -> Maybe String
nameOfDeclaration node =
case Node.value node of
Declaration.FunctionDeclaration { declaration } ->
declaration
|> Node.value
|> .name
|> Node.value
|> Just
Declaration.AliasDeclaration { name } ->
Just (Node.value name)
Declaration.CustomTypeDeclaration { name } ->
Just (Node.value name)
Declaration.PortDeclaration { name } ->
Just (Node.value name)
Declaration.InfixDeclaration { operator } ->
Just (Node.value operator)
Declaration.Destructuring _ _ ->
Nothing
docOfDeclaration : Declaration -> Maybe (Node Documentation)
docOfDeclaration declaration =
case declaration of
Declaration.FunctionDeclaration { documentation } ->
documentation
Declaration.AliasDeclaration { documentation } ->
documentation
Declaration.CustomTypeDeclaration { documentation } ->
documentation
Declaration.PortDeclaration _ ->
Nothing
Declaration.InfixDeclaration _ ->
Nothing
Declaration.Destructuring _ _ ->
Nothing
findSectionsAndLinksForDeclaration : ModuleName -> Set String -> Node Declaration -> { titleSections : List SectionWithRange, links : List MaybeExposedLink }
findSectionsAndLinksForDeclaration currentModuleName exposedElements declaration =
case docOfDeclaration (Node.value declaration) of
Just doc ->
let
name : String
name =
nameOfDeclaration declaration
|> Maybe.withDefault ""
isExposed : Bool
isExposed =
Set.member name exposedElements
in
findSectionsAndLinks
currentModuleName
isExposed
{ content = Node.value doc, startRow = (Node.range doc).start.row }
Nothing ->
{ titleSections = [], links = [] }
type alias SectionWithRange =
{ slug : String
, range : Range
, isExposed : Bool
}
removeRangeFromSection : SectionWithRange -> Section
removeRangeFromSection { slug, isExposed } =
{ slug = slug
, isExposed = isExposed
}
findSectionsAndLinks : ModuleName -> Bool -> { content : String, startRow : Int } -> { titleSections : List SectionWithRange, links : List MaybeExposedLink }
findSectionsAndLinks currentModuleName isExposed doc =
let
titleSections : List SectionWithRange
titleSections =
extractSlugsFromHeadings doc
|> List.map
(\slug ->
{ slug = Node.value slug
, range = Node.range slug
, isExposed = isExposed
}
)
links : List MaybeExposedLink
links =
Link.findLinks (doc.startRow - 1) currentModuleName doc.content
|> List.map
(\link ->
MaybeExposedLink
{ link = Node.value link
, linkRange = Node.range link
, isExposed = isExposed
}
)
in
{ titleSections = titleSections
, links = links
}
-- FINAL EVALUATION
finalEvaluation : ProjectContext -> List (Rule.Error { useErrorForModule : () })
finalEvaluation projectContext =
let
sectionsPerModule : Dict ModuleName (List Section)
sectionsPerModule =
projectContext.fileLinksAndSections
|> List.map (\module_ -> ( module_.moduleName, module_.sections ))
|> Dict.fromList
in
List.concatMap (errorsForFile projectContext sectionsPerModule) projectContext.fileLinksAndSections
errorsForFile : ProjectContext -> Dict ModuleName (List Section) -> FileLinksAndSections -> List (Rule.Error scope)
errorsForFile projectContext sectionsPerModule fileLinksAndSections =
List.filterMap
(errorForFile projectContext sectionsPerModule fileLinksAndSections)
fileLinksAndSections.links
errorForFile : ProjectContext -> Dict ModuleName (List Section) -> FileLinksAndSections -> MaybeExposedLink -> Maybe (Rule.Error scope)
errorForFile projectContext sectionsPerModule fileLinksAndSections (MaybeExposedLink maybeExposedLink) =
case maybeExposedLink.link.file of
Link.ModuleTarget moduleName ->
reportErrorForModule projectContext sectionsPerModule fileLinksAndSections maybeExposedLink moduleName
Link.ReadmeTarget ->
reportErrorForReadme sectionsPerModule fileLinksAndSections.fileKey maybeExposedLink
Link.PackagesTarget packageTarget ->
reportErrorsForPackagesTarget projectContext sectionsPerModule fileLinksAndSections maybeExposedLink packageTarget
Link.External target ->
reportErrorsForExternalTarget (projectContext.packageNameAndVersion == Nothing) fileLinksAndSections.fileKey maybeExposedLink.linkRange target
reportErrorsForPackagesTarget : ProjectContext -> Dict ModuleName (List Section) -> FileLinksAndSections -> MaybeExposedLinkData -> { name : String, version : String, subTarget : Link.SubTarget } -> Maybe (Rule.Error scope)
reportErrorsForPackagesTarget projectContext sectionsPerModule fileLinksAndSections maybeExposedLink { name, version, subTarget } =
case projectContext.packageNameAndVersion of
Just currentPackage ->
if name == currentPackage.name && (version == "latest" || version == currentPackage.version) then
reportErrorForCurrentPackageSubTarget projectContext sectionsPerModule fileLinksAndSections maybeExposedLink subTarget
else
Nothing
Nothing ->
Nothing
reportErrorForCurrentPackageSubTarget : ProjectContext -> Dict ModuleName (List Section) -> FileLinksAndSections -> MaybeExposedLinkData -> Link.SubTarget -> Maybe (Rule.Error scope)
reportErrorForCurrentPackageSubTarget projectContext sectionsPerModule fileLinksAndSections maybeExposedLink subTarget =
case subTarget of
Link.ModuleSubTarget moduleName ->
reportErrorForModule projectContext sectionsPerModule fileLinksAndSections maybeExposedLink moduleName
Link.ReadmeSubTarget ->
reportErrorForReadme sectionsPerModule fileLinksAndSections.fileKey maybeExposedLink
reportErrorForModule : ProjectContext -> Dict ModuleName (List Section) -> FileLinksAndSections -> MaybeExposedLinkData -> ModuleName -> Maybe (Rule.Error scope)
reportErrorForModule projectContext sectionsPerModule fileLinksAndSections maybeExposedLink moduleName =
case Dict.get moduleName sectionsPerModule of
Just existingSections ->
if Set.member fileLinksAndSections.moduleName projectContext.exposedModules && not (Set.member moduleName projectContext.exposedModules) then
Just (reportLinkToNonExposedModule fileLinksAndSections.fileKey maybeExposedLink.linkRange)
else
reportIfMissingSection fileLinksAndSections.fileKey existingSections maybeExposedLink
Nothing ->
Just (reportUnknownModule fileLinksAndSections.fileKey moduleName maybeExposedLink.linkRange)
reportErrorForReadme : Dict (List comparable) (List Section) -> FileKey -> MaybeExposedLinkData -> Maybe (Rule.Error scope)
reportErrorForReadme sectionsPerModule fileKey maybeExposedLink =
case Dict.get [] sectionsPerModule of
Just existingSections ->
reportIfMissingSection fileKey existingSections maybeExposedLink
Nothing ->
Just (reportLinkToMissingReadme fileKey maybeExposedLink.linkRange)
reportErrorsForExternalTarget : Bool -> FileKey -> Range -> String -> Maybe (Rule.Error scope)
reportErrorsForExternalTarget isApplication fileKey linkRange target =
if isApplication || String.contains "://" target then
Nothing
else
Just (reportLinkToExternalResourceWithoutProtocol fileKey linkRange)
reportIfMissingSection : FileKey -> List Section -> MaybeExposedLinkData -> Maybe (Rule.Error scope)
reportIfMissingSection fileKey existingSectionsForTargetFile { isExposed, linkRange, link } =
case link.slug of
Just "" ->
Just (reportLinkWithEmptySlug fileKey linkRange)
Just slug ->
case find (\section -> section.slug == slug) existingSectionsForTargetFile of
Just section ->
if isExposed && not section.isExposed then
Just (reportLinkToNonExposedSection fileKey linkRange)
else
Nothing
Nothing ->
Just (reportLink fileKey linkRange)
Nothing ->
Nothing
reportLink : FileKey -> Range -> Rule.Error scope
reportLink fileKey range =
reportForFile fileKey
{ message = "Link points to a non-existing section or element"
, details = [ "This is a dead link." ]
}
range
reportLinkToNonExposedModule : FileKey -> Range -> Rule.Error scope
reportLinkToNonExposedModule fileKey range =
reportForFile fileKey
{ message = "Link in public documentation points to non-exposed module"
, details = [ "Users will not be able to follow the link." ]
}
range
reportLinkToNonExposedSection : FileKey -> Range -> Rule.Error scope
reportLinkToNonExposedSection fileKey range =
reportForFile fileKey
{ message = "Link in public documentation points to non-exposed section"
, details = [ "Users will not be able to follow the link." ]
}
range
reportLinkWithEmptySlug : FileKey -> Range -> Rule.Error scope
reportLinkWithEmptySlug fileKey range =
reportForFile fileKey
{ message = "Link to empty section is unnecessary"
, details = [ "Links to # not followed by an id don't provide any value to the user. I suggest to either strip the # or remove the link." ]
}
range
reportUnknownModule : FileKey -> ModuleName -> Range -> Rule.Error scope
reportUnknownModule fileKey moduleName range =
reportForFile fileKey
{ message = "Link points to non-existing module " ++ String.join "." moduleName
, details = [ "This is a dead link." ]
}
range
reportLinkToMissingReadme : FileKey -> Range -> Rule.Error scope
reportLinkToMissingReadme fileKey range =
reportForFile fileKey
{ message = "Link points to missing README"
, details = [ "elm-review only looks for a 'README.md' located next to your 'elm.json'. Maybe it's positioned elsewhere or named differently?" ]
}
range
reportLinkToExternalResourceWithoutProtocol : FileKey -> Range -> Rule.Error scope
reportLinkToExternalResourceWithoutProtocol fileKey range =
reportForFile fileKey
{ message = "Link to unknown resource without a protocol"
, details =
[ "I have trouble figuring out what kind of resource is linked here."
, "If it should link to a module, then they should be in the form 'Some-Module-Name'."
, "If it's a link to an external resource, they should start with a protocol, like `https://www.fruits.com`, otherwise the link will point to an unknown resource on package.elm-lang.org."
]
}
range
duplicateSectionErrorDetails : { message : String, details : List String }
duplicateSectionErrorDetails =
{ message = "Duplicate section"
, details = [ "There are multiple sections that will result in the same id, meaning that links may point towards the wrong element." ]
}
reportForFile : FileKey -> { message : String, details : List String } -> Range -> Rule.Error scope
reportForFile fileKey =
case fileKey of
ModuleKey moduleKey ->
Rule.errorForModule moduleKey
ReadmeKey readmeKey ->
Rule.errorForReadme readmeKey
find : (a -> Bool) -> List a -> Maybe a
find predicate list =
case list of
[] ->
Nothing
first :: rest ->
if predicate first then
Just first
else
find predicate rest