elm-review/tests/Simplify/Normalize.elm

module Simplify.Normalize exposing (Comparison(..), areAllTheSame, compare, getNumberValue)

import Dict
import Elm.Syntax.Expression as Expression exposing (Expression)
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 Review.ModuleNameLookupTable as ModuleNameLookupTable exposing (ModuleNameLookupTable)


areTheSame : ModuleNameLookupTable -> Node Expression -> Node Expression -> Bool
areTheSame lookupTable left right =
    normalize lookupTable left == normalize lookupTable right


areAllTheSame : ModuleNameLookupTable -> Node Expression -> List (Node Expression) -> Bool
areAllTheSame lookupTable first rest =
    let
        normalizedFirst : Node Expression
        normalizedFirst =
            normalize lookupTable first
    in
    List.all (\node -> normalize lookupTable node == normalizedFirst) rest


normalize : ModuleNameLookupTable -> Node Expression -> Node Expression
normalize lookupTable node =
    case Node.value node of
        Expression.ParenthesizedExpression expr ->
            normalize lookupTable expr

        Expression.Application nodes ->
            toNode (Expression.Application (List.map (normalize lookupTable) nodes))

        Expression.OperatorApplication string infixDirection left right ->
            toNode (Expression.OperatorApplication string infixDirection (normalize lookupTable left) (normalize lookupTable right))

        Expression.FunctionOrValue rawModuleName string ->
            let
                moduleName : ModuleName
                moduleName =
                    ModuleNameLookupTable.moduleNameFor lookupTable node
                        |> Maybe.withDefault rawModuleName
            in
            toNode (Expression.FunctionOrValue moduleName string)

        Expression.IfBlock cond then_ else_ ->
            toNode (Expression.IfBlock (normalize lookupTable cond) (normalize lookupTable then_) (normalize lookupTable else_))

        Expression.Negation expr ->
            toNode (Expression.Negation (normalize lookupTable expr))

        Expression.TupledExpression nodes ->
            toNode (Expression.TupledExpression (List.map (normalize lookupTable) nodes))

        Expression.LetExpression letBlock ->
            toNode
                (Expression.LetExpression
                    { declarations =
                        List.map
                            (\decl ->
                                case Node.value decl of
                                    Expression.LetFunction function ->
                                        let
                                            declaration : Expression.FunctionImplementation
                                            declaration =
                                                Node.value function.declaration
                                        in
                                        toNode
                                            (Expression.LetFunction
                                                { documentation = Nothing
                                                , signature = Nothing
                                                , declaration =
                                                    toNode
                                                        { name = toNode (Node.value declaration.name)
                                                        , arguments = List.map normalizePattern declaration.arguments
                                                        , expression = normalize lookupTable declaration.expression
                                                        }
                                                }
                                            )

                                    Expression.LetDestructuring pattern expr ->
                                        toNode (Expression.LetDestructuring (normalizePattern pattern) (normalize lookupTable expr))
                            )
                            letBlock.declarations
                    , expression = normalize lookupTable letBlock.expression
                    }
                )

        Expression.CaseExpression caseBlock ->
            toNode
                (Expression.CaseExpression
                    { cases = List.map (\( pattern, expr ) -> ( normalizePattern pattern, normalize lookupTable expr )) caseBlock.cases
                    , expression = toNode <| Node.value caseBlock.expression
                    }
                )

        Expression.LambdaExpression lambda ->
            toNode
                (Expression.LambdaExpression
                    { args = List.map normalizePattern lambda.args
                    , expression = normalize lookupTable lambda.expression
                    }
                )

        Expression.ListExpr nodes ->
            toNode (Expression.ListExpr (List.map (normalize lookupTable) nodes))

        Expression.RecordAccess expr (Node _ field) ->
            toNode (Expression.RecordAccess (normalize lookupTable expr) (toNode field))

        Expression.RecordExpr nodes ->
            nodes
                |> List.sortBy (\(Node _ ( Node _ fieldName, _ )) -> fieldName)
                |> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize lookupTable expr ))
                |> Expression.RecordExpr
                |> toNode

        Expression.RecordUpdateExpression (Node _ value) nodes ->
            nodes
                |> List.sortBy (\(Node _ ( Node _ fieldName, _ )) -> fieldName)
                |> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize lookupTable expr ))
                |> Expression.RecordUpdateExpression (toNode value)
                |> toNode

        expr ->
            toNode expr


