Console Printer for elm-syntax "Expression" AST

PP.elm

module PP exposing (..)

import Elm.Syntax.Expression exposing (..)
import Elm.Syntax.Infix exposing (InfixDirection(..))
import Elm.Syntax.Node as Node exposing (Node(..))
import Elm.Syntax.Pattern exposing (..)
import Elm.Writer as Write
import Hex




logExpr : String -> Expression -> Expression
logExpr msg expr =
    let
        _ =
            log msg (toString expr)
    in
    expr


log : String -> String -> ()
log msg str =
    let
        _ =
            Debug.log ("[" ++ msg ++ "]" ++ " " ++ str) ()
    in
    ()


pp : Node Expression -> String
pp (Node _ expr) =
    toString expr


toString : Expression -> String
toString expr =
    let
        writeRecordSetter : RecordSetter -> String
        writeRecordSetter ( name, expr_ ) =
            String.join " " [ Node.value name, "=", pp expr_ ]
    in
    case expr of
        UnitExpr ->
            "()"

        Application exprs ->
            "Application " ++ printList (List.map pp exprs)

        OperatorApplication op _ left right ->
            "OperatorApplication " ++ printList [ pp left, printStr op, pp right ]

        FunctionOrValue mod name ->
            "FunctionOrValue " ++ printList mod ++ " " ++ printStr name

        IfBlock pred true false ->
            "IfBlock " ++ String.join " " [ parens (pp pred), parens (pp true), parens (pp false) ]

        PrefixOperator str ->
            "Prefix " ++ printStr str

        Operator str ->
            "Op " ++ printStr str

        Integer int ->
            "Int " ++ String.fromInt int

        Hex int ->
            "Hex 0x" ++ Hex.toString int

        Floatable f ->
            "Float " ++ String.fromFloat f

        Negation ex ->
            "Negation " ++ pp ex

        Literal str ->
            "Lit " ++ printStr str

        CharLiteral char ->
            "Char " ++ Debug.toString char

        TupledExpression ex ->
            "( " ++ String.join ", " (List.map pp ex) ++ " )"

        ParenthesizedExpression ex ->
            "( " ++ pp ex ++ " )"

        LetExpression letBlock ->
            let
                writeLetDeclaration : Node LetDeclaration -> String
                writeLetDeclaration (Node _ letDeclaration) =
                    case letDeclaration of
                        LetFunction function ->
                            let
                                declaration =
                                    Node.value function.declaration
                            in
                            "LetFunction "
                                ++ String.join " "
                                    [ --  Debug.toString (Maybe.map Node.value function.documentation)
                                      -- , Debug.toString (Maybe.map Node.value function.signature)
                                      parens (Node.value declaration.name ++ " " ++ String.join " " (List.map (parens << Debug.toString << Node.value) declaration.arguments) ++ " = " ++ pp declaration.expression)
                                    ]

                        LetDestructuring pattern expression ->
                            Debug.toString pattern ++ pp expression
            in
            "LetExpression "
                ++ printList (List.map writeLetDeclaration letBlock.declarations)
                ++ parens (pp letBlock.expression)

        CaseExpression caseBlock ->
            let
                writeCaseBranch : ( Node Pattern, Node Expression ) -> String
                writeCaseBranch ( Node _ pattern, expression ) =
                    printPattern pattern ++ " -> " ++ pp expression
            in
            "CaseExpression " ++ "{ expression = " ++ pp caseBlock.expression ++ ", cases = " ++ printList (List.map writeCaseBranch caseBlock.cases) ++ " }"

        LambdaExpression lambda ->
            "LambdaExpression " ++ printList (List.map Debug.toString lambda.args) ++ pp lambda.expression

        ListExpr xs ->
            "ListExpr " ++ printList (List.map pp xs)

        RecordAccess expression accessor ->
            "RecordAccess " ++ String.concat [ parens (pp expression), " ", printStr (String.concat [ ".", Node.value accessor ]) ]

        RecordAccessFunction s ->
            "RecordAccessFunction "
                ++ (if String.startsWith "." s then
                        s

                    else
                        String.concat [ ".", s ]
                   )

        RecordExpr setters ->
            "RecordExpr " ++ "{ " ++ String.join ", " (List.map (Node.value >> writeRecordSetter) setters) ++ " }"

        RecordUpdateExpression name updates ->
            "RecordUpdateExpression "
                ++ String.concat
                    [ "{"
                    , Node.value name
                    , "|"
                    , String.join ", " (List.map (Node.value >> writeRecordSetter) updates)
                    , "}"
                    ]

        GLSLExpression s ->
            "[glsl|" ++ s ++ "|]"


printPattern : Pattern -> String
printPattern p =
    case p of
        AllPattern ->
            "AllPattern"

        UnitPattern ->
            "UnitPattern"

        CharPattern char ->
            "CharPattern " ++ "'" ++ String.fromChar char ++ "'"

        StringPattern str ->
            "StringPattern " ++ printStr str

        IntPattern i ->
            "IntPattern " ++ String.fromInt i

        HexPattern int ->
            "HexPattern 0x" ++ Hex.toString int

        FloatPattern f ->
            "FloatPattern " ++ String.fromFloat f

        TuplePattern pats ->
            "TuplePattern " ++ printList (List.map (printPattern << Node.value) pats)

        RecordPattern [] ->
            "{}"

        RecordPattern names ->
            "RecordPattern { " ++ String.join ", " (List.map Node.value names) ++ " }"

        UnConsPattern (Node _ hd) (Node _ tl) ->
            "UnConsPattern " ++ printPattern hd ++ " :: " ++ printPattern tl

        ListPattern pats ->
            "ListPattern " ++ printList (List.map (printPattern << Node.value) pats)

        VarPattern str ->
            "VarPattern " ++ printStr str

        NamedPattern q pats ->
            "NamedPattern " ++ Debug.toString q ++ printList (List.map (printPattern << Node.value) pats)

        AsPattern (Node _ pat) str ->
            "AsPattern " ++ printPattern pat ++ " as " ++ Node.value str

        ParenthesizedPattern (Node _ pat) ->
            parens (printPattern pat)


parens : String -> String
parens s =
    "(" ++ s ++ ")"


printList : List String -> String
printList ls =
    case ls of
        [] ->
            "[]"

        _ ->
            "[ " ++ String.join ", " ls ++ " ]"


printStr : String -> String
printStr s =
    "\"" ++ s ++ "\""