module RestyScript.AST (
    RSVal(..), traverse
) where

import Text.ParserCombinators.Parsec.Pos (SourcePos)

-- RestyScript AST datatype
data RSVal = SetOp !String !RSVal !RSVal
           | Query ![RSVal]
           | Select ![RSVal] -- Select entries
           | From ![RSVal]
           | Where !RSVal
           | Limit !RSVal
           | Offset !RSVal
           | TypeCast !RSVal !RSVal
           | OrderBy ![RSVal]
           | OrderPair !RSVal !RSVal
           | GroupBy !RSVal
           | Alias !RSVal !RSVal
           | Column !RSVal
           | Model !RSVal
           | Symbol !String
           | Type !String
           | Keyword !String  -- for asc and desc
           | QualifiedColumn !RSVal !RSVal
           | Integer !Int
           | Float !Double
           | String !String
           | Variable !SourcePos !String
           | FuncCall !RSVal ![RSVal]
           | Compare !String !RSVal !RSVal
           | Arith !String !RSVal !RSVal
           | Minus !RSVal
           | Plus !RSVal
           | Not !RSVal
           | Or !RSVal !RSVal
           | And !RSVal !RSVal
           | Empty
           | Null
           | AnyColumn
           | Action ![RSVal]
           | Delete !RSVal !RSVal -- Delete model cond
           | Update !RSVal !RSVal !RSVal -- Update model assign cond
           | Assign !RSVal !RSVal -- Assign col expr
           | HttpCmd !String !RSVal !RSVal -- HttpCmd method url content
           | Object ![RSVal]  -- Object [pair]
           | Pair !RSVal !RSVal -- Pair key value
           | Array ![RSVal]  -- Array [elem]
           | Concat !RSVal !RSVal
           | Distinct ![RSVal]
           | All ![RSVal]
           | RSTrue
           | RSFalse
           | Capture [(RSVal, RSVal)]
           | ArrayIndex !RSVal !RSVal
               deriving (Eq, Show)

traverse :: (RSVal->a) -> (a->a->a) -> RSVal -> a
traverse visit merge node =
    let mergeAll = foldl1 merge
        cur = visit node
        self = traverse visit merge
    in case node of
        SetOp _ lhs rhs -> mergeAll [cur, self lhs, self rhs]
        Query q -> mergeAll $ cur : map self q
        Select s -> mergeAll $ cur : map self s
        From f -> mergeAll $ cur : map self f
        Where w -> merge cur $ self w
        Limit l -> merge cur $ self l
        Offset o -> merge cur $ self o
        TypeCast e t -> mergeAll [cur, self e, self t]
        OrderBy o -> mergeAll $ cur : map self o
        OrderPair col dir -> mergeAll [cur, self col, self dir]
        GroupBy g -> merge cur (self g)

        Alias col alias -> mergeAll [cur, self col, self alias]
        Column c -> merge cur (self c)
        Model m -> merge cur (self m)
        QualifiedColumn lhs rhs -> mergeAll [cur, self lhs, self rhs]
        Variable _ _ -> visit node
        FuncCall f args -> mergeAll $ cur : map self (f:args)

        Compare _ lhs rhs -> mergeAll [cur, self lhs, self rhs]
        Arith _ lhs rhs -> mergeAll [cur, self lhs, self rhs]

        Or lhs rhs -> mergeAll [cur, self lhs, self rhs]
        And lhs rhs -> mergeAll [cur, self lhs, self rhs]

        Minus val -> mergeAll [cur, self val]
        Plus val -> mergeAll [cur, self val]
        Not val -> mergeAll [cur, self val]

        Action cmds -> mergeAll $ cur : map self cmds
        Delete model cond -> mergeAll [cur, self model, self cond]
        Update model assign cond -> mergeAll [cur, self model, self assign, self cond]
        Assign col expr -> mergeAll [cur, self col, self expr]
        HttpCmd meth url content -> mergeAll [cur, self url, self content]
        Object ps -> mergeAll $ cur : map self ps
        Array xs -> mergeAll $ cur : map self xs
        Pair k v -> mergeAll [cur, self k, self v]
        Concat a b -> mergeAll [cur, self a, self b]
        AnyColumn -> cur
        Empty -> cur
        Null -> cur
        String _ -> cur
        Float _ -> cur
        Integer _ -> cur
        Symbol _ -> cur
        Type _ -> cur
        Keyword _ -> cur
        RSTrue -> cur
        RSFalse -> cur
        All _ -> cur
        Distinct _ -> cur
        Capture sig -> mergeAll $ cur : map aux sig
            where aux (a, b) = merge (self a) (self b)
        ArrayIndex array index -> mergeAll [cur, self array, self index]
        -- otherwise -> cur