normalizePattern : Node Pattern -> Node Pattern
normalizePattern node =
    case Node.value node of
        Pattern.TuplePattern patterns ->
            toNode (Pattern.TuplePattern (List.map normalizePattern patterns))

        Pattern.RecordPattern fields ->
            toNode (Pattern.RecordPattern (List.map (\(Node _ field) -> toNode field) fields))

        Pattern.UnConsPattern element list ->
            toNode (Pattern.UnConsPattern (normalizePattern element) (normalizePattern list))

        Pattern.ListPattern patterns ->
            toNode (Pattern.ListPattern (List.map normalizePattern patterns))

        Pattern.NamedPattern qualifiedNameRef patterns ->
            toNode (Pattern.NamedPattern qualifiedNameRef (List.map normalizePattern patterns))

        Pattern.AsPattern pattern (Node _ asName) ->
            toNode (Pattern.AsPattern (normalizePattern pattern) (toNode asName))

        Pattern.ParenthesizedPattern pattern ->
            normalizePattern pattern

        pattern ->
            toNode pattern


toNode : a -> Node a
toNode =
    Node Range.emptyRange



-- COMPARE


type Comparison
    = ConfirmedEquality
    | ConfirmedInequality
    | Unconfirmed


compare : ModuleNameLookupTable -> Node Expression -> Node Expression -> Comparison
compare lookupTable leftNode right =
    compareHelp lookupTable leftNode right True


