--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Profiteur.Parser
    ( decode
    , profileToCostCentre
    ) where


--------------------------------------------------------------------------------
import qualified Data.IntMap     as IM
import qualified Data.Scientific as Scientific
import qualified Data.Set        as Set
import qualified Data.Text       as T
import qualified Data.Text.Lazy  as TL
import qualified Data.Vector     as V
import qualified GHC.Prof        as Prof
import qualified GHC.Prof.Types  as Prof

import           Data.Maybe (fromMaybe)

--------------------------------------------------------------------------------
import           Profiteur.Core

--------------------------------------------------------------------------------
decode :: TL.Text -> Either String CostCentre
decode :: Text -> Either String CostCentre
decode Text
txt = Text -> Either String Profile
Prof.decode Text
txt Either String Profile
-> (Profile -> Either String CostCentre)
-> Either String CostCentre
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Profile -> Either String CostCentre
profileToCostCentre


--------------------------------------------------------------------------------
profileToCostCentre :: Prof.Profile -> Either String CostCentre
profileToCostCentre :: Profile -> Either String CostCentre
profileToCostCentre Profile
prof = do
    CostCentreNo
rootNo <- Either String CostCentreNo
findRoot
    CostCentreNo -> Either String CostCentre
toCostCentreByNo CostCentreNo
rootNo
  where
    tree :: Prof.CostCentreTree
    tree :: CostCentreTree
tree = Profile -> CostCentreTree
Prof.profileCostCentreTree Profile
prof

    findRoot :: Either String Prof.CostCentreNo
    findRoot :: Either String CostCentreNo
findRoot = case IntMap CostCentreNo -> [(CostCentreNo, CostCentreNo)]
forall a. IntMap a -> [(CostCentreNo, a)]
IM.toList (CostCentreTree -> IntMap CostCentreNo
Prof.costCentreParents CostCentreTree
tree) of
        []            -> String -> Either String CostCentreNo
forall a b. a -> Either a b
Left String
"Could not find root node"
        ((CostCentreNo
_, CostCentreNo
no) : [(CostCentreNo, CostCentreNo)]
_) -> CostCentreNo -> Either String CostCentreNo
forall {a}. CostCentreNo -> Either a CostCentreNo
go CostCentreNo
no
      where
        go :: CostCentreNo -> Either a CostCentreNo
go CostCentreNo
no = case CostCentreNo -> IntMap CostCentreNo -> Maybe CostCentreNo
forall a. CostCentreNo -> IntMap a -> Maybe a
IM.lookup CostCentreNo
no (CostCentreTree -> IntMap CostCentreNo
Prof.costCentreParents CostCentreTree
tree) of
            Maybe CostCentreNo
Nothing  -> CostCentreNo -> Either a CostCentreNo
forall a b. b -> Either a b
Right CostCentreNo
no
            Just CostCentreNo
par -> CostCentreNo -> Either a CostCentreNo
go CostCentreNo
par

    toCostCentreByNo :: Prof.CostCentreNo -> Either String CostCentre
    toCostCentreByNo :: CostCentreNo -> Either String CostCentre
toCostCentreByNo CostCentreNo
no = do
        CostCentre
cc <- Either String CostCentre
-> (CostCentre -> Either String CostCentre)
-> Maybe CostCentre
-> Either String CostCentre
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String CostCentre
forall a b. a -> Either a b
Left (String -> Either String CostCentre)
-> String -> Either String CostCentre
forall a b. (a -> b) -> a -> b
$ String
"Could not find CCN " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CostCentreNo -> String
forall a. Show a => a -> String
show CostCentreNo
no) CostCentre -> Either String CostCentre
forall a b. b -> Either a b
Right (Maybe CostCentre -> Either String CostCentre)
-> Maybe CostCentre -> Either String CostCentre
forall a b. (a -> b) -> a -> b
$
            CostCentreNo -> IntMap CostCentre -> Maybe CostCentre
forall a. CostCentreNo -> IntMap a -> Maybe a
IM.lookup CostCentreNo
no (CostCentreTree -> IntMap CostCentre
Prof.costCentreNodes CostCentreTree
tree)
        CostCentre -> Either String CostCentre
toCostCentreByNode CostCentre
cc

    toCostCentreByNode :: Prof.CostCentre -> Either String CostCentre
    toCostCentreByNode :: CostCentre -> Either String CostCentre
toCostCentreByNode CostCentre
cc = do
        let no :: CostCentreNo
no            = CostCentre -> CostCentreNo
Prof.costCentreNo CostCentre
cc
            childrenNodes :: [CostCentre]
childrenNodes = [CostCentre]
-> (Set CostCentre -> [CostCentre])
-> Maybe (Set CostCentre)
-> [CostCentre]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set CostCentre -> [CostCentre]
forall a. Set a -> [a]
Set.toList (Maybe (Set CostCentre) -> [CostCentre])
-> Maybe (Set CostCentre) -> [CostCentre]
forall a b. (a -> b) -> a -> b
$
                CostCentreNo -> IntMap (Set CostCentre) -> Maybe (Set CostCentre)
forall a. CostCentreNo -> IntMap a -> Maybe a
IM.lookup CostCentreNo
no (CostCentreTree -> IntMap (Set CostCentre)
Prof.costCentreChildren CostCentreTree
tree)
        Vector CostCentre
children <- (CostCentre -> Either String CostCentre)
-> Vector CostCentre -> Either String (Vector CostCentre)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM CostCentre -> Either String CostCentre
toCostCentreByNode ([CostCentre] -> Vector CostCentre
forall a. [a] -> Vector a
V.fromList [CostCentre]
childrenNodes)

        CostCentre -> Either String CostCentre
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return CostCentre
            { ccName :: Text
ccName            = CostCentre -> Text
Prof.costCentreName CostCentre
cc
            , ccModule :: Text
ccModule          = CostCentre -> Text
Prof.costCentreModule CostCentre
cc
            , ccSrc :: Text
ccSrc             = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ CostCentre -> Maybe Text
Prof.costCentreSrc CostCentre
cc
            , ccId :: Text
ccId              = String -> Text
T.pack (CostCentreNo -> String
forall a. Show a => a -> String
show (CostCentreNo -> String) -> CostCentreNo -> String
forall a b. (a -> b) -> a -> b
$ CostCentreNo
no)
            , ccEntries :: CostCentreNo
ccEntries         = Integer -> CostCentreNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CostCentre -> Integer
Prof.costCentreEntries CostCentre
cc)
            , ccIndividualTime :: Double
ccIndividualTime  = Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreIndTime CostCentre
cc)
            , ccIndividualAlloc :: Double
ccIndividualAlloc = Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreIndAlloc CostCentre
cc)
            , ccInheritedTime :: Double
ccInheritedTime   = Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreInhTime CostCentre
cc)
            , ccInheritedAlloc :: Double
ccInheritedAlloc  = Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreInhAlloc CostCentre
cc)
            , ccChildren :: Vector CostCentre
ccChildren        = Vector CostCentre
children
            }