buildTree :: [(Level, CostCentre)] -> CostCentreTree
buildTree = snd . foldl' go (TreePath 0 [], emptyCostCentreTree)
  where
    go
      :: (TreePath, CostCentreTree)
      -> (Level, CostCentre)
      -> (TreePath, CostCentreTree)
    go (!path, !CostCentreTree {..}) (level, node) = (path', tree')
      where
        ccNo = costCentreNo node
        parentPath = popTo level path
        parentNo = currentNo parentPath
        path' = push ccNo parentPath
        tree' = CostCentreTree
          { costCentreNodes = IntMap.insert ccNo node costCentreNodes
          , costCentreParents = maybe costCentreParents
            (\parent -> IntMap.insert ccNo parent costCentreParents)
            parentNo
          , costCentreChildren = maybe costCentreChildren
            (\parent -> IntMap.insertWith Set.union parent
              (Set.singleton node)
              costCentreChildren)
            parentNo
          , costCentreCallSites = Map.insertWith Set.union
            (costCentreName node, costCentreModule node)
            (Set.singleton node)
            costCentreCallSites
          , costCentreAggregate = Map.alter
            (Just . updateCostCentre)
            (costCentreModule node)
            costCentreAggregate
          }
        aggregate = AggregatedCostCentre
          { aggregatedCostCentreName = costCentreName node
          , aggregatedCostCentreModule = costCentreModule node
          , aggregatedCostCentreSrc = costCentreSrc node
          , aggregatedCostCentreEntries = Just $! costCentreEntries node
          , aggregatedCostCentreTime = costCentreIndTime node
          , aggregatedCostCentreAlloc = costCentreIndAlloc node
          , aggregatedCostCentreTicks = costCentreTicks node
          , aggregatedCostCentreBytes = costCentreBytes node
          }
        updateCostCentre
          :: Maybe (Map.Map Text AggregatedCostCentre)
          -> Map.Map Text AggregatedCostCentre
        updateCostCentre = \case
          Nothing -> Map.singleton (costCentreName node) aggregate
          Just costCentreByName ->
            Map.insertWith
              addCostCentre
              (costCentreName node)
              aggregate
              costCentreByName
        addCostCentre x y = x
          { aggregatedCostCentreEntries = seqM $ (+)
            <$> aggregatedCostCentreEntries x
            <*> aggregatedCostCentreEntries y
          , aggregatedCostCentreTime =
            aggregatedCostCentreTime x + aggregatedCostCentreTime y
          , aggregatedCostCentreAlloc =
            aggregatedCostCentreAlloc x + aggregatedCostCentreAlloc y
          , aggregatedCostCentreTicks = seqM $ (+)
            <$> aggregatedCostCentreTicks x
            <*> aggregatedCostCentreTicks y
          , aggregatedCostCentreBytes = seqM $ (+)
            <$> aggregatedCostCentreBytes x
            <*> aggregatedCostCentreBytes y
          }