compareHelp : ModuleNameLookupTable -> Node Expression -> Node Expression -> Bool -> Comparison
compareHelp lookupTable leftNode right canFlip =
    let
        fallback : Node Expression -> Comparison
        fallback rightNode =
            if canFlip then
                compareHelp lookupTable rightNode leftNode False

            else if areTheSame lookupTable leftNode right then
                ConfirmedEquality

            else
                Unconfirmed
    in
    case Node.value leftNode of
        Expression.ParenthesizedExpression expr ->
            compareHelp lookupTable expr right canFlip

        Expression.Integer left ->
            compareNumbers (Basics.toFloat left) right

        Expression.Floatable left ->
            compareNumbers left right

        Expression.Hex left ->
            compareNumbers (Basics.toFloat left) right

        Expression.Negation left ->
            case getNumberValue left of
                Just leftValue ->
                    compareNumbers -leftValue right

                Nothing ->
                    fallback right

        Expression.OperatorApplication leftOp _ leftLeft leftRight ->
            if List.member leftOp [ "+", "-", "*", "/" ] then
                case getNumberValue leftNode of
                    Just leftValue ->
                        case getNumberValue right of
                            Just rightValue ->
                                fromEquality (leftValue == rightValue)

                            Nothing ->
                                fallback right

                    Nothing ->
                        fallback right

            else
                case Node.value (removeParens right) of
                    Expression.OperatorApplication rightOp _ rightLeft rightRight ->
                        if leftOp == rightOp then
                            compareEqualityOfAll
                                lookupTable
                                [ leftLeft, leftRight ]
                                [ rightLeft, rightRight ]

                        else
                            fallback right

                    _ ->
                        fallback right

        Expression.Literal left ->
            case Node.value (removeParens right) of
                Expression.Literal rightValue ->
                    fromEquality (left == rightValue)

                _ ->
                    fallback right

        Expression.CharLiteral left ->
            case Node.value (removeParens right) of
                Expression.CharLiteral rightValue ->
                    fromEquality (left == rightValue)

                _ ->
                    fallback right

        Expression.FunctionOrValue _ leftName ->
            let
                right_ : Node Expression
                right_ =
                    removeParens right
            in
            case Node.value right_ of
                Expression.FunctionOrValue _ rightName ->
                    if
                        isSameReference
                            lookupTable
                            ( Node.range leftNode, leftName )
                            ( Node.range right_, rightName )
                    then
                        ConfirmedEquality

                    else
                        fallback right_

                _ ->
                    fallback right

        Expression.ListExpr leftList ->
            case Node.value (removeParens right) of
                Expression.ListExpr rightList ->
                    if List.length leftList /= List.length rightList then
                        ConfirmedInequality

                    else
                        compareLists lookupTable leftList rightList ConfirmedEquality

                _ ->
                    fallback right

        Expression.TupledExpression leftList ->
            case Node.value (removeParens right) of
                Expression.TupledExpression rightList ->
                    compareLists lookupTable leftList rightList ConfirmedEquality

                _ ->
                    fallback right

        Expression.RecordExpr leftList ->
            case Node.value (removeParens right) of
                Expression.RecordExpr rightList ->
                    compareRecords lookupTable leftList rightList ConfirmedEquality

                _ ->
                    fallback right

        Expression.RecordUpdateExpression leftBaseValue leftList ->
            case Node.value (removeParens right) of
                Expression.RecordUpdateExpression rightBaseValue rightList ->
                    if Node.value leftBaseValue == Node.value rightBaseValue then
                        compareRecords lookupTable leftList rightList ConfirmedEquality

                    else
                        compareRecords lookupTable leftList rightList Unconfirmed

                _ ->
                    fallback right

        Expression.Application leftArgs ->
            case Node.value (removeParens right) of
                Expression.Application rightArgs ->
                    compareEqualityOfAll lookupTable leftArgs rightArgs

                _ ->
                    fallback right

        Expression.RecordAccess leftExpr leftName ->
            case Node.value (removeParens right) of
                Expression.RecordAccess rightExpr rightName ->
                    if Node.value leftName == Node.value rightName then
                        compareHelp lookupTable leftExpr rightExpr canFlip

                    else
                        Unconfirmed

                _ ->
                    fallback right

        Expression.UnitExpr ->
            ConfirmedEquality

        Expression.IfBlock leftCond leftThen leftElse ->
            case Node.value (removeParens right) of
                Expression.IfBlock rightCond rightThen rightElse ->
                    compareEqualityOfAll
                        lookupTable
                        [ leftCond, leftThen, leftElse ]
                        [ rightCond, rightThen, rightElse ]

                _ ->
                    fallback right

        _ ->
            fallback right


isSameReference : ModuleNameLookupTable -> ( Range, String ) -> ( Range, String ) -> Bool
isSameReference lookupTable ( leftFnRange, leftFnName ) ( rightFnRange, rightFnName ) =
    if leftFnName == rightFnName then
        Maybe.map2 (==)
            (ModuleNameLookupTable.moduleNameAt lookupTable leftFnRange)
            (ModuleNameLookupTable.moduleNameAt lookupTable rightFnRange)
            |> Maybe.withDefault False

    else
        False


compareNumbers : Float -> Node Expression -> Comparison
compareNumbers leftValue right =
    case getNumberValue right of
        Just rightValue ->
            fromEquality (leftValue == rightValue)

        Nothing ->
            Unconfirmed


