{-# 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