elm-review/tests/Simplify/Normalize.elm

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

import Dict
import Elm.Syntax.Expression as Expression exposing (Expression)
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Pattern as Pattern exposing (Pattern)
import Elm.Syntax.Range as Range
import Elm.Writer
import Review.ModuleNameLookupTable as ModuleNameLookupTable exposing (ModuleNameLookupTable)
import Simplify.Infer as Infer


areAllTheSame : Infer.Resources a -> Node Expression -> List (Node Expression) -> Bool
areAllTheSame resources first rest =
    let
        normalizedFirst : Node Expression
        normalizedFirst =
            normalize resources first
    in
    List.all (\node -> normalize resources node == normalizedFirst) rest


normalize : Infer.Resources a -> Node Expression -> Node Expression
normalize resources node =
    case Node.value node of
        Expression.ParenthesizedExpression expr ->
            normalize resources expr

        Expression.Application nodes ->
            case nodes of
                fn :: arg1 :: restOrArgs ->
                    let
                        normalizedArg1 : Node Expression
                        normalizedArg1 =
                            normalize resources arg1
                    in
                    case normalize resources fn of
                        Node _ (Expression.RecordAccessFunction fieldAccess) ->
                            let
                                recordAccess : Node Expression
                                recordAccess =
                                    Expression.RecordAccess normalizedArg1 (toNode (String.dropLeft 1 fieldAccess))
                                        |> toNode
                            in
                            if List.isEmpty restOrArgs then
                                recordAccess

                            else
                                (recordAccess :: List.map (normalize resources) restOrArgs)
                                    |> Expression.Application
                                    |> toNode

                        normalizedFn ->
                            (normalizedFn :: normalizedArg1 :: List.map (normalize resources) restOrArgs)
                                |> Expression.Application
                                |> toNode

                _ ->
                    node

        Expression.OperatorApplication "<|" _ function extraArgument ->
            addToFunctionCall
                (normalize resources function)
                (normalize resources extraArgument)

        Expression.OperatorApplication "|>" _ extraArgument function ->
            addToFunctionCall
                (normalize resources function)
                (normalize resources extraArgument)

        Expression.OperatorApplication "::" infixDirection element list ->
            let
                normalizedElement : Node Expression
                normalizedElement =
                    normalize resources element

                normalizedList : Node Expression
                normalizedList =
                    normalize resources list
            in
            case Node.value normalizedList of
                Expression.ListExpr elements ->
                    toNode (Expression.ListExpr (normalizedElement :: elements))

                _ ->
                    toNode (Expression.OperatorApplication "::" infixDirection normalizedElement normalizedList)

        Expression.OperatorApplication ">" infixDirection left right ->
            toNode (Expression.OperatorApplication "<" infixDirection (normalize resources right) (normalize resources left))

        Expression.OperatorApplication ">=" infixDirection left right ->
            toNode (Expression.OperatorApplication "<=" infixDirection (normalize resources right) (normalize resources left))

        Expression.OperatorApplication operator infixDirection l r ->
            let
                left : Node Expression
                left =
                    normalize resources l

                right : Node Expression
                right =
                    normalize resources r
            in
            if List.member operator [ "+", "*", "||", "&&", "==", "/=" ] && toComparable left > toComparable right then
                toNode (Expression.OperatorApplication operator infixDirection right left)

            else
                toNode (Expression.OperatorApplication operator infixDirection left right)

        Expression.FunctionOrValue rawModuleName string ->
            Expression.FunctionOrValue
                (ModuleNameLookupTable.moduleNameFor resources.lookupTable node
                    |> Maybe.withDefault rawModuleName
                )
                string
                |> toNodeAndInfer resources

        Expression.IfBlock cond then_ else_ ->
            let
                reverseIfConditionIsNegated : Node Expression -> Node Expression -> Node Expression -> Node Expression
                reverseIfConditionIsNegated condArg thenArg elseArg =
                    case Node.value condArg of
                        Expression.Application [ Node _ (Expression.FunctionOrValue [ "Basics" ] "not"), negatedCondition ] ->
                            reverseIfConditionIsNegated negatedCondition elseArg thenArg

                        _ ->
                            toNode (Expression.IfBlock condArg thenArg elseArg)
            in
            reverseIfConditionIsNegated
                (normalize resources cond)
                (normalize resources then_)
                (normalize resources else_)

        Expression.Negation expr ->
            let
                normalized : Node Expression
                normalized =
                    normalize resources expr
            in
            case Node.value normalized of
                Expression.Integer int ->
                    toNode (Expression.Integer -int)

                Expression.Floatable float ->
                    toNode (Expression.Floatable -float)

                _ ->
                    toNode (Expression.Negation normalized)

        Expression.TupledExpression nodes ->
            toNode (Expression.TupledExpression (List.map (normalize resources) 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 resources.lookupTable) declaration.arguments
                                                        , expression = normalize resources declaration.expression
                                                        }
                                                }
                                            )

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

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

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

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

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

        Expression.RecordExpr nodes ->
            nodes
                |> List.sortBy (\(Node _ ( Node _ fieldName, _ )) -> fieldName)
                |> List.map (\(Node _ ( Node _ fieldName, expr )) -> toNode ( toNode fieldName, normalize resources 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 resources expr ))
                |> Expression.RecordUpdateExpression (toNode value)
                |> toNode

        Expression.Hex int ->
            Expression.Integer int
                |> toNode

        expr ->
            toNode expr


toNodeAndInfer : Infer.Resources a -> Expression -> Node Expression
toNodeAndInfer resources element =
    case Infer.get element (Tuple.first resources.inferredConstants) of
        Just value ->
            toNode value

        Nothing ->
            toNode element


