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