elm-review/example/Main.elm

module Main exposing (main)

import Browser
import Html exposing (..)
import Html.Attributes as Attr
import Html.Events as Events
import Lint exposing (LintError, Severity(..), lintSource)
import Lint.Rule exposing (Rule)
import Lint.Rule.DefaultPatternPosition as DefaultPatternPosition exposing (PatternPosition)
import Lint.Rule.NoDebug
import Lint.Rule.NoExtraBooleanComparison
import Lint.Rule.NoImportingEverything
import Lint.Rule.NoUnusedVariables



-- LINT CONFIGURATION


config : Model -> List ( Severity, Rule )
config model =
    [ ( model.noDebugEnabled, ( Critical, Lint.Rule.NoDebug.rule ) )
    , ( model.noUnusedVariablesEnabled, ( Critical, Lint.Rule.NoUnusedVariables.rule ) )
    , ( model.noImportingEverythingEnabled, ( Critical, Lint.Rule.NoImportingEverything.rule { exceptions = [ "Html" ] } ) )
    , ( model.defaultPatternPositionEnabled, ( Critical, DefaultPatternPosition.rule model.defaultPatternPositionPattern ) )
    , ( model.noExtraBooleanComparisonEnabled, ( Critical, Lint.Rule.NoExtraBooleanComparison.rule ) )

    -- , ( Critical, Lint.Rule.NoConstantCondition.rule )
    -- , ( Critical, Lint.Rule.NoDuplicateImports.rule )
    -- , ( Critical, Lint.Rule.NoExposingEverything.rule )
    -- , ( Critical, Lint.Rule.NoNestedLet.rule )
    -- , ( Critical, Lint.Rule.NoUnannotatedFunction.rule )
    -- , ( Critical, Lint.Rule.NoUselessIf.rule )
    -- , ( Critical, Lint.Rule.NoUselessPatternMatching.rule )
    -- , ( Warning, Lint.Rule.NoWarningComments.rule )
    -- , ( Critical, Lint.Rule.SimplifyPiping.rule )
    -- , ( Critical, Lint.Rule.SimplifyPropertyAccess.rule )
    -- , ( Critical, Lint.Rule.ElmTest.NoDuplicateTestBodies.rule )
    ]
        |> List.filter Tuple.first
        |> List.map Tuple.second



-- MODEL


type alias Model =
    { sourceCode : String
    , lintResult : Result (List String) (List ( Severity, LintError ))
    , noDebugEnabled : Bool
    , noUnusedVariablesEnabled : Bool
    , noImportingEverythingEnabled : Bool
    , noImportingEverythingExceptions : List String
    , defaultPatternPositionEnabled : Bool
    , defaultPatternPositionPattern : PatternPosition
    , noExtraBooleanComparisonEnabled : Bool
    , showConfigurationAsText : Bool
    }


init : Model
init =
    let
        sourceCode : String
        sourceCode =
            """module Main exposing (f)

import Html.Events exposing (..)
import Html exposing (..)
import NotUsed
import SomeModule exposing (notUsed)

f : Int -> Int
f x = x Debug.log 1

g n = n + 1
"""

        tmpModel : Model
        tmpModel =
            { sourceCode = sourceCode
            , lintResult = Result.Ok []
            , noDebugEnabled = True
            , noUnusedVariablesEnabled = True
            , noImportingEverythingEnabled = True
            , noImportingEverythingExceptions = [ "Html", "Html.Attributes" ]
            , defaultPatternPositionEnabled = True
            , defaultPatternPositionPattern = DefaultPatternPosition.ShouldBeLast
            , noExtraBooleanComparisonEnabled = True
            , showConfigurationAsText = False
            }
    in
    { tmpModel | lintResult = lintSource (config tmpModel) sourceCode }



-- UPDATE


type Msg
    = UserEditedSourceCode String
    | UserToggledNoDebugRule
    | UserToggledNoUnusedVariablesRule
    | UserToggledNoImportingEverythingRule
    | UserToggledDefaultPatternPositionRule
    | UserToggledNoExtraBooleanComparisonRule
    | UserChangedDefaultPatternSetting PatternPosition
    | UserToggledConfigurationAsText


