Utility.hs

{- TooManyCells.MakeTree.Utility
Gregory W. Schwartz

Collects utility functions for the tree.
-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

module TooManyCells.MakeTree.Utility
    ( updateTreeRowIndex
    , updateTreeRowBool
    , projectionMapToCoordinateMap
    ) where

-- Remote
import BirchBeer.Types
import Data.Maybe (fromMaybe)
import Data.Tree (Tree)
import qualified Control.Lens as L
import qualified Data.HashMap.Strict as HMap
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Sparse.Common as S
import qualified Data.Vector as V

-- Local
import TooManyCells.MakeTree.Types
import TooManyCells.Matrix.Types

-- | Update the CellInfo row index with new matrix row index values.
updateTreeRowIndex :: SingleCells
                   -> Tree (TreeNode (V.Vector CellInfo))
                   -> Tree (TreeNode (V.Vector CellInfo))
updateTreeRowIndex sc = fmap (L.over item (fmap (V.mapMaybe updateCell)))
  where
    cellRowMap =
      HMap.fromList . flip zip (fmap Row [0..]) . V.toList . getRowNames $ sc
    updateCell c = do
      newRow <- flip HMap.lookup cellRowMap
                  . unCell
                  . L.view barcode
                  $ c
      return $ L.set cellRow newRow c

-- | updateTreeRowIndex meant to be called from the main program with these
-- options.
updateTreeRowBool :: UpdateTreeRowsFlag
                  -> Maybe SingleCells
                  -> Tree (TreeNode (V.Vector CellInfo))
                  -> Tree (TreeNode (V.Vector CellInfo))
updateTreeRowBool (UpdateTreeRowsFlag False) _ tree = tree
updateTreeRowBool (UpdateTreeRowsFlag True) Nothing tree = tree
updateTreeRowBool (UpdateTreeRowsFlag True) (Just sc) tree =
  updateTreeRowIndex sc tree

-- | Convert ProjectionMap to CoordinateMap for birch-beer.
projectionMapToCoordinateMap :: ProjectionMap -> CoordinateMap
projectionMapToCoordinateMap = CoordinateMap
  . Map.map (L.over L._2 (\(X !x, Y !y) -> S.fromListDenseSV 2 [x, y]))
  . Map.mapKeys (Id . unCell)
  . unProjectionMap