Data/Interval/Map/Strict.hs

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