{-# 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 =
        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 forall a. ToJSON a => a -> Value
toJSON 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" forall a. Maybe a
Nothing Text
"MAIN" Maybe (Int, Text, Text)
ni forall a. a -> [a] -> [a]
: forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
+Int
1)
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Text
pack (forall a. Show a => a -> [Char]
show Int
l forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
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 (forall a. a -> Maybe a
Just Text
p) (CostCentre -> Text
label forall a b. (a -> b) -> a -> b
$ Map Word32 CostCentre
ccMap 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
        forall (m :: * -> *) a. Monad m => a -> m a
return (Value
n forall a. a -> [a] -> [a]
: [Value]
rs forall a. [a] -> [a] -> [a]
++ [Value]
os)
  in 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 (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 forall a b. (a -> b) -> a -> b
$ [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
id_string, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n
                             , Key
"ccs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Int
_, Text
v, Text
_) -> Text
v) Maybe (Int, Text, Text)
mccs
                             , Key
"c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"OTHER" (\(Int
_, Text
_, Text
c) -> Text
c) Maybe (Int, Text, Text)
mccs]
                             forall a. [a] -> [a] -> [a]
++ [Key
"parent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
p | Just Text
p <- [Maybe Text
mparent] ]