FnReport-2.elm

module FnReport exposing (rule)

{-| Run with

elm-review ./src/Well/I18n.elm --extract --report=json --rules FnReport | jq -r '.extracts.FnReport'

-}

import Dict
import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.Expression as Expression
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node)
import Elm.Syntax.Pattern as Pattern
import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..))
import Json.Encode as Encode
import Review.ModuleNameLookupTable exposing (ModuleNameLookupTable)
import Review.Rule as Rule exposing (Rule)


rule : Rule
rule =
    Rule.newProjectRuleSchema "FnReport" initContext
        |> Rule.withModuleVisitor
            moduleVisitor
        |> Rule.withModuleContextUsingContextCreator
            { fromProjectToModule = fromProjectToModule
            , fromModuleToProject = fromModuleToProject
            , foldProjectContexts = foldProjectContexts
            }
        |> Rule.withDataExtractor dataExtractor
        |> Rule.fromProjectRuleSchema


type alias ProjectContext =
    { functions : List SimplifiedFunction }


type alias ModuleContext =
    { lookupTable : ModuleNameLookupTable
    , moduleName : ModuleName
    , functions : List SimplifiedFunction
    }


type alias SimplifiedFunction =
    { name : String
    , result : Maybe String
    }


initContext : ProjectContext
initContext =
    { functions = [] }


fromProjectToModule : Rule.ContextCreator ProjectContext ModuleContext
fromProjectToModule =
    Rule.initContextCreator
        (\moduleName lookupTable _ ->
            { lookupTable = lookupTable
            , moduleName = moduleName
            , functions = []
            }
        )
        |> Rule.withModuleName
        |> Rule.withModuleNameLookupTable


fromModuleToProject : Rule.ContextCreator ModuleContext ProjectContext
fromModuleToProject =
    Rule.initContextCreator
        (\_ moduleContext ->
            { functions = moduleContext.functions }
        )
        |> Rule.withModuleName


foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts newContext previousContext =
    { functions = newContext.functions ++ previousContext.functions }


moduleVisitor :
    Rule.ModuleRuleSchema {} ModuleContext
    -> Rule.ModuleRuleSchema { hasAtLeastOneVisitor : () } ModuleContext
moduleVisitor schema =
    schema
        |> Rule.withDeclarationEnterVisitor declarationEnterVisitor


{-| Extract a simplified signature from a function annotation

The last argument in the list is the return type of the function.

-}
signatureList : Node TypeAnnotation -> List String
signatureList typeAnnotation =
    let
        go f typeAnn =
            case typeAnn |> Node.value of
                FunctionTypeAnnotation arg returnType ->
                    let
                        argStr =
                            case Node.value arg of
                                Typed argNodeModAndName _ ->
                                    argNodeModAndName |> Node.value |> Tuple.second

                                GenericType arg_ ->
                                    arg_

                                Record _ ->
                                    "{ .. }"

                                GenericRecord r _ ->
                                    "{ " ++ Node.value r ++ " | .. }"

                                Unit ->
                                    "()"

                                Tupled _ ->
                                    "(..)"

                                FunctionTypeAnnotation _ _ ->
                                    "f"
                    in
                    go (f << (::) argStr) returnType

                Typed arg _ ->
                    let
                        argName =
                            arg |> Node.value |> Tuple.second
                    in
                    f << (::) argName

                GenericType arg ->
                    f << (::) arg

                Record _ ->
                    f << (::) "{ .. }"

                GenericRecord r _ ->
                    f << (::) ("{ " ++ Node.value r ++ " | .. }")

                Unit ->
                    f

                Tupled _ ->
                    f << (::) "(..)"
    in
    go identity typeAnnotation []


{-| A "simple" message is a function with signature `Lang -> String`
-}
isSimpleMessage : Expression.Function -> Bool
isSimpleMessage =
    .signature
        >> Maybe.map Node.value
        >> Maybe.map (\signature -> signatureList signature.typeAnnotation)
        >> (\sigList ->
                case sigList of
                    Just [ "Lang", "String" ] ->
                        True

                    _ ->
                        False
           )


declarationEnterVisitor : Node Declaration -> ModuleContext -> ( List never, ModuleContext )
declarationEnterVisitor node context =
    let
        fns =
            case Node.value node of
                Declaration.FunctionDeclaration function ->
                    if isSimpleMessage function then
                        [ { name = function.declaration |> Node.value |> .name |> Node.value
                          , result =
                                function.declaration
                                    |> Node.value
                                    |> .expression
                                    |> Node.value
                                    |> (\exp ->
                                            case exp of
                                                Expression.CaseExpression { cases } ->
                                                    cases
                                                        |> List.filterMap
                                                            (\( patternNode, exprNode ) ->
                                                                case patternNode |> Node.value of
                                                                    Pattern.NamedPattern { name } _ ->
                                                                        if name == "En" then
                                                                            exprNode
                                                                                |> Node.value
                                                                                |> (\expr ->
                                                                                        case expr of
                                                                                            Expression.Literal str ->
                                                                                                Just str

                                                                                            _ ->
                                                                                                Nothing
                                                                                   )

                                                                        else
                                                                            Nothing

                                                                    _ ->
                                                                        Nothing
                                                            )

                                                _ ->
                                                    []
                                       )
                                    |> (\list ->
                                            -- There should be exactly one match for the "En" case
                                            case list of
                                                [ match ] ->
                                                    Just match

                                                _ ->
                                                    Nothing
                                       )
                          }
                        ]

                    else
                        []

                _ ->
                    []
    in
    ( [], { context | functions = fns ++ context.functions } )