update : Msg -> Model -> Model
update action model =
    case action of
        UserEditedSourceCode sourceCode ->
            { model
                | sourceCode = sourceCode
                , lintResult = lintSource (config model) sourceCode
            }

        UserToggledNoDebugRule ->
            { model | noDebugEnabled = not model.noDebugEnabled }
                |> rerunLinting

        UserToggledNoUnusedVariablesRule ->
            { model | noUnusedVariablesEnabled = not model.noUnusedVariablesEnabled }
                |> rerunLinting

        UserToggledNoImportingEverythingRule ->
            { model | noImportingEverythingEnabled = not model.noImportingEverythingEnabled }
                |> rerunLinting

        UserToggledDefaultPatternPositionRule ->
            { model | defaultPatternPositionEnabled = not model.defaultPatternPositionEnabled }
                |> rerunLinting

        UserChangedDefaultPatternSetting patternPosition ->
            { model | defaultPatternPositionPattern = patternPosition }
                |> rerunLinting

        UserToggledNoExtraBooleanComparisonRule ->
            { model | noExtraBooleanComparisonEnabled = not model.noExtraBooleanComparisonEnabled }
                |> rerunLinting

        UserToggledConfigurationAsText ->
            { model | showConfigurationAsText = not model.showConfigurationAsText }


rerunLinting : Model -> Model
rerunLinting model =
    { model | lintResult = lintSource (config model) model.sourceCode }



-- VIEW


view : Model -> Html Msg
view model =
    div [ Attr.id "wrapper" ]
        [ div [ Attr.id "left" ]
            [ p [ Attr.class "title" ] [ text "Source code" ]
            , div
                [ Attr.style "display" "flex"
                , Attr.style "flex-direction" "row"
                ]
                [ textarea
                    [ Attr.id "input"
                    , Events.onInput UserEditedSourceCode
                    , Attr.style "height" "500px"
                    , Attr.style "width" "60%"
                    ]
                    [ text model.sourceCode ]
                , div [ Attr.style "margin-left" "2rem" ]
                    [ viewConfigurationPanel model
                    , viewConfigurationAsText model
                    , p [ Attr.class "title" ] [ text "Linting errors" ]
                    , ul [ Attr.id "lint" ]
                        (lintErrors model)
                    ]
                ]
            ]
        ]


viewConfigurationPanel : Model -> Html Msg
viewConfigurationPanel model =
    div []
        [ p [ Attr.class "title" ] [ text "Configuration" ]
        , div
            [ Attr.style "display" "flex"
            , Attr.style "flex-direction" "column"
            ]
            [ viewCheckbox UserToggledNoDebugRule "NoDebug" model.noDebugEnabled
            , viewCheckbox UserToggledNoUnusedVariablesRule "NoUnusedVariables" model.noUnusedVariablesEnabled
            , viewCheckbox UserToggledNoImportingEverythingRule "NoImportingEverything" model.noImportingEverythingEnabled
            , form [ Attr.action "" ]
                [ viewCheckbox UserToggledDefaultPatternPositionRule "DefaultPatternPosition" model.defaultPatternPositionEnabled
                , viewRadioButton
                    UserChangedDefaultPatternSetting
                    DefaultPatternPosition.ShouldBeLast
                    "Should be last"
                    model.defaultPatternPositionEnabled
                    model.defaultPatternPositionPattern
                , viewRadioButton
                    UserChangedDefaultPatternSetting
                    DefaultPatternPosition.ShouldBeFirst
                    "Should be first"
                    model.defaultPatternPositionEnabled
                    model.defaultPatternPositionPattern
                ]
            , viewCheckbox UserToggledNoExtraBooleanComparisonRule "NoExtraBooleanComparison" model.noExtraBooleanComparisonEnabled
            ]
        ]


