lib/Hcompta/Lib/Map/Strict.hs

   1 module Hcompta.Lib.Map.Strict where
   2
   3 import qualified Data.Foldable as Foldable
   4 import           Data.Map.Strict (Map)
   5 import qualified Data.Map.Strict as Data.Map
   6
   7 import           Hcompta.Lib.Interval (Interval)
   8 import qualified Hcompta.Lib.Interval as Interval
   9 import qualified Hcompta.Lib.Interval.Sieve as Interval.Sieve
  10
  11 -- * Slice
  12
  13 -- | Return an 'Interval' spanning over all the keys of the given 'Map'.
  14 interval :: Ord k => Map k x -> Maybe (Interval k)
  15 interval m | Data.Map.null m = Nothing
  16 interval m =
  17         (Interval.<=..<=)
  18          (fst $ Data.Map.findMin m)
  19          (fst $ Data.Map.findMax m)
  20
  21 -- | Return non-'Data.Map.null' sub-'Map's of the given 'Map'
  22 --   sliced according to the given 'Interval.Sieve.Sieve'.
  23 slice
  24  :: Ord k
  25  => Interval.Sieve.Sieve k
  26  -> Map k x -> [Map k x]
  27 slice (Interval.Sieve.Sieve is) m =
  28         Foldable.foldr
  29          (\i ->
  30                 let l = Interval.low  i in
  31                 let h = Interval.high i in
  32                 let (_lt_l, eq_l, gt_l) = Data.Map.splitLookup (Interval.limit l) m in
  33                 let (lt_h, eq_h, _gt_h) = Data.Map.splitLookup (Interval.limit h) gt_l in
  34                 case
  35                         (case Interval.adherence l of
  36                          Interval.In  -> maybe id (Data.Map.insert (Interval.limit l)) eq_l
  37                          Interval.Out -> id) $
  38                         (case Interval.adherence h of
  39                          Interval.In  -> maybe id (Data.Map.insert (Interval.limit h)) eq_h
  40                          Interval.Out -> id) $
  41                         lt_h of
  42                  s | Data.Map.null s -> id
  43                  s -> (:) s
  44          ) [] is