toComparable : Node Expression -> String
toComparable a =
    Elm.Writer.write (Elm.Writer.writeExpression a)


addToFunctionCall : Node Expression -> Node Expression -> Node Expression
addToFunctionCall functionCall extraArgument =
    case Node.value functionCall of
        Expression.ParenthesizedExpression expr ->
            addToFunctionCall expr extraArgument

        Expression.Application (fnCall :: args) ->
            Expression.Application (fnCall :: (args ++ [ extraArgument ]))
                |> toNode

        Expression.LetExpression { declarations, expression } ->
            Expression.LetExpression { declarations = declarations, expression = addToFunctionCall expression extraArgument }
                |> toNode

        Expression.IfBlock condition ifBranch elseBranch ->
            Expression.IfBlock condition (addToFunctionCall ifBranch extraArgument) (addToFunctionCall elseBranch extraArgument)
                |> toNode

        Expression.CaseExpression { expression, cases } ->
            Expression.CaseExpression { expression = expression, cases = List.map (\( cond, expr ) -> ( cond, addToFunctionCall expr extraArgument )) cases }
                |> toNode

        Expression.RecordAccessFunction fieldAccess ->
            Expression.RecordAccess extraArgument (toNode (String.dropLeft 1 fieldAccess))
                |> toNode

        _ ->
            Expression.Application [ functionCall, extraArgument ]
                |> toNode


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

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

        Pattern.UnConsPattern element list ->
            case normalizePattern lookupTable list of
                Node _ (Pattern.ListPattern elements) ->
                    toNode (Pattern.ListPattern (normalizePattern lookupTable element :: elements))

                normalizedList ->
                    toNode (Pattern.UnConsPattern (normalizePattern lookupTable element) normalizedList)

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

        Pattern.NamedPattern qualifiedNameRef patterns ->
            let
                nameRef : Pattern.QualifiedNameRef
                nameRef =
                    { moduleName =
                        ModuleNameLookupTable.moduleNameFor lookupTable node
                            |> Maybe.withDefault qualifiedNameRef.moduleName
                    , name = qualifiedNameRef.name
                    }
            in
            toNode (Pattern.NamedPattern nameRef (List.map (normalizePattern lookupTable) patterns))

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

        Pattern.ParenthesizedPattern pattern ->
            normalizePattern lookupTable pattern

        Pattern.HexPattern int ->
            toNode (Pattern.IntPattern int)

        pattern ->
            toNode pattern


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



-- COMPARE


type Comparison
    = ConfirmedEquality
    | ConfirmedInequality
    | Unconfirmed


compare : Infer.Resources a -> Node Expression -> Node Expression -> Comparison
compare resources leftNode right =
    compareHelp
        (normalize resources leftNode)
        (normalize resources right)
        True


compareWithoutNormalization : Node Expression -> Node Expression -> Comparison
compareWithoutNormalization leftNode right =
    compareHelp leftNode right True


compareHelp : Node Expression -> Node Expression -> Bool -> Comparison
compareHelp leftNode right canFlip =
    let
        fallback : () -> Comparison
        fallback () =
            if canFlip then
                compareHelp right leftNode False

            else if leftNode == right then
                ConfirmedEquality

            else
                Unconfirmed
    in
    case Node.value leftNode of
        Expression.Integer left ->
            compareNumbers (Basics.toFloat left) right

        Expression.Floatable left ->
            compareNumbers left 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 ()

                    Nothing ->
                        fallback ()

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

                        else
                            fallback ()

                    _ ->
                        fallback ()

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

                _ ->
                    fallback ()

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

                _ ->
                    fallback ()

        Expression.FunctionOrValue moduleNameLeft leftName ->
            case Node.value right of
                Expression.FunctionOrValue moduleNameRight rightName ->
                    if leftName == rightName && moduleNameRight == moduleNameLeft then
                        ConfirmedEquality

                    else
                        fallback ()

                _ ->
                    fallback ()

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

                    else
                        compareLists leftList rightList ConfirmedEquality

                _ ->
                    fallback ()

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

                _ ->
                    fallback ()

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

                _ ->
                    fallback ()

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

                    else
                        compareRecords leftList rightList Unconfirmed

                _ ->
                    fallback ()

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

                _ ->
                    fallback ()

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

                    else
                        Unconfirmed

                _ ->
                    fallback ()

        Expression.UnitExpr ->
            ConfirmedEquality

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

                _ ->
                    fallback ()

        _ ->
            fallback ()


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 : List (Node Expression) -> List (Node Expression) -> Comparison -> Comparison
compareLists leftList rightList acc =
    case ( leftList, rightList ) of
        ( left :: restOfLeft, right :: restOfRight ) ->
            case compareWithoutNormalization left right of
                ConfirmedEquality ->
                    compareLists restOfLeft restOfRight acc

                ConfirmedInequality ->
                    ConfirmedInequality

                Unconfirmed ->
                    compareLists restOfLeft restOfRight Unconfirmed

        _ ->
            acc


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

                ConfirmedInequality ->
                    Unconfirmed

                Unconfirmed ->
                    Unconfirmed

        _ ->
            ConfirmedEquality


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


compareRecords : List (Node Expression.RecordSetter) -> List (Node Expression.RecordSetter) -> Comparison -> Comparison
compareRecords 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 recordFieldComparisons acc


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

        MissingOtherValue :: rest ->
            compareRecordFields rest Unconfirmed

        (HasBothValues a b) :: rest ->
            case compareHelp a b True of
                ConfirmedInequality ->
                    ConfirmedInequality

                ConfirmedEquality ->
                    compareRecordFields rest acc

                Unconfirmed ->
                    compareRecordFields 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