{-# 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
}