--------------------------------------------------------------------------------
{-# 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 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 forall a. IntMap a -> [(CostCentreNo, a)]
IM.toList (CostCentreTree -> IntMap CostCentreNo
Prof.costCentreParents CostCentreTree
tree) of
        []            -> forall a b. a -> Either a b
Left String
"Could not find root node"
        ((CostCentreNo
_, CostCentreNo
no) : [(CostCentreNo, CostCentreNo)]
_) -> forall {a}. CostCentreNo -> Either a CostCentreNo
go CostCentreNo
no
      where
        go :: CostCentreNo -> Either a CostCentreNo
go CostCentreNo
no = case forall a. CostCentreNo -> IntMap a -> Maybe a
IM.lookup CostCentreNo
no (CostCentreTree -> IntMap CostCentreNo
Prof.costCentreParents CostCentreTree
tree) of
            Maybe CostCentreNo
Nothing  -> 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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Could not find CCN " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CostCentreNo
no) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
            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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$
                forall a. CostCentreNo -> IntMap a -> Maybe a
IM.lookup CostCentreNo
no (CostCentreTree -> IntMap (Set CostCentre)
Prof.costCentreChildren CostCentreTree
tree)
        Vector CostCentre
children <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM CostCentre -> Either String CostCentre
toCostCentreByNode (forall a. [a] -> Vector a
V.fromList [CostCentre]
childrenNodes)

        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             = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ CostCentre -> Maybe Text
Prof.costCentreSrc CostCentre
cc
            , ccId :: Text
ccId              = String -> Text
T.pack (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ CostCentreNo
no)
            , ccEntries :: CostCentreNo
ccEntries         = forall a b. (Integral a, Num b) => a -> b
fromIntegral (CostCentre -> Integer
Prof.costCentreEntries CostCentre
cc)
            , ccIndividualTime :: Double
ccIndividualTime  = forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreIndTime CostCentre
cc)
            , ccIndividualAlloc :: Double
ccIndividualAlloc = forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreIndAlloc CostCentre
cc)
            , ccInheritedTime :: Double
ccInheritedTime   = forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreInhTime CostCentre
cc)
            , ccInheritedAlloc :: Double
ccInheritedAlloc  = forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat (CostCentre -> Scientific
Prof.costCentreInhAlloc CostCentre
cc)
            , ccChildren :: Vector CostCentre
ccChildren        = Vector CostCentre
children
            }