elm-review/tests/NoMissingTypeExpose.elm
2022-08-22 21:49:08 +02:00

748 lines
24 KiB
Elm
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module NoMissingTypeExpose exposing (rule)
{-|
@docs rule
-}
import Dict exposing (Dict)
import Elm.Docs exposing (Module)
import Elm.Module
import Elm.Project exposing (Project)
import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.Exposing as Exposing exposing (Exposing)
import Elm.Syntax.Import exposing (Import)
import Elm.Syntax.Module as Module exposing (Module)
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Range as Range
import Elm.Syntax.Signature exposing (Signature)
import Elm.Syntax.Type as Type
import Elm.Syntax.TypeAnnotation as TypeAnnotation exposing (TypeAnnotation)
import Review.Fix as Fix exposing (Fix)
import Review.ModuleNameLookupTable as ModuleNameLookupTable exposing (ModuleNameLookupTable)
import Review.Project.Dependency as Dependency exposing (Dependency)
import Review.Rule as Rule exposing (Rule)
import Set exposing (Set)
{-| Reports types that should be exposed but are not.
🔧 Running with `--fix` will automatically fix all the reported errors.
If a type is not exposed then it can be impossible to annotate functions or values that use them outside of the module. Affected types may be used in exposed function signatures, type aliases or other custom types.
import NoMissingTypeExpose
config : List Rule
config =
[ NoMissingTypeExpose.rule
]
## Fail
module Happiness exposing (happy, toString)
-- Type `Happiness` is private because it's not been exposed
type Happiness
= Happy
-- Private type `Happiness` used by exposed function `toString`
toString : Happiness -> String
toString happiness =
"Happy"
-- Private type `Happiness` used by exposed value `happy`
happy : Happiness
happy =
Happy
## Success
module Happiness exposing (Happiness, happy, toString)
type Happiness
= Happy
toString : Happiness -> String
toString happiness =
"Happy"
happy : Happiness
happy =
Happy
## Try it out
You can try this rule out by running the following command:
```bash
elm-review --template jfmengels/elm-review-common/example --rules NoMissingTypeExpose
```
-}
rule : Rule
rule =
Rule.newProjectRuleSchema "NoMissingTypeExpose" initialProjectContext
|> Rule.withElmJsonProjectVisitor elmJsonVisitor
|> Rule.withDirectDependenciesProjectVisitor dependencyDictVisitor
|> Rule.withModuleVisitor moduleVisitor
|> Rule.withContextFromImportedModules
|> Rule.withModuleContextUsingContextCreator
{ fromProjectToModule = fromProjectToModuleContext
, fromModuleToProject = fromModuleToProjectContext
, foldProjectContexts = foldProjectContexts
}
|> Rule.fromProjectRuleSchema
elmJsonVisitor : Maybe { a | project : Project } -> ProjectContext -> ( List nothing, ProjectContext )
elmJsonVisitor maybeProject context =
case maybeProject of
Just { project } ->
( []
, { context
| exposedModules = exposedModulesForElmJson project
}
)
Nothing ->
( [], context )
exposedModulesForElmJson : Project -> ExposedModules
exposedModulesForElmJson project =
case project of
Elm.Project.Package { exposed } ->
Package (elmProjectExposedList exposed)
Elm.Project.Application _ ->
Application
elmProjectExposedList : Elm.Project.Exposed -> Set String
elmProjectExposedList exposed =
case exposed of
Elm.Project.ExposedList list ->
List.foldl (Elm.Module.toString >> Set.insert) Set.empty list
Elm.Project.ExposedDict dict ->
List.foldl
(\( _, list ) acc ->
List.foldl (Elm.Module.toString >> Set.insert) acc list
)
Set.empty
dict
dependencyDictVisitor : Dict String Dependency -> ProjectContext -> ( List nothing, ProjectContext )
dependencyDictVisitor dependencies context =
( []
, { context
| exposedModules =
Dict.values dependencies
|> List.foldl exposedModulesForDependency context.exposedModules
}
)
exposedModulesForDependency : Dependency -> ExposedModules -> ExposedModules
exposedModulesForDependency dependency exposedModules =
Dependency.modules dependency
|> List.foldl (.name >> addExposedModule) exposedModules
moduleVisitor :
Rule.ModuleRuleSchema state ModuleContext
-> Rule.ModuleRuleSchema { state | hasAtLeastOneVisitor : () } ModuleContext
moduleVisitor schema =
schema
|> Rule.withModuleDefinitionVisitor moduleDefinitionVisitor
|> Rule.withImportVisitor importVisitor
|> Rule.withDeclarationListVisitor declarationListVisitor
|> Rule.withFinalModuleEvaluation finalEvaluation
moduleDefinitionVisitor : Node Module -> ModuleContext -> ( List nothing, ModuleContext )
moduleDefinitionVisitor (Node _ mod) context =
case context.moduleType of
InternalModule data ->
( []
, { lookupTable = context.lookupTable
, modulesFromTheProject = context.modulesFromTheProject
, moduleType = InternalModule { data | exposes = Module.exposingList mod }
}
)
ExposedModule data ->
( []
, { lookupTable = context.lookupTable
, modulesFromTheProject = context.modulesFromTheProject
, moduleType =
ExposedModule
{ data
| exposes = Module.exposingList mod
, exposingListStart = exposingListStartLocation (Module.exposingList mod)
}
}
)
exposingListStartLocation : Exposing -> Maybe Range.Location
exposingListStartLocation exposes =
case exposes of
Exposing.Explicit ((Node range _) :: _) ->
Just range.start
_ ->
Nothing
importVisitor : Node Import -> ModuleContext -> ( List nothing, ModuleContext )
importVisitor (Node _ { moduleName, moduleAlias }) context =
case context.moduleType of
InternalModule _ ->
( [], context )
ExposedModule data ->
( []
, { lookupTable = context.lookupTable
, modulesFromTheProject = context.modulesFromTheProject
, moduleType =
ExposedModule
{ data | exposedModules = exposedModulesForImportAlias (Node.value moduleName) moduleAlias data.exposedModules }
}
)
exposedModulesForImportAlias : ModuleName -> Maybe (Node ModuleName) -> ExposedModules -> ExposedModules
exposedModulesForImportAlias moduleName maybeModuleAlias exposedModules =
case maybeModuleAlias of
Just (Node _ moduleAlias) ->
addExposedModuleAlias moduleName
(String.join "." moduleAlias)
exposedModules
Nothing ->
exposedModules
declarationListVisitor : List (Node Declaration) -> ModuleContext -> ( List nothing, ModuleContext )
declarationListVisitor nodes context =
( []
, case context.moduleType of
InternalModule data ->
{ lookupTable = context.lookupTable
, modulesFromTheProject = context.modulesFromTheProject
, moduleType =
InternalModule
{ data
| exposedTypes =
exposedTypesForDeclarationList data.exposes nodes data.exposedTypes
}
}
ExposedModule data ->
{ lookupTable = context.lookupTable
, modulesFromTheProject = context.modulesFromTheProject
, moduleType =
ExposedModule
{ data
| declaredTypes = declaredTypesForDeclarationList nodes data.declaredTypes
, exposedSignatureTypes = exposedSignatureTypesForDeclarationList context.lookupTable data.exposes nodes data.exposedSignatureTypes
}
}
)
exposedTypesForDeclarationList : Exposing -> List (Node Declaration) -> Set String -> Set String
exposedTypesForDeclarationList exposes list exposedTypes =
List.foldl (exposedTypesForDeclaration exposes) exposedTypes list
exposedTypesForDeclaration : Exposing -> Node Declaration -> Set String -> Set String
exposedTypesForDeclaration exposes (Node _ declaration) exposedTypes =
case declaration of
Declaration.CustomTypeDeclaration { name } ->
rememberExposedType exposes name exposedTypes
Declaration.AliasDeclaration { name } ->
rememberExposedType exposes name exposedTypes
_ ->
exposedTypes
rememberExposedType : Exposing -> Node String -> Set String -> Set String
rememberExposedType exposes (Node _ name) exposedTypes =
if isTypeExposed exposes name then
Set.insert name exposedTypes
else
exposedTypes
declaredTypesForDeclarationList : List (Node Declaration) -> Set String -> Set String
declaredTypesForDeclarationList list declaredTypes =
List.foldl declaredTypesForDeclaration declaredTypes list
declaredTypesForDeclaration : Node Declaration -> Set String -> Set String
declaredTypesForDeclaration (Node _ declaration) declaredTypes =
case declaration of
Declaration.CustomTypeDeclaration { name } ->
rememberDeclaredType name declaredTypes
Declaration.AliasDeclaration { name } ->
rememberDeclaredType name declaredTypes
_ ->
declaredTypes
rememberDeclaredType : Node String -> Set String -> Set String
rememberDeclaredType (Node _ name) declaredTypes =
Set.insert name declaredTypes
exposedSignatureTypesForDeclarationList :
ModuleNameLookupTable
-> Exposing
-> List (Node Declaration)
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForDeclarationList lookupTable exposes list exposedSignatureTypes =
List.foldl (exposedSignatureTypesForDeclaration lookupTable exposes) exposedSignatureTypes list
exposedSignatureTypesForDeclaration :
ModuleNameLookupTable
-> Exposing
-> Node Declaration
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForDeclaration lookupTable exposes (Node _ declaration) exposedSignatureTypes =
case declaration of
Declaration.CustomTypeDeclaration { name, constructors } ->
exposedSignatureTypesForConstructorList lookupTable exposes name constructors exposedSignatureTypes
Declaration.AliasDeclaration { name, typeAnnotation } ->
exposedSignatureTypesForAlias lookupTable exposes name typeAnnotation exposedSignatureTypes
Declaration.FunctionDeclaration { signature } ->
exposedSignatureTypesForSignature lookupTable exposes signature exposedSignatureTypes
_ ->
exposedSignatureTypes
exposedSignatureTypesForConstructorList :
ModuleNameLookupTable
-> Exposing
-> Node String
-> List (Node Type.ValueConstructor)
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForConstructorList lookupTable exposes (Node _ name) list exposedSignatureTypes =
if isTypeExposedOpen exposes name then
List.foldl (exposedSignatureTypesForConstructor lookupTable) exposedSignatureTypes list
else
exposedSignatureTypes
exposedSignatureTypesForConstructor :
ModuleNameLookupTable
-> Node Type.ValueConstructor
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForConstructor lookupTable (Node _ { arguments }) exposedSignatureTypes =
exposedSignatureTypesForTypeAnnotationList lookupTable arguments exposedSignatureTypes
exposedSignatureTypesForAlias :
ModuleNameLookupTable
-> Exposing
-> Node String
-> Node TypeAnnotation
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForAlias lookupTable exposes (Node _ name) typeAnnotation exposedSignatureTypes =
if isTypeExposed exposes name then
case typeAnnotation of
Node _ (TypeAnnotation.Typed _ list) ->
exposedSignatureTypesForTypeAnnotationList lookupTable list exposedSignatureTypes
_ ->
exposedSignatureTypesForTypeAnnotation lookupTable typeAnnotation exposedSignatureTypes
else
exposedSignatureTypes
exposedSignatureTypesForSignature :
ModuleNameLookupTable
-> Exposing
-> Maybe (Node Signature)
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForSignature lookupTable exposes maybeSignature exposedSignatureTypes =
case maybeSignature of
Just (Node _ { name, typeAnnotation }) ->
if Exposing.exposesFunction (Node.value name) exposes then
exposedSignatureTypesForTypeAnnotation lookupTable typeAnnotation exposedSignatureTypes
else
exposedSignatureTypes
Nothing ->
exposedSignatureTypes
exposedSignatureTypesForRecordFieldList :
ModuleNameLookupTable
-> List (Node TypeAnnotation.RecordField)
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForRecordFieldList lookupTable fields exposedSignatureTypes =
List.foldl (exposedSignatureTypesForRecordField lookupTable) exposedSignatureTypes fields
exposedSignatureTypesForRecordField :
ModuleNameLookupTable
-> Node TypeAnnotation.RecordField
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForRecordField lookupTable (Node _ ( _, typeAnnotation )) exposedSignatureTypes =
exposedSignatureTypesForTypeAnnotation lookupTable typeAnnotation exposedSignatureTypes
exposedSignatureTypesForTypeAnnotationList :
ModuleNameLookupTable
-> List (Node TypeAnnotation)
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForTypeAnnotationList lookupTable list exposedSignatureTypes =
List.foldl (exposedSignatureTypesForTypeAnnotation lookupTable) exposedSignatureTypes list
exposedSignatureTypesForTypeAnnotation :
ModuleNameLookupTable
-> Node TypeAnnotation
-> List (Node ( ModuleName, String ))
-> List (Node ( ModuleName, String ))
exposedSignatureTypesForTypeAnnotation lookupTable (Node _ typeAnnotation) exposedSignatureTypes =
case typeAnnotation of
TypeAnnotation.Typed name list ->
case ModuleNameLookupTable.moduleNameFor lookupTable name of
Just moduleName ->
(Node.map (\( _, typeName ) -> ( moduleName, typeName )) name :: exposedSignatureTypes)
|> exposedSignatureTypesForTypeAnnotationList lookupTable list
Nothing ->
(name :: exposedSignatureTypes)
|> exposedSignatureTypesForTypeAnnotationList lookupTable list
TypeAnnotation.FunctionTypeAnnotation left right ->
exposedSignatureTypes
|> exposedSignatureTypesForTypeAnnotation lookupTable left
|> exposedSignatureTypesForTypeAnnotation lookupTable right
TypeAnnotation.Tupled list ->
exposedSignatureTypes
|> exposedSignatureTypesForTypeAnnotationList lookupTable list
TypeAnnotation.Record fields ->
exposedSignatureTypes
|> exposedSignatureTypesForRecordFieldList lookupTable fields
TypeAnnotation.GenericRecord _ (Node _ fields) ->
exposedSignatureTypes
|> exposedSignatureTypesForRecordFieldList lookupTable fields
TypeAnnotation.Unit ->
exposedSignatureTypes
TypeAnnotation.GenericType _ ->
exposedSignatureTypes
finalEvaluation : ModuleContext -> List (Rule.Error {})
finalEvaluation context =
case context.moduleType of
InternalModule _ ->
[]
ExposedModule data ->
data.exposedSignatureTypes
|> List.filter (isTypePrivate context.modulesFromTheProject data)
|> List.map (makeError data.exposingListStart)
isTypePrivate : Set ModuleName -> ExposedModuleData -> Node ( ModuleName, String ) -> Bool
isTypePrivate modulesFromTheProject data (Node _ typeCall) =
case typeCall of
( [], name ) ->
Set.member name data.declaredTypes
&& not (isTypeExposed data.exposes name)
( moduleName, _ ) ->
Set.member moduleName modulesFromTheProject
&& not (isModuleExposed data.exposedModules moduleName)
isTypeExposed : Exposing -> String -> Bool
isTypeExposed exposes name =
case exposes of
Exposing.All _ ->
True
Exposing.Explicit list ->
List.any (isExposingATypeNamed name) list
isTypeExposedOpen : Exposing -> String -> Bool
isTypeExposedOpen exposes name =
case exposes of
Exposing.All _ ->
True
Exposing.Explicit list ->
List.any (isExposingAnOpenTypeNamed name) list
isExposingATypeNamed : String -> Node Exposing.TopLevelExpose -> Bool
isExposingATypeNamed needle (Node _ topLevelExpose) =
case topLevelExpose of
Exposing.InfixExpose _ ->
False
Exposing.FunctionExpose _ ->
False
Exposing.TypeOrAliasExpose name ->
name == needle
Exposing.TypeExpose { name } ->
name == needle
isExposingAnOpenTypeNamed : String -> Node Exposing.TopLevelExpose -> Bool
isExposingAnOpenTypeNamed needle (Node _ expose) =
case expose of
Exposing.TypeExpose { name, open } ->
name == needle && open /= Nothing
_ ->
False
addExposedModule : String -> ExposedModules -> ExposedModules
addExposedModule moduleName exposedModules =
case exposedModules of
Application ->
exposedModules
Package list ->
Package (Set.insert moduleName list)
addExposedModuleAlias : ModuleName -> String -> ExposedModules -> ExposedModules
addExposedModuleAlias moduleName moduleAlias exposedModules =
case exposedModules of
Application ->
exposedModules
Package list ->
if Set.member (String.join "." moduleName) list then
Package (Set.insert moduleAlias list)
else
exposedModules
isModuleExposed : ExposedModules -> ModuleName -> Bool
isModuleExposed exposedModules moduleName =
case exposedModules of
Application ->
True
Package list ->
Set.member (String.join "." moduleName) list
makeError : Maybe Range.Location -> Node ( ModuleName, String ) -> Rule.Error {}
makeError exposingListStart (Node range typeName) =
let
formattedName : String
formattedName =
formatTypeName typeName
in
Rule.errorWithFix
{ message = "Private type `" ++ formattedName ++ "` should be exposed"
, details =
[ "Users of this module will not be able to annotate a value of this type if they wanted to. You should expose this type or an alias of this type."
]
}
range
(exposeTypeFix exposingListStart typeName)
exposeTypeFix : Maybe Range.Location -> ( ModuleName, String ) -> List Fix
exposeTypeFix exposingListStart ( moduleName, name ) =
case ( exposingListStart, moduleName ) of
( Just start, [] ) ->
[ Fix.insertAt start (name ++ ", ") ]
_ ->
[]
formatTypeName : ( ModuleName, String ) -> String
formatTypeName ( moduleName, name ) =
String.join "." (moduleName ++ [ name ])
fromProjectToModuleContext : Rule.ContextCreator ProjectContext ModuleContext
fromProjectToModuleContext =
Rule.initContextCreator
(\lookupTable moduleName { exposedModules, moduleTypes } ->
let
moduleType : ModuleType
moduleType =
if isModuleExposed exposedModules moduleName then
initialExposedModuleType exposedModules moduleTypes
else
initialInternalModuleType
in
{ lookupTable = lookupTable
, modulesFromTheProject = Dict.keys moduleTypes |> Set.fromList
, moduleType = moduleType
}
)
|> Rule.withModuleNameLookupTable
|> Rule.withModuleName
fromModuleToProjectContext : Rule.ContextCreator ModuleContext ProjectContext
fromModuleToProjectContext =
Rule.initContextCreator
(\moduleName context ->
case context.moduleType of
InternalModule { exposedTypes } ->
{ initialProjectContext | moduleTypes = Dict.singleton moduleName exposedTypes }
ExposedModule _ ->
initialProjectContext
)
|> Rule.withModuleName
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts new old =
{ exposedModules = foldExposedModules new.exposedModules old.exposedModules
, moduleTypes = foldModuleTypes new.moduleTypes old.moduleTypes
}
foldExposedModules : ExposedModules -> ExposedModules -> ExposedModules
foldExposedModules newExposedModules oldExposedModules =
case ( oldExposedModules, newExposedModules ) of
( Application, Application ) ->
Application
( Application, Package _ ) ->
newExposedModules
( Package _, Application ) ->
oldExposedModules
( Package oldList, Package newList ) ->
Package (Set.union oldList newList)
foldModuleTypes : Dict ModuleName (Set String) -> Dict ModuleName (Set String) -> Dict ModuleName (Set String)
foldModuleTypes newModuleTypes oldModuleTypes =
Dict.foldl foldModuleTypesHelp newModuleTypes oldModuleTypes
foldModuleTypesHelp : ModuleName -> Set String -> Dict ModuleName (Set String) -> Dict ModuleName (Set String)
foldModuleTypesHelp moduleName newTypes moduleTypes =
case Dict.get moduleName moduleTypes of
Just oldTypes ->
Dict.insert moduleName (Set.union oldTypes newTypes) moduleTypes
Nothing ->
Dict.insert moduleName newTypes moduleTypes
initialProjectContext : ProjectContext
initialProjectContext =
{ exposedModules = Application
, moduleTypes = Dict.empty
}
initialInternalModuleType : ModuleType
initialInternalModuleType =
InternalModule
{ exposedTypes = Set.empty
, exposes = Exposing.Explicit []
}
initialExposedModuleType : ExposedModules -> Dict ModuleName (Set String) -> ModuleType
initialExposedModuleType exposedModules moduleTypes =
ExposedModule
{ declaredTypes = Set.empty
, exposedModules = exposedModules
, exposedSignatureTypes = []
, exposes = Exposing.Explicit []
, exposingListStart = Nothing
, moduleTypes = moduleTypes
}
type alias ProjectContext =
{ exposedModules : ExposedModules
, moduleTypes : Dict ModuleName (Set String)
}
type alias ModuleContext =
{ lookupTable : ModuleNameLookupTable
, modulesFromTheProject : Set ModuleName
, moduleType : ModuleType
}
type ModuleType
= InternalModule InternalModuleData
| ExposedModule ExposedModuleData
type alias InternalModuleData =
{ exposedTypes : Set String
, exposes : Exposing
}
type alias ExposedModuleData =
{ declaredTypes : Set String
, exposedModules : ExposedModules
, exposedSignatureTypes : List (Node ( ModuleName, String ))
, exposes : Exposing
, exposingListStart : Maybe Range.Location
, moduleTypes : Dict ModuleName (Set String)
}
type ExposedModules
= Application
| Package (Set String)