{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.Map.Ordered.Strict
( OMap
, empty, singleton
, (<|), (|<), (>|), (|>)
, (<>|), (|<>), unionWithL, unionWithR
, Bias(Bias, unbiased), L, R
, delete, filter, (\\)
, (|/\), (/\|), intersectionWith
, null, size, member, notMember, lookup
, Index, findIndex, elemAt
, fromList, assocs, toAscList
, toMap
) where
import Data.Foldable (foldl')
import qualified Data.Map.Strict as M
import Data.Map.Ordered.Internal
( OMap(..), empty, (<>|), (|<>), delete, filter, (\\), (|/\), (/\|), null, size
, member, notMember, lookup, findIndex, elemAt, assocs, toAscList, fromTV, toMap )
import Data.Map.Util
import Prelude hiding (filter, lookup, null)
infixr 5 <|, |<
infixl 5 >|, |>
(<|) , (|<) :: Ord k => (,) k v -> OMap k v -> OMap k v
(>|) , (|>) :: Ord k => OMap k v -> (,) k v -> OMap k v
(k, v) <| OMap tvs kvs = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
t = maybe (nextLowerTag kvs) fst (M.lookup k tvs)
(k, v) |< o = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
t = nextLowerTag kvs
OMap tvs kvs = delete k o
o >| (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
t = nextHigherTag kvs
OMap tvs kvs = delete k o
OMap tvs kvs |> (k, v) = OMap (M.insert k (t, v) tvs) (M.insert t (k, v) kvs) where
t = maybe (nextHigherTag kvs) fst (M.lookup k tvs)
unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL = unionWithInternal (\t t' -> t )
unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR = unionWithInternal (\t t' -> t')
unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithInternal fT fKV (OMap tvs kvs) (OMap tvs' kvs') = fromTV tvs'' where
bump = case maxTag kvs of
Nothing -> 0
Just k -> -k-1
bump' = case minTag kvs' of
Nothing -> 0
Just k -> -k
tvs'' = M.unionWithKey (\k (t,v) (t',v') -> (fT t t', fKV k v v'))
(fmap (\(t,v) -> (bump +t,v)) tvs )
(fmap (\(t,v) -> (bump'+t,v)) tvs')
singleton :: (k, v) -> OMap k v
singleton kv@(k, v) = OMap (M.singleton k (0, v)) (M.singleton 0 kv)
fromList :: Ord k => [(k, v)] -> OMap k v
fromList = foldl' (|>) empty
intersectionWith ::
Ord k =>
(k -> v -> v' -> v'') ->
OMap k v -> OMap k v' -> OMap k v''
intersectionWith f (OMap tvs kvs) (OMap tvs' kvs') = fromTV
$ M.intersectionWithKey (\k (t,v) (t',v') -> (t, f k v v')) tvs tvs'