module NLP.GenI.Statistics(Statistics, StatisticsState,
emptyStats,
showFinalStats,
initialStatisticsStateFor,
addMetric,
Metric(IntMetric), queryMetrics, updateMetrics,
incrIntMetric, queryIntMetric,
) where
import Control.Applicative ( (<$>) )
import Control.Monad.State
import Data.Maybe (mapMaybe)
import Text.JSON
import Control.DeepSeq
newtype Statistics = Stat{ metrics::[Metric] }
type StatisticsState a = forall m. (MonadState Statistics m) => m a
updateMetrics :: (Metric -> Metric) -> Statistics -> Statistics
updateMetrics f stat = stat{metrics = map f (metrics stat) }
queryMetrics :: (Metric -> Maybe a) -> Statistics -> [a]
queryMetrics f = mapMaybe f . metrics
emptyStats :: Statistics
emptyStats = Stat []
initialStatisticsStateFor :: (MonadState Statistics m) => (m a -> Statistics -> b) -> m a -> b
initialStatisticsStateFor f = flip f emptyStats
addMetric :: Metric -> StatisticsState ()
addMetric newMetric = modify (\stat -> stat{metrics = newMetric : metrics stat } )
showFinalStats :: Statistics -> String
showFinalStats = unlines . map show . reverse . metrics
data Metric = IntMetric String Int
instance Show Metric where
show (IntMetric s x) = s ++ " : " ++ show x
incrIntMetric :: String -> Int -> Metric -> Metric
incrIntMetric key i (IntMetric s c) | s == key = IntMetric s (c+i)
incrIntMetric _ _ m = m
queryIntMetric :: String -> Metric -> Maybe Int
queryIntMetric key (IntMetric s c) | s == key = Just c
queryIntMetric _ _ = Nothing
instance JSON Statistics where
readJSON (JSObject j) = do
Stat <$> mapM jsonToMetric (fromJSObject j)
readJSON j = fail $
"Expected a JSON object, but got " ++ show j ++ " instead"
showJSON = JSObject . toJSObject . map metricToJSON . metrics
metricToJSON :: Metric -> (String, JSValue)
metricToJSON (IntMetric s i) = (s, showJSON i)
jsonToMetric :: (String, JSValue) -> Result Metric
jsonToMetric (s, i) = IntMetric s <$> readJSON i
instance NFData Statistics where
rnf (Stat x1) = rnf x1 `seq` ()
instance NFData Metric where
rnf (IntMetric x1 x2) = rnf x1 `seq` rnf x2 `seq` ()