getNumberValue : Node Expression -> Maybe Float
getNumberValue node =
    case Node.value node of
        Expression.Integer value ->
            Just (Basics.toFloat value)

        Expression.Hex int ->
            Just (Basics.toFloat int)

        Expression.Floatable float ->
            Just float

        Expression.ParenthesizedExpression expr ->
            getNumberValue expr

        Expression.LetExpression { expression } ->
            getNumberValue expression

        Expression.OperatorApplication "+" _ left right ->
            Maybe.map2 (+)
                (getNumberValue left)
                (getNumberValue right)

        Expression.OperatorApplication "-" _ left right ->
            Maybe.map2 (-)
                (getNumberValue left)
                (getNumberValue right)

        Expression.OperatorApplication "*" _ left right ->
            Maybe.map2 (*)
                (getNumberValue left)
                (getNumberValue right)

        Expression.OperatorApplication "/" _ left right ->
            Maybe.map2 (/)
                (getNumberValue left)
                (getNumberValue right)

        Expression.Negation expr ->
            getNumberValue expr
                |> Maybe.map negate

        _ ->
            Nothing


compareLists : ModuleNameLookupTable -> List (Node Expression) -> List (Node Expression) -> Comparison -> Comparison
compareLists lookupTable leftList rightList acc =
    case ( leftList, rightList ) of
        ( left :: restOfLeft, right :: restOfRight ) ->
            case compareHelp lookupTable left right True of
                ConfirmedEquality ->
                    compareLists lookupTable restOfLeft restOfRight acc

                ConfirmedInequality ->
                    ConfirmedInequality

                Unconfirmed ->
                    compareLists lookupTable restOfLeft restOfRight Unconfirmed

        _ ->
            acc


compareEqualityOfAll : ModuleNameLookupTable -> List (Node Expression) -> List (Node Expression) -> Comparison
compareEqualityOfAll lookupTable leftList rightList =
    case ( leftList, rightList ) of
        ( left :: restOfLeft, right :: restOfRight ) ->
            case compareHelp lookupTable left right True of
                ConfirmedEquality ->
                    compareEqualityOfAll lookupTable restOfLeft restOfRight

                ConfirmedInequality ->
                    Unconfirmed

                Unconfirmed ->
                    Unconfirmed

        _ ->
            ConfirmedEquality


type RecordFieldComparison
    = MissingOtherValue
    | HasBothValues (Node Expression) (Node Expression)


compareRecords : ModuleNameLookupTable -> List (Node Expression.RecordSetter) -> List (Node Expression.RecordSetter) -> Comparison -> Comparison
compareRecords lookupTable leftList rightList acc =
    let
        leftFields : List ( String, Node Expression )
        leftFields =
            List.map (Node.value >> Tuple.mapFirst Node.value) leftList

        rightFields : List ( String, Node Expression )
        rightFields =
            List.map (Node.value >> Tuple.mapFirst Node.value) rightList

        recordFieldComparisons : List RecordFieldComparison
        recordFieldComparisons =
            Dict.merge
                (\key _ -> Dict.insert key MissingOtherValue)
                (\key a b -> Dict.insert key (HasBothValues a b))
                (\key _ -> Dict.insert key MissingOtherValue)
                (Dict.fromList leftFields)
                (Dict.fromList rightFields)
                Dict.empty
                |> Dict.values
    in
    compareRecordFields lookupTable recordFieldComparisons acc


compareRecordFields : ModuleNameLookupTable -> List RecordFieldComparison -> Comparison -> Comparison
compareRecordFields lookupTable recordFieldComparisons acc =
    case recordFieldComparisons of
        [] ->
            acc

        MissingOtherValue :: rest ->
            compareRecordFields lookupTable rest Unconfirmed

        (HasBothValues a b) :: rest ->
            case compare lookupTable a b of
                ConfirmedInequality ->
                    ConfirmedInequality

                ConfirmedEquality ->
                    compareRecordFields lookupTable rest acc

                Unconfirmed ->
                    compareRecordFields lookupTable rest Unconfirmed


fromEquality : Bool -> Comparison
fromEquality bool =
    if bool then
        ConfirmedEquality

    else
        ConfirmedInequality


removeParens : Node Expression -> Node Expression
removeParens node =
    case Node.value node of
        Expression.ParenthesizedExpression expr ->
            removeParens expr

        _ ->
            node