{-# LANGUAGE OverloadedStrings #-}
module Eventlog.Trie where

import Prelude hiding (init, lookup)
import Data.Text (Text, pack)

import Eventlog.Types
import Data.Word
import qualified Data.Map as Map
import Data.Map ((!))
import qualified Data.Trie.Map as Trie
import qualified Data.Trie.Map.Internal as TrieI
import Data.Aeson
import Control.Monad.State

outputTree :: Map.Map Word32 CostCentre -> [(Bucket, (Int, BucketInfo))]
           -> Value
outputTree :: Map Word32 CostCentre -> [(Bucket, (Int, BucketInfo))] -> Value
outputTree Map Word32 CostCentre
ccMap [(Bucket, (Int, BucketInfo))]
mdescs =
  let t :: TMap Word32 (Int, Text, Text)
t =
        [([Word32], (Int, Text, Text))] -> TMap Word32 (Int, Text, Text)
forall c a. Ord c => [([c], a)] -> TMap c a
Trie.fromList [([Word32]
k, (Int
i, Text
b, Text
v)) | (Bucket Text
b, (Int
i, BucketInfo { shortDescription :: BucketInfo -> Text
shortDescription = Text
v
                                                                  , longDescription :: BucketInfo -> Maybe [Word32]
longDescription = (Just [Word32]
k) }))
                                                                  <- [(Bucket, (Int, BucketInfo))]
mdescs ]
  in [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ Map Word32 CostCentre -> TMap Word32 (Int, Text, Text) -> [Value]
outputTrie Map Word32 CostCentre
ccMap TMap Word32 (Int, Text, Text)
t

outputTrie :: Map.Map Word32 CostCentre -> Trie.TMap Word32 (Int, Text, Text) -> [Value]
outputTrie :: Map Word32 CostCentre -> TMap Word32 (Int, Text, Text) -> [Value]
outputTrie Map Word32 CostCentre
ccMap (TrieI.TMap (TrieI.Node Maybe (Int, Text, Text)
ni Map Word32 (TMap Word32 (Int, Text, Text))
m))  =
    Text -> Maybe Text -> Text -> Maybe (Int, Text, Text) -> Value
mkNode Text
"TOP" Maybe Text
forall a. Maybe a
Nothing Text
"MAIN" Maybe (Int, Text, Text)
ni Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (State Int [Value] -> Int -> [Value])
-> Int -> State Int [Value] -> [Value]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [Value] -> Int -> [Value]
forall s a. State s a -> s -> a
evalState Int
0 (Map Word32 CostCentre
-> Text
-> Map Word32 (TMap Word32 (Int, Text, Text))
-> State Int [Value]
outputTrieLoop Map Word32 CostCentre
ccMap Text
"TOP" Map Word32 (TMap Word32 (Int, Text, Text))
m)

newLabel :: Word32 -> State Int Text
newLabel :: Word32 -> State Int Text
newLabel Word32
n = do
  Int
l <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
  (Int -> Int) -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  Text -> State Int Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
n))


outputTrieLoop :: Map.Map Word32 CostCentre
               -> Text
               -> Map.Map Word32 (Trie.TMap Word32 (Int, Text, Text))
               -> State Int [Value]
outputTrieLoop :: Map Word32 CostCentre
-> Text
-> Map Word32 (TMap Word32 (Int, Text, Text))
-> State Int [Value]
outputTrieLoop Map Word32 CostCentre
ccMap Text
p Map Word32 (TMap Word32 (Int, Text, Text))
cs =
  let go :: Word32
-> TMap Word32 (Int, Text, Text)
-> State Int [Value]
-> State Int [Value]
go Word32
p' (TrieI.TMap (TrieI.Node Maybe (Int, Text, Text)
mv Map Word32 (TMap Word32 (Int, Text, Text))
cs')) State Int [Value]
rest = do
        Text
nid <- Word32 -> State Int Text
newLabel Word32
p'
        let n :: Value
n = Text -> Maybe Text -> Text -> Maybe (Int, Text, Text) -> Value
mkNode Text
nid (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p) (CostCentre -> Text
label (CostCentre -> Text) -> CostCentre -> Text
forall a b. (a -> b) -> a -> b
$ Map Word32 CostCentre
ccMap Map Word32 CostCentre -> Word32 -> CostCentre
forall k a. Ord k => Map k a -> k -> a
! Word32
p') Maybe (Int, Text, Text)
mv
        [Value]
rs <- Map Word32 CostCentre
-> Text
-> Map Word32 (TMap Word32 (Int, Text, Text))
-> State Int [Value]
outputTrieLoop Map Word32 CostCentre
ccMap Text
nid Map Word32 (TMap Word32 (Int, Text, Text))
cs'
        [Value]
os <- State Int [Value]
rest
        [Value] -> State Int [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
n Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
rs [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
os)
  in (Word32
 -> TMap Word32 (Int, Text, Text)
 -> State Int [Value]
 -> State Int [Value])
-> State Int [Value]
-> Map Word32 (TMap Word32 (Int, Text, Text))
-> State Int [Value]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Word32
-> TMap Word32 (Int, Text, Text)
-> State Int [Value]
-> State Int [Value]
go ([Value] -> State Int [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return []) Map Word32 (TMap Word32 (Int, Text, Text))
cs

mkNode :: Text -> Maybe Text -> Text -> Maybe (Int, Text, Text) -> Value
mkNode :: Text -> Maybe Text -> Text -> Maybe (Int, Text, Text) -> Value
mkNode Text
id_string Maybe Text
mparent Text
n Maybe (Int, Text, Text)
mccs = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Text
"id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
id_string, Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
n
                             , Text
"ccs" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
-> ((Int, Text, Text) -> Text) -> Maybe (Int, Text, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Int
_, Text
v, Text
_) -> Text
v) Maybe (Int, Text, Text)
mccs
                             , Text
"c" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
-> ((Int, Text, Text) -> Text) -> Maybe (Int, Text, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"OTHER" (\(Int
_, Text
_, Text
c) -> Text
c) Maybe (Int, Text, Text)
mccs]
                             [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Text
"parent" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
p | Just Text
p <- [Maybe Text
mparent] ]