buildTree :: [(Level, CostCentre)] -> CostCentreTree
buildTree = snd . foldl' go (TreePath 0 [], emptyCostCentreTree)
  where
    go
      :: (TreePath, CostCentreTree)
      -> (Level, CostCentre)
      -> (TreePath, CostCentreTree)
    go (!path, !CostCentreTree {..}) (level, node) = (path', tree')
      where
        ccNo = costCentreNo node
        parentPath = popTo level path
        parentNo = currentNo parentPath
        path' = push ccNo parentPath
        tree' = CostCentreTree
          { costCentreNodes = IntMap.insert ccNo node costCentreNodes
          , costCentreParents = maybe costCentreParents
            (\parent -> IntMap.insert ccNo parent costCentreParents)
            parentNo
          , costCentreChildren = maybe costCentreChildren
            (\parent -> IntMap.insertWith Set.union parent
              (Set.singleton node)
              costCentreChildren)
            parentNo
          , costCentreCallSites = Map.insertWith Set.union
            (costCentreName node, costCentreModule node)
            (Set.singleton node)
            costCentreCallSites
          , costCentreAggregate = Map.alter
            (Just . updateCostCentre)
            (costCentreModule node)
            costCentreAggregate
          }
        aggregate = AggregatedCostCentre
          { aggregatedCostCentreName = costCentreName node
          , aggregatedCostCentreModule = costCentreModule node
          , aggregatedCostCentreSrc = costCentreSrc node
          , aggregatedCostCentreEntries = Just $! costCentreEntries node
          , aggregatedCostCentreTime = costCentreIndTime node
          , aggregatedCostCentreAlloc = costCentreIndAlloc node
          , aggregatedCostCentreTicks = costCentreTicks node
          , aggregatedCostCentreBytes = costCentreBytes node
          }
        updateCostCentre
          :: Maybe (Map.Map Text AggregatedCostCentre)
          -> Map.Map Text AggregatedCostCentre
        updateCostCentre = \case
          Nothing -> Map.singleton (costCentreName node) aggregate
          Just costCentreByName ->
            Map.insertWith
              addCostCentre
              (costCentreName node)
              aggregate
              costCentreByName
        addCostCentre x y = x
          { aggregatedCostCentreEntries = seqM $ (+)
            <$> aggregatedCostCentreEntries x
            <*> aggregatedCostCentreEntries y
          , aggregatedCostCentreTime =
            aggregatedCostCentreTime x + aggregatedCostCentreTime y
          , aggregatedCostCentreAlloc =
            aggregatedCostCentreAlloc x + aggregatedCostCentreAlloc y
          , aggregatedCostCentreTicks = seqM $ (+)
            <$> aggregatedCostCentreTicks x
            <*> aggregatedCostCentreTicks y
          , aggregatedCostCentreBytes = seqM $ (+)
            <$> aggregatedCostCentreBytes x
            <*> aggregatedCostCentreBytes y
          }
buildTree = snd . foldl' go (TreePath 0 [], emptyCostCentreTree)
  where
    go
      :: (TreePath, CostCentreTree)
      -> (Level, CostCentre)
      -> (TreePath, CostCentreTree)
    go (!path, !CostCentreTree {..}) (level, node) = (path', tree')
      where
        ccNo = costCentreNo node
        parentPath = popTo level path
        parentNo = currentNo parentPath
        path' = push ccNo parentPath
        tree' = CostCentreTree
          { costCentreNodes = IntMap.insert ccNo node costCentreNodes
          , costCentreParents = maybe costCentreParents
            (\parent -> IntMap.insert ccNo parent costCentreParents)
            parentNo
          , costCentreChildren = maybe costCentreChildren
            (\parent -> IntMap.insertWith Set.union parent
              (Set.singleton node)
              costCentreChildren)
            parentNo
          , costCentreCallSites = Map.insertWith Set.union
            (costCentreName node, costCentreModule node)
            (Set.singleton node)
            costCentreCallSites
          , costCentreAggregate = Map.alter
            (Just . updateCostCentre)
            (costCentreModule node)
            costCentreAggregate
          }
        aggregate = AggregatedCostCentre
          { aggregatedCostCentreName = costCentreName node
          , aggregatedCostCentreModule = costCentreModule node
          , aggregatedCostCentreSrc = costCentreSrc node
          , aggregatedCostCentreEntries = Just $! costCentreEntries node
          , aggregatedCostCentreTime = costCentreIndTime node
          , aggregatedCostCentreAlloc = costCentreIndAlloc node
          , aggregatedCostCentreTicks = costCentreTicks node
          , aggregatedCostCentreBytes = costCentreBytes node
          }
        updateCostCentre
          :: Maybe (Map.Map Text AggregatedCostCentre)
          -> Map.Map Text AggregatedCostCentre
        updateCostCentre = \case
          Nothing -> Map.singleton (costCentreName node) aggregate
          Just costCentreByName ->
            Map.insertWith
              addCostCentre
              (costCentreName node)
              aggregate
              costCentreByName
        addCostCentre x y = x
          { aggregatedCostCentreEntries = seqM $ (+)
            <$> aggregatedCostCentreEntries x
            <*> aggregatedCostCentreEntries y
          , aggregatedCostCentreTime =
            aggregatedCostCentreTime x + aggregatedCostCentreTime y
          , aggregatedCostCentreAlloc =
            aggregatedCostCentreAlloc x + aggregatedCostCentreAlloc y
          , aggregatedCostCentreTicks = seqM $ (+)
            <$> aggregatedCostCentreTicks x
            <*> aggregatedCostCentreTicks y
          , aggregatedCostCentreBytes = seqM $ (+)
            <$> aggregatedCostCentreBytes x
            <*> aggregatedCostCentreBytes y
          }