content: module IdeSession.Strict.IntervalMap (
      StrictIntervalMap
    , dominators
    , fromList
    , toList
    , empty
    , insert
      -- * Re-exports
    , Interval(..)
    ) where
  
  import Data.IntervalMap.FingerTree (Interval(..), IntervalMap)
  import qualified Data.IntervalMap.FingerTree as IntervalMap
  import Text.Show.Pretty
  
  {-
    We maintain an interval spanning the entire map, in order to support a toList
    operation.
  -}
  
  data StrictIntervalMap v a = StrictIntervalMap {
      toLazyIntervalMap :: !(IntervalMap v a)
    , maxInterval       :: !(Maybe (Interval v))
    }
  
  instance (Ord v, Show v, Show a) => Show (StrictIntervalMap v a) where
    show m = "fromList " ++ show (toList m)
  
  instance (Ord v, PrettyVal v, PrettyVal a) => PrettyVal (StrictIntervalMap v a) where
    prettyVal m = Con "fromList" [prettyVal . map flattenIntervals . toList $ m]
      where
        flattenIntervals :: (Interval v, a) -> ((v, v), a)
        flattenIntervals (Interval lo hi, a) = ((lo, hi), a)
  
  unionInterval :: Ord v => Interval v -> Maybe (Interval v) -> Maybe (Interval v)
  unionInterval i@(Interval low high) Nothing =
    low `seq` high `seq` Just i
  unionInterval (Interval low1 high1) (Just (Interval low2 high2)) =
    let low  = min low1  low2
        high = max high1 high2
    in low `seq` high `seq` Just (Interval low high)
  
  dominators :: Ord v => Interval v -> StrictIntervalMap v a -> [(Interval v, a)]
  dominators i = IntervalMap.dominators i . toLazyIntervalMap
  
  empty :: Ord v => StrictIntervalMap v a
  empty = StrictIntervalMap IntervalMap.empty Nothing
  
  insert :: Ord v => Interval v -> a -> StrictIntervalMap v a -> StrictIntervalMap v a
  insert i a m =
    a `seq` StrictIntervalMap {
        toLazyIntervalMap = IntervalMap.insert i a $ toLazyIntervalMap m
      , maxInterval       = unionInterval i        $ maxInterval m
      }
  
  fromList :: Ord v => [(Interval v, a)] -> StrictIntervalMap v a
  fromList = foldr (\(i, a) m -> insert i a m) empty
  
  toList :: Ord v => StrictIntervalMap v a -> [(Interval v, a)]
  toList m = case maxInterval m of
               Nothing -> []
               Just i  -> IntervalMap.intersections i (toLazyIntervalMap m)
  