viewConfigurationAsText : Model -> Html Msg
viewConfigurationAsText model =
    if model.showConfigurationAsText then
        div
            [ Attr.style "display" "flex"
            , Attr.style "flex-direction" "column"
            ]
            [ button
                [ Attr.style "margin-top" "2rem"
                , Events.onClick UserToggledConfigurationAsText
                ]
                [ text "Hide configuration as Elm code" ]
            , textarea
                [ Events.onInput UserEditedSourceCode
                , Attr.style "height" "300px"
                , Attr.style "width" "100%"
                ]
                [ text <| configurationAsText model ]
            ]

    else
        button
            [ Attr.style "margin-top" "2rem"
            , Events.onClick UserToggledConfigurationAsText
            ]
            [ text "Show configuration as Elm code" ]


configurationAsText : Model -> String
configurationAsText model =
    let
        rules : List { import_ : String, configExpression : String }
        rules =
            [ ( model.noDebugEnabled
              , { import_ = "Lint.Rule.NoDebug"
                , configExpression = "Lint.Rule.NoDebug.rule"
                }
              )
            , ( model.noUnusedVariablesEnabled
              , { import_ = "Lint.Rule.NoUnusedVariables"
                , configExpression = "Lint.Rule.NoUnusedVariables.rule"
                }
              )
            , ( model.noImportingEverythingEnabled
              , { import_ = "Lint.Rule.NoImportingEverything"
                , configExpression = "Lint.Rule.NoImportingEverything.rule { exceptions = [] }"
                }
              )
            , ( model.defaultPatternPositionEnabled
              , { import_ = "Lint.Rule.DefaultPatternPosition as DefaultPatternPosition"
                , configExpression =
                    "DefaultPatternPosition.rule DefaultPatternPosition."
                        ++ (case model.defaultPatternPositionPattern of
                                DefaultPatternPosition.ShouldBeFirst ->
                                    "ShouldBeFirst"

                                DefaultPatternPosition.ShouldBeLast ->
                                    "ShouldBeLast"
                           )
                }
              )
            , ( model.noExtraBooleanComparisonEnabled
              , { import_ = "Lint.Rule.NoExtraBooleanComparison"
                , configExpression = "Lint.Rule.NoExtraBooleanComparison.rule"
                }
              )
            ]
                |> List.filter Tuple.first
                |> List.map Tuple.second

        importStatements : String
        importStatements =
            rules
                |> List.map (\{ import_ } -> "import " ++ import_)
                |> String.join "\n"

        configExpressions : String
        configExpressions =
            rules
                |> List.map (\{ configExpression } -> " ( Critical, " ++ configExpression ++ " )")
                |> String.join "\n    ,"
    in
    """module LintConfig exposing (config)

import Lint exposing (Severity(..))
import Lint.Rule exposing (Rule)
""" ++ importStatements ++ """


config : List ( Severity, Rule )
config =
    [""" ++ configExpressions ++ """
    ]
"""


viewCheckbox : Msg -> String -> Bool -> Html Msg
viewCheckbox onClick name checked =
    label
        []
        [ input
            [ Attr.type_ "checkbox"
            , Attr.checked checked
            , Events.onClick onClick
            ]
            []
        , text name
        ]


viewRadioButton : (PatternPosition -> Msg) -> PatternPosition -> String -> Bool -> PatternPosition -> Html Msg
viewRadioButton onClick patternPosition name enabled selectedPatternPosition =
    label
        []
        [ input
            [ Attr.type_ "radio"
            , Attr.checked (patternPosition == selectedPatternPosition)
            , Events.onClick (onClick patternPosition)
            , Attr.disabled <| not enabled
            , Attr.name name
            , Attr.value name
            ]
            []
        , text name
        ]


lintErrors : Model -> List (Html Msg)
lintErrors model =
    let
        messages : List String
        messages =
            case model.lintResult of
                Err errors ->
                    errors

                Ok errors ->
                    if List.isEmpty errors then
                        [ "No errors." ]

                    else
                        List.map (Tuple.second >> errorToString) errors
    in
    List.map
        (\message -> li [] [ text message ])
        messages


errorToString : LintError -> String
errorToString { ruleName, message, range } =
    let
        location : String
        location =
            "(line " ++ String.fromInt range.start.row ++ ", column " ++ String.fromInt range.start.column ++ ")"
    in
    ruleName ++ ": " ++ message ++ " " ++ location


main : Program () Model Msg
main =
    Browser.sandbox
        { init = init
        , update = update
        , view = view
        }