dataExtractor : ProjectContext -> Encode.Value
dataExtractor projectContext =
    projectContext.functions
        |> List.map (\d -> ( d.name, d.result ))
        |> Dict.fromList
        |> Encode.dict identity (Maybe.map Encode.string >> Maybe.withDefault Encode.null)

FnReport.elm

module FnReport exposing (rule)

{-| Run with

elm-review ./src/I18n.elm --extract --report=json --rules FnReport | jq -r '.extracts.FnReport'

-}

import Elm.Syntax.Declaration as Declaration exposing (Declaration)
import Elm.Syntax.ModuleName exposing (ModuleName)
import Elm.Syntax.Node as Node exposing (Node)
import Elm.Syntax.TypeAnnotation exposing (TypeAnnotation(..))
import Json.Encode as Encode
import Review.ModuleNameLookupTable exposing (ModuleNameLookupTable)
import Review.Rule as Rule exposing (Rule)


rule : Rule
rule =
    Rule.newProjectRuleSchema "FnReport" initContext
        |> Rule.withModuleVisitor
            moduleVisitor
        |> Rule.withModuleContextUsingContextCreator
            { fromProjectToModule = fromProjectToModule
            , fromModuleToProject = fromModuleToProject
            , foldProjectContexts = foldProjectContexts
            }
        |> Rule.withDataExtractor dataExtractor
        |> Rule.fromProjectRuleSchema


type alias ProjectContext =
    { functions : List SimplifiedFunction }


type alias ModuleContext =
    { lookupTable : ModuleNameLookupTable
    , moduleName : ModuleName
    , functions : List SimplifiedFunction
    }


type alias SimplifiedFunction =
    { name : String
    , signature : List String
    }


initContext : ProjectContext
initContext =
    { functions = [] }


fromProjectToModule : Rule.ContextCreator ProjectContext ModuleContext
fromProjectToModule =
    Rule.initContextCreator
        (\moduleName lookupTable _ ->
            { lookupTable = lookupTable
            , moduleName = moduleName
            , functions = []
            }
        )
        |> Rule.withModuleName
        |> Rule.withModuleNameLookupTable


fromModuleToProject : Rule.ContextCreator ModuleContext ProjectContext
fromModuleToProject =
    Rule.initContextCreator
        (\_ moduleContext ->
            { functions = moduleContext.functions }
        )
        |> Rule.withModuleName


foldProjectContexts : ProjectContext -> ProjectContext -> ProjectContext
foldProjectContexts newContext previousContext =
    { functions = newContext.functions ++ previousContext.functions }


moduleVisitor :
    Rule.ModuleRuleSchema {} ModuleContext
    -> Rule.ModuleRuleSchema { hasAtLeastOneVisitor : () } ModuleContext
moduleVisitor schema =
    schema
        |> Rule.withDeclarationEnterVisitor declarationEnterVisitor


{-| Extract a simplified signature from a function annotation

The last argument in the list is the return type of the function.

-}
signatureList : Node TypeAnnotation -> List String
signatureList typeAnnotation =
    let
        go f typeAnn =
            case typeAnn |> Node.value of
                FunctionTypeAnnotation arg returnType ->
                    let
                        argStr =
                            case Node.value arg of
                                Typed argNodeModAndName _ ->
                                    argNodeModAndName |> Node.value |> Tuple.second

                                GenericType arg_ ->
                                    arg_

                                Record _ ->
                                    "{ .. }"

                                GenericRecord r _ ->
                                    "{ " ++ Node.value r ++ " | .. }"

                                Unit ->
                                    "()"

                                Tupled _ ->
                                    "(..)"

                                FunctionTypeAnnotation _ _ ->
                                    "f"
                    in
                    go (f << (::) argStr) returnType

                Typed arg _ ->
                    let
                        argName =
                            arg |> Node.value |> Tuple.second
                    in
                    f << (::) argName

                GenericType arg ->
                    f << (::) arg

                Record _ ->
                    f << (::) "{ .. }"

                GenericRecord r _ ->
                    f << (::) ("{ " ++ Node.value r ++ " | .. }")

                Unit ->
                    f

                Tupled _ ->
                    f << (::) "(..)"
    in
    go identity typeAnnotation []


declarationEnterVisitor : Node Declaration -> ModuleContext -> ( List never, ModuleContext )
declarationEnterVisitor node context =
    let
        fns =
            case Node.value node of
                Declaration.FunctionDeclaration functionDeclaration ->
                    functionDeclaration.signature
                        |> Maybe.map Node.value
                        |> Maybe.map (\signature -> signatureList signature.typeAnnotation)
                        |> Maybe.map (\signature -> { signature = signature, name = functionDeclaration.declaration |> Node.value |> .name |> Node.value })
                        |> (\ma ->
                                case ma of
                                    Just a ->
                                        [ a ]

                                    Nothing ->
                                        []
                           )

                _ ->
                    []
    in
    ( [], { context | functions = fns ++ context.functions } )


dataExtractor : ProjectContext -> Encode.Value
dataExtractor projectContext =
    projectContext.functions
        |> Encode.list
            (\d ->
                Encode.object
                    [ ( "name", Encode.string d.name )
                    , ( "signature", Encode.list Encode.string d.signature )
                    , ( "returnType", Encode.string (List.reverse d.signature |> List.head |> Maybe.withDefault "") )
                    ]
            )