elm-review/tests/Scope.elm
2020-06-25 22:57:31 +02:00

1601 lines
54 KiB
Elm

module Scope exposing
( ModuleContext, addModuleVisitors, initialModuleContext
, ProjectContext, addProjectVisitors
, initialProjectContext, fromProjectToModule, fromModuleToProject, foldProjectContexts
, moduleNameForValue, moduleNameForType
, addProjectVisitors_New
)
{-| Collect and infer information automatically for you
# Adding to a module rule
@docs ModuleContext, addModuleVisitors, initialModuleContext
# Adding to a project rule
@docs ProjectContext, addProjectVisitors
@docs initialProjectContext, fromProjectToModule, fromModuleToProject, foldProjectContexts
# Access
@docs moduleNameForValue, moduleNameForType
-}
{- Copied over from https://github.com/jfmengels/elm-review-scope
Version: 0.3.0
Copyright (c) 2020, Jeroen Engels
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name of elm-review-scope nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
import Dict exposing (Dict)
import Elm.Docs
import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.Exposing as Exposing exposing (Exposing, TopLevelExpose)
import Elm.Syntax.Expression as Expression exposing (Expression)
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.Pattern as Pattern exposing (Pattern)
import Elm.Syntax.Range as Range exposing (Range)
import Elm.Syntax.Signature exposing (Signature)
import Elm.Syntax.Type
import Elm.Syntax.TypeAnnotation as TypeAnnotation exposing (TypeAnnotation)
import Elm.Type
import Review.Project.Dependency as Dependency exposing (Dependency)
import Review.Rule as Rule exposing (Direction)
import Review.Rule3 as Rule3
import Set exposing (Set)
-- MODULE VISITOR
{-| The context the Scope visitors will collect and store in your `moduleContext`.
-}
type ModuleContext
= ModuleContext InnerModuleContext
type alias InnerModuleContext =
{ scopes : Nonempty Scope
, localTypes : Set String
, importAliases : Dict String (List ModuleName)
, importedFunctions : Dict String (List String)
, importedTypes : Dict String (List String)
, dependenciesModules : Dict String Elm.Docs.Module
, modules : Dict ModuleName Elm.Docs.Module
, exposesEverything : Bool
, exposedNames : Dict String Range
, exposedUnions : List Elm.Docs.Union
, exposedAliases : List Elm.Docs.Alias
, exposedValues : List Elm.Docs.Value
, exposedBinops : List Elm.Docs.Binop
}
{-| Create an initial `moduleContext` for the scope for module rules. Use this value when
initializing the scope inside your `initialModuleContext`.
Using [`Scope.addModuleVisitors`](#addModuleVisitors) requires your module context
to be a record with a `scope : Scope.ModuleContext` field.
type alias ModuleContext =
{ scope : Scope.ModuleContext
-- ...other fields
}
initialModuleContext : ModuleContext
initialModuleContext =
{ scope = Scope.initialModuleContext
-- ...other fields
}
**NOTE**: If you are building a project rule, don't use this value inside your
`fromProjectToModule` function. Instead, use [`Scope.fromProjectToModule`](#fromProjectToModule).
-}
initialModuleContext : ModuleContext
initialModuleContext =
fromProjectToModule initialProjectContext
-- PROJECT VISITOR
{-| The context the Scope visitors will collect and store in your `projectContext`.
-}
type ProjectContext
= ProjectContext InnerProjectContext
type alias InnerProjectContext =
{ dependenciesModules : Dict String Elm.Docs.Module
, modules : Dict ModuleName Elm.Docs.Module
}
{-| Create an initial `projectContext` for the scope for project rules. Use this value when
initializing the scope inside your `initialProjectContext`.
Using [`Scope.addProjectVisitors`](#addProjectVisitors) requires your project context
to be a record with a `scope : Scope.ProjectContext` field.
Look at the [`Scope.addProjectVisitors`](#addProjectVisitors) example for the
wiring logic related to `withModuleContext` that you can copy-paste then adapt to your needs.
type alias ProjectContext =
{ scope : Scope.ProjectContext
-- ...other fields
}
initialProjectContext : ProjectContext
initialProjectContext =
{ scope = Scope.initialProjectContext
, otherFields = ()
}
-}
initialProjectContext : ProjectContext
initialProjectContext =
ProjectContext
{ dependenciesModules = Dict.empty
, modules = Dict.empty
}
{-| Get a `Scope.ModuleContext` from a `Scope.ProjectContext`. Use this in your own
`fromProjectToModule`.
fromProjectToModule : Rule.ModuleKey -> Node ModuleName -> ProjectContext -> ModuleContext
fromProjectToModule moduleKey moduleName projectContext =
{ scope = Scope.fromProjectToModule projectContext.scope
-- ...other fields
}
-}
fromProjectToModule : ProjectContext -> ModuleContext
fromProjectToModule (ProjectContext projectContext) =
{ scopes = nonemptyList_fromElement emptyScope
, localTypes = Set.empty
, importAliases = Dict.empty
, importedFunctions = Dict.empty
, importedTypes = Dict.empty
, dependenciesModules = projectContext.dependenciesModules
, modules = projectContext.modules
, exposesEverything = False
, exposedNames = Dict.empty
, exposedUnions = []
, exposedAliases = []
, exposedValues = []
, exposedBinops = []
}
|> registerPrelude
|> ModuleContext
{-| Get a `Scope.ProjectContext` from a `Scope.ModuleContext`. Use this in your own
`fromModuleToProject`.
fromModuleToProject : Rule.ModuleKey -> Node ModuleName -> ModuleContext -> ProjectContext
fromModuleToProject moduleKey moduleName moduleContext =
{ scope = Scope.fromModuleToProject moduleName moduleContext.scope
-- ...other fields
}
-}
fromModuleToProject : Node ModuleName -> ModuleContext -> ProjectContext
fromModuleToProject moduleName (ModuleContext moduleContext) =
ProjectContext
{ dependenciesModules = Dict.empty
, modules =
Dict.singleton (Node.value moduleName)
{ name = String.join "." (Node.value moduleName)
, comment = ""
, unions = moduleContext.exposedUnions
, aliases = moduleContext.exposedAliases
, values = moduleContext.exposedValues
, binops = moduleContext.exposedBinops
}
}
{-| Fold `Scope.ProjectContext`s. Use this in your own `foldProjectContexts`.
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts newContext previousContext =
{ scope = Scope.foldProjectContexts newContext.scope previousContext.scope
-- ...other fields
}
-}
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts (ProjectContext newContext) (ProjectContext previousContext) =
ProjectContext
{ dependenciesModules = previousContext.dependenciesModules
, modules = Dict.union previousContext.modules newContext.modules
}
-- SCOPE
type alias Scope =
{ names : Dict String VariableInfo
, cases : List ( Node Expression, Dict String VariableInfo )
, caseToExit : Node Expression
}
emptyScope : Scope
emptyScope =
{ names = Dict.empty
, cases = []
, caseToExit = Node Range.emptyRange (Expression.Literal "root")
}
{-| Adds the scope visitors to your project rule.
Using `addProjectVisitors` requires your project context
to be a record with a `scope : Scope.ProjectContext` field.
**NOTE**: You need to use this function **before** your other visitors, otherwise
the scope may not be up-to-date when you access it.
Adding project visitors adds a bit of wiring, but you can pretty much copy-paste
the code below and adapt it to your needs.
rule : Rule
rule =
Rule.newProjectRuleSchema "RuleName" initialProjectContext
|> Scope.addProjectVisitors
-- |> addOtherVisitors
|> Rule.withModuleContext
{ fromProjectToModule = fromProjectToModule
, fromModuleToProject = fromModuleToProject
, foldProjectContexts = foldProjectContexts
}
|> Rule.fromProjectRuleSchema
type alias ProjectContext =
{ scope : Scope.ProjectContext
-- ...other fields
}
type alias ModuleContext =
{ scope : Scope.ModuleContext
-- ...other fields
}
initialProjectContext : ProjectContext
initialProjectContext =
{ scope = Scope.initialProjectContext
-- ...other fields
}
fromProjectToModule : Rule.ModuleKey -> Node ModuleName -> ProjectContext -> ModuleContext
fromProjectToModule moduleKey moduleName projectContext =
{ scope = Scope.fromProjectToModule projectContext.scope
-- ...other fields
}
fromModuleToProject : Rule.ModuleKey -> Node ModuleName -> ModuleContext -> ProjectContext
fromModuleToProject moduleKey moduleName moduleContext =
{ scope = Scope.fromModuleToProject moduleName moduleContext.scope
-- ...other fields
}
foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts newContext previousContext =
{ scope = Scope.foldProjectContexts newContext.scope previousContext.scope
-- ...other fields
}
-}
addProjectVisitors :
Rule.ProjectRuleSchema { schemaState | canAddModuleVisitor : () } { projectContext | scope : ProjectContext } { moduleContext | scope : ModuleContext }
-> Rule.ProjectRuleSchema { schemaState | canAddModuleVisitor : (), hasAtLeastOneVisitor : (), withModuleContext : Rule.Required } { projectContext | scope : ProjectContext } { moduleContext | scope : ModuleContext }
addProjectVisitors schema =
schema
|> Rule.withContextFromImportedModules
|> Rule.withDependenciesProjectVisitor (mapInnerProjectContext dependenciesProjectVisitor)
|> Rule.withModuleVisitor internalAddModuleVisitors
addProjectVisitors_New :
Rule3.ProjectRuleSchema { schemaState | canAddModuleVisitor : () } { projectContext | scope : ProjectContext } { moduleContext | scope : ModuleContext }
-> Rule3.ProjectRuleSchema { schemaState | canAddModuleVisitor : (), hasAtLeastOneVisitor : (), withModuleContext : Rule.Required } { projectContext | scope : ProjectContext } { moduleContext | scope : ModuleContext }
addProjectVisitors_New schema =
schema
|> Rule3.withContextFromImportedModules
|> Rule3.withDependenciesProjectVisitor (mapInnerProjectContext dependenciesProjectVisitor)
|> Rule3.withModuleVisitor internalAddModuleVisitors_New
{-| Adds the scope visitors to your module rule.
Using `addModuleVisitors` requires your module context
to be a record with a `scope : Scope.ModuleContext` field.
**NOTE**: You need to use this function **before** your other visitors, otherwise
the scope may not be up-to-date when you access it.
rule : Rule
rule =
Rule.newModuleRuleSchema "RuleName" initialContext
-- Scope.addModuleVisitors needs to be added before your own visitors
|> Scope.addModuleVisitors
-- |> addOtherVisitors
|> Rule.fromModuleRuleSchema
type alias Context =
-- Scope expects a context with a record, containing the `scope` field.
{ scope : Scope.ModuleContext
-- ...other fields
}
initialContext : Context
initialContext =
{ scope = Scope.initialModuleContext
-- ...other fields
}
-}
addModuleVisitors :
Rule.ModuleRuleSchema { schemaState | canCollectProjectData : () } { moduleContext | scope : ModuleContext }
-> Rule.ModuleRuleSchema { schemaState | canCollectProjectData : (), hasAtLeastOneVisitor : () } { moduleContext | scope : ModuleContext }
addModuleVisitors schema =
schema
|> Rule.withDependenciesModuleVisitor (mapInnerModuleContext dependenciesModuleVisitor)
|> internalAddModuleVisitors
internalAddModuleVisitors : Rule.ModuleRuleSchema schemaState { moduleContext | scope : ModuleContext } -> Rule.ModuleRuleSchema { schemaState | hasAtLeastOneVisitor : () } { moduleContext | scope : ModuleContext }
internalAddModuleVisitors schema =
schema
|> Rule.withModuleDefinitionVisitor
(mapInnerModuleContext moduleDefinitionVisitor |> pairWithNoErrors)
|> Rule.withImportVisitor
(mapInnerModuleContext importVisitor |> pairWithNoErrors)
|> Rule.withDeclarationListVisitor
(mapInnerModuleContext declarationListVisitor |> pairWithNoErrors)
|> Rule.withDeclarationEnterVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> declarationEnterVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule.withDeclarationExitVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> declarationExitVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule.withExpressionEnterVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> popScopeEnter visitedElement
|> expressionEnterVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule.withExpressionExitVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> popScopeExit visitedElement
|> expressionExitVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
internalAddModuleVisitors_New : Rule3.ModuleRuleSchema schemaState { moduleContext | scope : ModuleContext } -> Rule3.ModuleRuleSchema { schemaState | hasAtLeastOneVisitor : () } { moduleContext | scope : ModuleContext }
internalAddModuleVisitors_New schema =
schema
|> Rule3.withModuleDefinitionVisitor
(mapInnerModuleContext moduleDefinitionVisitor |> pairWithNoErrors)
|> Rule3.withImportVisitor
(mapInnerModuleContext importVisitor |> pairWithNoErrors)
|> Rule3.withDeclarationListVisitor
(mapInnerModuleContext declarationListVisitor |> pairWithNoErrors)
|> Rule3.withDeclarationEnterVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> declarationEnterVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule3.withDeclarationExitVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> declarationExitVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule3.withExpressionEnterVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> popScopeEnter visitedElement
|> expressionEnterVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
|> Rule3.withExpressionExitVisitor
(\visitedElement outerContext ->
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> popScopeExit visitedElement
|> expressionExitVisitor visitedElement
in
( [], { outerContext | scope = ModuleContext innerContext } )
)
mapInnerProjectContext : (visitedElement -> InnerProjectContext -> InnerProjectContext) -> visitedElement -> { projectContext | scope : ProjectContext } -> ( List nothing, { projectContext | scope : ProjectContext } )
mapInnerProjectContext visitor visitedElement outerContext =
let
innerContext : InnerProjectContext
innerContext =
outerContext.scope
|> unboxProjectContext
|> visitor visitedElement
in
( [], { outerContext | scope = ProjectContext innerContext } )
mapInnerModuleContext : (visitedElement -> InnerModuleContext -> InnerModuleContext) -> visitedElement -> { moduleContext | scope : ModuleContext } -> { moduleContext | scope : ModuleContext }
mapInnerModuleContext visitor visitedElement outerContext =
let
innerContext : InnerModuleContext
innerContext =
outerContext.scope
|> unboxModule
|> visitor visitedElement
in
{ outerContext | scope = ModuleContext innerContext }
pairWithNoErrors : (visited -> context -> context) -> visited -> context -> ( List nothing, context )
pairWithNoErrors fn visited context =
( [], fn visited context )
-- DEPENDENCIES
dependenciesProjectVisitor : Dict String Dependency -> InnerProjectContext -> InnerProjectContext
dependenciesProjectVisitor dependencies innerContext =
internalDependenciesVisitor dependencies innerContext
dependenciesModuleVisitor : Dict String Dependency -> InnerModuleContext -> InnerModuleContext
dependenciesModuleVisitor dependencies innerContext =
internalDependenciesVisitor dependencies innerContext
|> registerPrelude
internalDependenciesVisitor : Dict String Dependency -> { context | dependenciesModules : Dict String Elm.Docs.Module } -> { context | dependenciesModules : Dict String Elm.Docs.Module }
internalDependenciesVisitor dependencies innerContext =
let
dependenciesModules : Dict String Elm.Docs.Module
dependenciesModules =
dependencies
|> Dict.values
|> List.concatMap Dependency.modules
|> List.map (\dependencyModule -> ( dependencyModule.name, dependencyModule ))
|> Dict.fromList
in
{ innerContext | dependenciesModules = dependenciesModules }
registerPrelude : InnerModuleContext -> InnerModuleContext
registerPrelude innerContext =
List.foldl registerImportExposed innerContext elmCorePrelude
elmCorePrelude : List Import
elmCorePrelude =
let
explicit : List TopLevelExpose -> Maybe Exposing
explicit exposed =
exposed
|> List.map (Node Range.emptyRange)
|> Exposing.Explicit
|> Just
in
-- These are the default imports implicitly added by the Elm compiler
-- https://package.elm-lang.org/packages/elm/core/latest
[ createFakeImport
{ moduleName = [ "Basics" ]
, moduleAlias = Nothing
, exposingList = Just <| Exposing.All Range.emptyRange
}
, createFakeImport
{ moduleName = [ "List" ]
, moduleAlias = Nothing
, exposingList =
explicit
[ Exposing.TypeExpose { name = "List", open = Nothing }
, Exposing.InfixExpose "::"
]
}
, createFakeImport
{ moduleName = [ "Maybe" ]
, moduleAlias = Nothing
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Maybe", open = Just Range.emptyRange }
]
}
, createFakeImport
{ moduleName = [ "Result" ]
, moduleAlias = Nothing
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Result", open = Just Range.emptyRange }
]
}
, createFakeImport
{ moduleName = [ "String" ]
, moduleAlias = Nothing
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Char", open = Nothing }
]
}
, createFakeImport
{ moduleName = [ "Char" ]
, moduleAlias = Nothing
, exposingList = Nothing
}
, createFakeImport
{ moduleName = [ "Tuple" ]
, moduleAlias = Nothing
, exposingList = Nothing
}
, createFakeImport
{ moduleName = [ "Debug" ]
, moduleAlias = Nothing
, exposingList = Nothing
}
, createFakeImport
{ moduleName = [ "Platform" ]
, moduleAlias = Nothing
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Program", open = Nothing }
]
}
, createFakeImport
{ moduleName = [ "Platform", "Cmd" ]
, moduleAlias = Just "Cmd"
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Cmd", open = Nothing }
]
}
, createFakeImport
{ moduleName = [ "Platform", "Sub" ]
, moduleAlias = Just "Sub"
, exposingList =
explicit
[ Exposing.TypeExpose { name = "Sub", open = Nothing }
]
}
]
createFakeImport : { moduleName : List String, exposingList : Maybe Exposing, moduleAlias : Maybe String } -> Import
createFakeImport { moduleName, moduleAlias, exposingList } =
{ moduleName = Node Range.emptyRange moduleName
, moduleAlias = moduleAlias |> Maybe.map (List.singleton >> Node Range.emptyRange)
, exposingList = exposingList |> Maybe.map (Node Range.emptyRange)
}
declarationListVisitor : List (Node Declaration) -> InnerModuleContext -> InnerModuleContext
declarationListVisitor declarations innerContext =
List.foldl registerDeclaration innerContext declarations
registerDeclaration : Node Declaration -> InnerModuleContext -> InnerModuleContext
registerDeclaration declaration innerContext =
case Node.value declaration of
Declaration.FunctionDeclaration function ->
let
nameNode : Node String
nameNode =
function.declaration
|> Node.value
|> .name
in
innerContext
|> addToScope
{ variableType = TopLevelVariable
, node = nameNode
}
|> registerIfExposed (registerExposedValue function) (Node.value nameNode)
Declaration.AliasDeclaration alias_ ->
{ innerContext | localTypes = Set.insert (Node.value alias_.name) innerContext.localTypes }
|> addToScope
{ variableType = TopLevelVariable
, node = alias_.name
}
|> registerIfExposed registerExposedTypeAlias (Node.value alias_.name)
Declaration.CustomTypeDeclaration { name, constructors } ->
List.foldl
(\constructor innerContext_ ->
let
constructorName : Node String
constructorName =
constructor |> Node.value |> .name
in
addToScope
{ variableType = CustomTypeConstructor
, node = constructorName
}
innerContext_
)
{ innerContext | localTypes = Set.insert (Node.value name) innerContext.localTypes }
constructors
|> registerIfExposed (registerExposedCustomType constructors) (Node.value name)
Declaration.PortDeclaration signature ->
addToScope
{ variableType = Port
, node = signature.name
}
innerContext
Declaration.InfixDeclaration _ ->
-- TODO Support operators
-- I could use help adding this.
innerContext
Declaration.Destructuring _ _ ->
-- Not possible in 0.19 code
innerContext
addToScope : { variableType : VariableType, node : Node String } -> InnerModuleContext -> InnerModuleContext
addToScope variableData innerContext =
let
newScopes : Nonempty Scope
newScopes =
registerVariable
variableData
(Node.value variableData.node)
innerContext.scopes
in
{ innerContext | scopes = newScopes }
registerExposedValue : Expression.Function -> String -> InnerModuleContext -> InnerModuleContext
registerExposedValue function name innerContext =
{ innerContext
| exposedValues =
{ name = name
, comment =
case Maybe.map Node.value function.documentation of
Just str ->
str
Nothing ->
""
, tipe = convertTypeSignatureToDocsType innerContext function.signature
}
:: innerContext.exposedValues
}
registerExposedCustomType : List (Node Elm.Syntax.Type.ValueConstructor) -> String -> InnerModuleContext -> InnerModuleContext
registerExposedCustomType constructors name innerContext =
{ innerContext
| exposedUnions =
{ name = name
, comment = ""
-- TODO
, args = []
, tags =
constructors
-- TODO Constructor args?
|> List.map (\constructor -> ( Node.value (Node.value constructor).name, [] ))
}
:: innerContext.exposedUnions
}
registerExposedTypeAlias : String -> InnerModuleContext -> InnerModuleContext
registerExposedTypeAlias name innerContext =
{ innerContext
| exposedAliases =
{ name = name
, comment = ""
, args = []
, tipe = Elm.Type.Tuple []
}
:: innerContext.exposedAliases
}
registerIfExposed : (String -> InnerModuleContext -> InnerModuleContext) -> String -> InnerModuleContext -> InnerModuleContext
registerIfExposed registerFn name innerContext =
if innerContext.exposesEverything || Dict.member name innerContext.exposedNames then
registerFn name innerContext
else
innerContext
convertTypeSignatureToDocsType : InnerModuleContext -> Maybe (Node Signature) -> Elm.Type.Type
convertTypeSignatureToDocsType innerContext maybeSignature =
case maybeSignature |> Maybe.map (Node.value >> .typeAnnotation) of
Just typeAnnotation ->
syntaxTypeAnnotationToDocsType innerContext typeAnnotation
Nothing ->
Elm.Type.Tuple []
syntaxTypeAnnotationToDocsType : InnerModuleContext -> Node TypeAnnotation -> Elm.Type.Type
syntaxTypeAnnotationToDocsType innerContext (Node _ typeAnnotation) =
case typeAnnotation of
TypeAnnotation.GenericType name ->
Elm.Type.Var name
TypeAnnotation.Typed (Node _ ( moduleName, typeName )) typeParameters ->
let
realModuleName : List String
realModuleName =
moduleNameForType (ModuleContext innerContext) typeName moduleName
in
Elm.Type.Type (String.join "." realModuleName ++ "." ++ typeName) (List.map (syntaxTypeAnnotationToDocsType innerContext) typeParameters)
TypeAnnotation.Unit ->
Elm.Type.Tuple []
TypeAnnotation.Tupled list ->
Elm.Type.Tuple (List.map (syntaxTypeAnnotationToDocsType innerContext) list)
TypeAnnotation.Record updates ->
Elm.Type.Record (recordUpdateToDocsType innerContext updates) Nothing
TypeAnnotation.GenericRecord (Node _ generic) (Node _ updates) ->
Elm.Type.Record (recordUpdateToDocsType innerContext updates) (Just generic)
TypeAnnotation.FunctionTypeAnnotation left right ->
Elm.Type.Lambda
(syntaxTypeAnnotationToDocsType innerContext left)
(syntaxTypeAnnotationToDocsType innerContext right)
recordUpdateToDocsType : InnerModuleContext -> List (Node TypeAnnotation.RecordField) -> List ( String, Elm.Type.Type )
recordUpdateToDocsType innerContext updates =
List.map
(\(Node _ ( name, typeAnnotation )) ->
( Node.value name
, syntaxTypeAnnotationToDocsType innerContext typeAnnotation
)
)
updates
registerVariable : VariableInfo -> String -> Nonempty Scope -> Nonempty Scope
registerVariable variableInfo name scopes =
nonemptyList_mapHead
(\scope -> { scope | names = Dict.insert name variableInfo scope.names })
scopes
updateScope : InnerModuleContext -> Nonempty Scope -> InnerModuleContext
updateScope innerContext scopes =
{ innerContext | scopes = scopes }
-- MODULE DEFINITION VISITOR
moduleDefinitionVisitor : Node Module -> InnerModuleContext -> InnerModuleContext
moduleDefinitionVisitor node innerContext =
case Module.exposingList (Node.value node) of
Exposing.All _ ->
{ innerContext | exposesEverything = True }
Exposing.Explicit list ->
{ innerContext | exposedNames = exposedElements list }
exposedElements : List (Node Exposing.TopLevelExpose) -> Dict String Range
exposedElements nodes =
nodes
|> List.filterMap
(\node ->
case Node.value node of
Exposing.FunctionExpose name ->
Just ( name, Node.range node )
Exposing.TypeOrAliasExpose name ->
Just ( name, Node.range node )
Exposing.TypeExpose { name } ->
Just ( name, Node.range node )
Exposing.InfixExpose name ->
Nothing
)
|> Dict.fromList
-- IMPORT VISITOR
importVisitor : Node Import -> InnerModuleContext -> InnerModuleContext
importVisitor (Node _ import_) innerContext =
innerContext
|> registerImportAlias import_
|> registerImportExposed import_
registerImportAlias : Import -> InnerModuleContext -> InnerModuleContext
registerImportAlias import_ innerContext =
case import_.moduleAlias of
Nothing ->
let
moduleName : List String
moduleName =
Node.value import_.moduleName
in
case moduleName of
singleSegmentModuleName :: [] ->
{ innerContext
| importAliases =
Dict.update
singleSegmentModuleName
(\previousValue -> Just <| moduleName :: Maybe.withDefault [] previousValue)
innerContext.importAliases
}
_ ->
innerContext
Just alias_ ->
{ innerContext
| importAliases =
Dict.update
(Node.value alias_ |> getModuleName)
(\previousValue -> Just <| Node.value import_.moduleName :: Maybe.withDefault [] previousValue)
innerContext.importAliases
}
registerImportExposed : Import -> InnerModuleContext -> InnerModuleContext
registerImportExposed import_ innerContext =
case import_.exposingList |> Maybe.map Node.value of
Nothing ->
innerContext
Just exposing_ ->
let
moduleName : List String
moduleName =
Node.value import_.moduleName
module_ : Elm.Docs.Module
module_ =
(case Dict.get (getModuleName moduleName) innerContext.dependenciesModules of
Just m ->
Just m
Nothing ->
Dict.get moduleName innerContext.modules
)
|> Maybe.withDefault
{ name = getModuleName moduleName
, comment = ""
, unions = []
, values = []
, aliases = []
, binops = []
}
in
case exposing_ of
Exposing.All _ ->
let
nameWithModuleName : { r | name : String } -> ( String, List String )
nameWithModuleName { name } =
( name, moduleName )
exposedValues : Dict String (List String)
exposedValues =
List.concat
[ List.concatMap
(\union ->
List.map (\( name, _ ) -> ( name, moduleName )) union.tags
)
module_.unions
, List.map nameWithModuleName module_.values
, List.map nameWithModuleName module_.aliases
, List.map nameWithModuleName module_.binops
]
|> Dict.fromList
exposedTypes : Dict String (List String)
exposedTypes =
List.concat
[ List.map nameWithModuleName module_.unions
, List.map nameWithModuleName module_.aliases
]
|> Dict.fromList
in
{ innerContext
| importedFunctions = Dict.union innerContext.importedFunctions exposedValues
, importedTypes = Dict.union innerContext.importedTypes exposedTypes
}
Exposing.Explicit topLevelExposeList ->
let
exposedValues : Dict String (List String)
exposedValues =
topLevelExposeList
|> List.concatMap (valuesFromExposingList module_)
|> List.map (\name -> ( name, moduleName ))
|> Dict.fromList
exposedTypes : Dict String (List String)
exposedTypes =
topLevelExposeList
|> List.filterMap typesFromExposingList
|> List.map (\name -> ( name, moduleName ))
|> Dict.fromList
in
{ innerContext
| importedFunctions = Dict.union innerContext.importedFunctions exposedValues
, importedTypes = Dict.union innerContext.importedTypes exposedTypes
}
valuesFromExposingList : Elm.Docs.Module -> Node TopLevelExpose -> List String
valuesFromExposingList module_ topLevelExpose =
case Node.value topLevelExpose of
Exposing.InfixExpose operator ->
[ operator ]
Exposing.FunctionExpose function ->
[ function ]
Exposing.TypeOrAliasExpose name ->
if List.any (\alias_ -> alias_.name == name) module_.aliases then
[ name ]
else
-- Type is a custom type
[]
Exposing.TypeExpose { name, open } ->
case open of
Just _ ->
module_.unions
|> List.filter (\union -> union.name == name)
|> List.concatMap .tags
|> List.map Tuple.first
Nothing ->
[]
typesFromExposingList : Node TopLevelExpose -> Maybe String
typesFromExposingList topLevelExpose =
case Node.value topLevelExpose of
Exposing.InfixExpose _ ->
Nothing
Exposing.FunctionExpose _ ->
Nothing
Exposing.TypeOrAliasExpose name ->
Just name
Exposing.TypeExpose { name } ->
Just name
unboxProjectContext : ProjectContext -> InnerProjectContext
unboxProjectContext (ProjectContext context) =
context
unboxModule : ModuleContext -> InnerModuleContext
unboxModule (ModuleContext context) =
context
type alias VariableInfo =
{ variableType : VariableType
, node : Node String
}
type VariableType
= TopLevelVariable
| CustomTypeConstructor
| FunctionParameter
| LetVariable
| PatternVariable
| Port
declarationEnterVisitor : Node Declaration -> InnerModuleContext -> InnerModuleContext
declarationEnterVisitor node context =
case Node.value node of
Declaration.FunctionDeclaration function ->
let
newScope : Scope
newScope =
{ emptyScope | names = parameters <| .arguments <| Node.value function.declaration }
in
context.scopes
|> nonemptyList_cons newScope
|> updateScope context
_ ->
context
declarationExitVisitor : Node Declaration -> InnerModuleContext -> InnerModuleContext
declarationExitVisitor node context =
case Node.value node of
Declaration.FunctionDeclaration _ ->
{ context | scopes = nonemptyList_pop context.scopes }
_ ->
context
parameters : List (Node Pattern) -> Dict String VariableInfo
parameters patterns =
List.concatMap collectNamesFromPattern patterns
|> List.map
(\node ->
( Node.value node
, { node = node
, variableType = FunctionParameter
}
)
)
|> Dict.fromList
collectNamesFromPattern : Node Pattern -> List (Node String)
collectNamesFromPattern pattern =
case Node.value pattern of
Pattern.AllPattern ->
[]
Pattern.UnitPattern ->
[]
Pattern.CharPattern _ ->
[]
Pattern.StringPattern _ ->
[]
Pattern.IntPattern _ ->
[]
Pattern.HexPattern _ ->
[]
Pattern.FloatPattern _ ->
[]
Pattern.TuplePattern subPatterns ->
List.concatMap collectNamesFromPattern subPatterns
Pattern.RecordPattern names ->
names
Pattern.UnConsPattern left right ->
List.concatMap collectNamesFromPattern [ left, right ]
Pattern.ListPattern subPatterns ->
List.concatMap collectNamesFromPattern subPatterns
Pattern.VarPattern name ->
[ Node (Node.range pattern) name ]
Pattern.NamedPattern _ subPatterns ->
List.concatMap collectNamesFromPattern subPatterns
Pattern.AsPattern subPattern alias_ ->
alias_ :: collectNamesFromPattern subPattern
Pattern.ParenthesizedPattern subPattern ->
collectNamesFromPattern subPattern
popScopeEnter : Node Expression -> InnerModuleContext -> InnerModuleContext
popScopeEnter node context =
let
currentScope : Scope
currentScope =
nonemptyList_head context.scopes
caseExpression : Maybe ( Node Expression, Dict String VariableInfo )
caseExpression =
findInList (\( expressionNode, _ ) -> node == expressionNode) currentScope.cases
in
case caseExpression of
Nothing ->
context
Just ( _, names ) ->
{ context | scopes = nonemptyList_cons { emptyScope | names = names, caseToExit = node } context.scopes }
popScopeExit : Node Expression -> InnerModuleContext -> InnerModuleContext
popScopeExit node context =
let
currentScope : Scope
currentScope =
nonemptyList_head context.scopes
in
if node == currentScope.caseToExit then
{ context | scopes = nonemptyList_pop context.scopes }
else
context
expressionEnterVisitor : Node Expression -> InnerModuleContext -> InnerModuleContext
expressionEnterVisitor node context =
case Node.value node of
Expression.LetExpression { declarations, expression } ->
List.foldl
(\declaration scopes ->
case Node.value declaration of
Expression.LetFunction function ->
let
nameNode : Node String
nameNode =
function.declaration
|> Node.value
|> .name
in
registerVariable
{ variableType = LetVariable, node = nameNode }
-- TODO Check if the name as 2nd arg is not redundant with the 1st argument's node field
(Node.value nameNode)
scopes
Expression.LetDestructuring _ _ ->
scopes
)
(nonemptyList_cons emptyScope context.scopes)
declarations
|> updateScope context
Expression.CaseExpression caseBlock ->
let
cases : List ( Node Expression, Dict String VariableInfo )
cases =
caseBlock.cases
|> List.map
(\( pattern, expression ) ->
( expression
, collectNamesFromPattern pattern
|> List.map
(\node_ ->
( Node.value node_
, { node = node_
, variableType = PatternVariable
}
)
)
|> Dict.fromList
)
)
in
{ context | scopes = nonemptyList_mapHead (\scope -> { scope | cases = cases }) context.scopes }
_ ->
context
expressionExitVisitor : Node Expression -> InnerModuleContext -> InnerModuleContext
expressionExitVisitor node context =
case Node.value node of
Expression.LetExpression _ ->
{ context | scopes = nonemptyList_pop context.scopes }
Expression.CaseExpression _ ->
{ context | scopes = nonemptyList_mapHead (\scope -> { scope | cases = [] }) context.scopes }
_ ->
context
findInList : (a -> Bool) -> List a -> Maybe a
findInList predicate list =
case list of
[] ->
Nothing
a :: rest ->
if predicate a then
Just a
else
findInList predicate rest
-- ACCESS
{-| Get the name of the module where a value was defined.
A value can be either a function, a constant, a custom type constructor or a type alias (used as a function).
- The second argument (`String`) is the name of the value
- The third argument (`List String`) is the module name that was used next to the value's name where you found it
If the element was defined in the current module, then the result will be `[]`.
expressionVisitor : Node Expression -> Context -> ( List (Error {}), Context )
expressionVisitor node context =
case Node.value node of
Expression.FunctionOrValue moduleName "button" ->
if Scope.moduleNameForValue context.scope "button" moduleName == [ "Html" ] then
( [ createError node ], context )
else
( [], context )
_ ->
( [], context )
-}
moduleNameForValue : ModuleContext -> String -> List String -> List String
moduleNameForValue (ModuleContext context) valueName moduleName =
case moduleName of
[] ->
if isInScope valueName context.scopes then
[]
else
Dict.get valueName context.importedFunctions
|> Maybe.withDefault []
_ :: [] ->
case Dict.get (getModuleName moduleName) context.importAliases of
Just [ aliasedModuleName ] ->
aliasedModuleName
Just aliases ->
case
findInList
(\aliasedModuleName ->
case Dict.get aliasedModuleName context.modules of
Just module_ ->
isValueDeclaredInModule valueName module_
Nothing ->
False
)
aliases
of
Just aliasedModuleName ->
aliasedModuleName
Nothing ->
List.head aliases
|> Maybe.withDefault moduleName
Nothing ->
moduleName
_ ->
moduleName
{-| Get the name of the module where a type was defined.
A type can be either a custom type or a type alias.
- The second argument (`String`) is the name of the type
- The third argument (`List String`) is the module name that was used next to the type name where you found it
-}
moduleNameForType : ModuleContext -> String -> List String -> List String
moduleNameForType (ModuleContext context) typeName moduleName =
case moduleName of
[] ->
if Set.member typeName context.localTypes then
[]
else
Dict.get typeName context.importedTypes
|> Maybe.withDefault []
_ :: [] ->
case Dict.get (getModuleName moduleName) context.importAliases of
Just [ aliasedModuleName ] ->
aliasedModuleName
Just aliases ->
case
findInList
(\aliasedModuleName ->
case Dict.get aliasedModuleName context.modules of
Just module_ ->
isTypeDeclaredInModule typeName module_
Nothing ->
False
)
aliases
of
Just aliasedModuleName ->
aliasedModuleName
Nothing ->
List.head aliases
|> Maybe.withDefault moduleName
Nothing ->
moduleName
_ ->
moduleName
isValueDeclaredInModule : String -> Elm.Docs.Module -> Bool
isValueDeclaredInModule valueName module_ =
List.any (.name >> (==) valueName) module_.values
|| List.any (.name >> (==) valueName) module_.aliases
|| List.any
(\union -> List.any (Tuple.first >> (==) valueName) union.tags)
module_.unions
isTypeDeclaredInModule : String -> Elm.Docs.Module -> Bool
isTypeDeclaredInModule typeName module_ =
List.any (.name >> (==) typeName) module_.aliases
|| List.any (.name >> (==) typeName) module_.unions
isInScope : String -> Nonempty Scope -> Bool
isInScope name scopes =
nonemptyList_any (.names >> Dict.member name) scopes
-- MISC
getModuleName : List String -> String
getModuleName name =
String.join "." name
{- INLINED NONEMPTYLIST
Copied contents of mgold/elm-nonempty-list, and trimmed down unused functions.
This is to avoid dependency conflicts when mgold/elm-nonempty-list would release a new major version.
A list that cannot be empty. The head and tail can be accessed without Maybes. Most other list functions are
available.
# Definition
@docs Nonempty
# Create
@docs fromElement
# Access
@docs head
# Inspect
@docs any
# Convert
@docs cons, pop
# Map
@docs mapHead
# Original copyright notice
Copyright (c) 2015, Max Goldstein
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Max Goldstein nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
{-| The Nonempty type. If you have both a head and tail, you can construct a
nonempty list directly. Otherwise use the helpers below instead.
-}
type Nonempty a
= Nonempty a (List a)
{-| Create a singleton list with the given element.
-}
nonemptyList_fromElement : a -> Nonempty a
nonemptyList_fromElement x =
Nonempty x []
{-| Return the head of the list.
-}
nonemptyList_head : Nonempty a -> a
nonemptyList_head (Nonempty x _) =
x
{-| Determine if any elements satisfy the predicate.
-}
nonemptyList_any : (a -> Bool) -> Nonempty a -> Bool
nonemptyList_any f (Nonempty x xs) =
f x || List.any f xs
{-| Add another element as the head of the list, pushing the previous head to the tail.
-}
nonemptyList_cons : a -> Nonempty a -> Nonempty a
nonemptyList_cons y (Nonempty x xs) =
Nonempty y (x :: xs)
{-| Pop and discard the head, or do nothing for a singleton list. Useful if you
want to exhaust a list but hang on to the last item indefinitely.
pop (Nonempty 3 [ 2, 1 ]) --> Nonempty 2 [1]
pop (Nonempty 1 []) --> Nonempty 1 []
-}
nonemptyList_pop : Nonempty a -> Nonempty a
nonemptyList_pop (Nonempty x xs) =
case xs of
[] ->
Nonempty x xs
y :: ys ->
Nonempty y ys
{-| Map the head to a value of the same type
-}
nonemptyList_mapHead : (a -> a) -> Nonempty a -> Nonempty a
nonemptyList_mapHead fn (Nonempty x xs) =
Nonempty (fn x) xs