The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
{-# OPTIONS_GHC -funbox-strict-fields #-}

module RestyScript.Emitter.Stats (
    Stats,
    emit,
    emitJSON
) where

import RestyScript.AST
import Text.JSON

data Stats = Stats {
    modelList :: ![String], funcList :: ![String],
    selectedMax :: !Int, joinedMax :: !Int,
    comparedCount :: !Int, queryCount :: !Int }
        deriving (Ord, Eq, Show)

instance JSON Stats where
    showJSON st =
        JSObject $ toJSObject [
                     ("modelList", showList $ modelList st),
                     ("funcList", showList $ funcList st),
                     ("selectedMax", showJSON $ selectedMax st),
                     ("joinedMax", showJSON $ joinedMax st),
                     ("comparedCount", showJSON $ comparedCount st),
                     ("queryCount", showJSON $ queryCount st)]
            where showList = JSArray . map showJSON
    readJSON = undefined

si = Stats {
    modelList = [], funcList = [],
    selectedMax = 0, joinedMax = 0,
    comparedCount = 0, queryCount = 0 }

findModel :: RSVal -> Stats -> Stats
findModel (Model (Symbol n)) st = st { modelList = [n] }
findModel (Model (Variable _ n)) st = st { modelList = ['$':n] }
findModel _ st = st

findFunc :: RSVal -> Stats -> Stats
findFunc (FuncCall (Symbol func)  _) st = st { funcList = func : (funcList st) }
findFunc (FuncCall (Variable _ func)  _) st = st { funcList = ('$':func) : (funcList st) }
findFunc _ st = st

findSelected :: RSVal -> Stats -> Stats
findSelected (Select lst) st = st { selectedMax = length lst }
findSelected _ st = st

findJoined :: RSVal -> Stats -> Stats
findJoined (From lst) st = st { joinedMax = length lst }
findJoined _ st = st

findQuery :: RSVal -> Stats -> Stats
findQuery (Query _) st = st { queryCount = 1 }
findQuery _ st = st

findCompared :: RSVal -> Stats -> Stats
findCompared (Compare _ _ _) st = st { comparedCount = 1 }
findCompared _ st = st

visit :: RSVal -> Stats
visit node = foldr (\f st -> f node st) si
    [findModel, findFunc,
     findSelected, findJoined, findCompared, findQuery]

merge :: Stats -> Stats -> Stats
merge a b = Stats {
    modelList = (modelList a) ++ (modelList b),
    funcList = (funcList a) ++ (funcList b),
    selectedMax = max (selectedMax a) (selectedMax b),
    joinedMax = max (joinedMax a) (joinedMax b),
    comparedCount = comparedCount a + comparedCount b,
    queryCount = queryCount a + queryCount b }

emit :: RSVal -> Stats
emit = traverse visit merge

emitJSON :: RSVal -> String
emitJSON = encode . emit