{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Map.Ordered.Internal where

import Control.Monad (guard)
import Data.Data
import Data.Foldable (Foldable, foldl', foldMap)
import Data.Function (on)
import Data.Hashable (Hashable(..))
import Data.Map (Map)
import Data.Map.Util
import Data.Monoid (Monoid(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative ((<$>))
import Data.Traversable
#endif
import Prelude hiding (filter, lookup, null)
import qualified Data.Map as M
import qualified GHC.Exts as Exts

data OMap k v = OMap !(Map k (Tag, v)) !(Map Tag (k, v))
	deriving
		( (forall a b. (a -> b) -> OMap k a -> OMap k b)
-> (forall a b. a -> OMap k b -> OMap k a) -> Functor (OMap k)
forall a b. a -> OMap k b -> OMap k a
forall a b. (a -> b) -> OMap k a -> OMap k b
forall k a b. a -> OMap k b -> OMap k a
forall k a b. (a -> b) -> OMap k a -> OMap k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> OMap k a -> OMap k b
fmap :: forall a b. (a -> b) -> OMap k a -> OMap k b
$c<$ :: forall k a b. a -> OMap k b -> OMap k a
<$ :: forall a b. a -> OMap k b -> OMap k a
Functor -- ^ @since 0.2
		, Typeable -- ^ @since 0.2
		)

-- | Values are produced in insertion order, not key order.
instance Foldable (OMap k) where foldMap :: forall m a. Monoid m => (a -> m) -> OMap k a -> m
foldMap a -> m
f (OMap Map k (Tag, a)
_ Map Tag (k, a)
kvs) = ((k, a) -> m) -> Map Tag (k, a) -> m
forall m a. Monoid m => (a -> m) -> Map Tag a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((k, a) -> a) -> (k, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, a) -> a
forall a b. (a, b) -> b
snd) Map Tag (k, a)
kvs
instance (       Eq   k, Eq   v) => Eq   (OMap k v) where == :: OMap k v -> OMap k v -> Bool
(==)    = [(k, v)] -> [(k, v)] -> Bool
forall a. Eq a => a -> a -> Bool
(==)    ([(k, v)] -> [(k, v)] -> Bool)
-> (OMap k v -> [(k, v)]) -> OMap k v -> OMap k v -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OMap k v -> [(k, v)]
forall k v. OMap k v -> [(k, v)]
assocs
instance (       Ord  k, Ord  v) => Ord  (OMap k v) where compare :: OMap k v -> OMap k v -> Ordering
compare = [(k, v)] -> [(k, v)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([(k, v)] -> [(k, v)] -> Ordering)
-> (OMap k v -> [(k, v)]) -> OMap k v -> OMap k v -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OMap k v -> [(k, v)]
forall k v. OMap k v -> [(k, v)]
assocs
instance (       Show k, Show v) => Show (OMap k v) where showsPrec :: Tag -> OMap k v -> ShowS
showsPrec = (OMap k v -> [(k, v)]) -> Tag -> OMap k v -> ShowS
forall a b. Show a => (b -> [a]) -> Tag -> b -> ShowS
showsPrecList OMap k v -> [(k, v)]
forall k v. OMap k v -> [(k, v)]
assocs
-- | Value-lazy
instance (Ord k, Read k, Read v) => Read (OMap k v) where readsPrec :: Tag -> ReadS (OMap k v)
readsPrec = ([(k, v)] -> OMap k v) -> Tag -> ReadS (OMap k v)
forall a b. Read a => ([a] -> b) -> Tag -> ReadS b
readsPrecList [(k, v)] -> OMap k v
forall k v. Ord k => [(k, v)] -> OMap k v
fromList
-- | @since 0.2.4
instance (Hashable k, Hashable v) => Hashable (OMap k v) where hashWithSalt :: Tag -> OMap k v -> Tag
hashWithSalt Tag
s = Tag -> [(k, v)] -> Tag
forall a. Hashable a => Tag -> a -> Tag
hashWithSalt Tag
s ([(k, v)] -> Tag) -> (OMap k v -> [(k, v)]) -> OMap k v -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap k v -> [(k, v)]
forall k v. OMap k v -> [(k, v)]
assocs

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.
-- | @since 0.2
instance (Data k, Data a, Ord k) => Data (OMap k a) where
	gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OMap k a -> c (OMap k a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z OMap k a
m   = ([(k, a)] -> OMap k a) -> c ([(k, a)] -> OMap k a)
forall g. g -> c g
z [(k, a)] -> OMap k a
forall k v. Ord k => [(k, v)] -> OMap k v
fromList c ([(k, a)] -> OMap k a) -> [(k, a)] -> c (OMap k a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` OMap k a -> [(k, a)]
forall k v. OMap k v -> [(k, v)]
assocs OMap k a
m
	toConstr :: OMap k a -> Constr
toConstr OMap k a
_     = Constr
fromListConstr
	gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OMap k a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Tag
constrIndex Constr
c of
		Tag
1 -> c ([(k, a)] -> OMap k a) -> c (OMap k a)
forall b r. Data b => c (b -> r) -> c r
k (([(k, a)] -> OMap k a) -> c ([(k, a)] -> OMap k a)
forall r. r -> c r
z [(k, a)] -> OMap k a
forall k v. Ord k => [(k, v)] -> OMap k v
fromList)
		Tag
_ -> String -> c (OMap k a)
forall a. HasCallStack => String -> a
error String
"gunfold"
	dataTypeOf :: OMap k a -> DataType
dataTypeOf OMap k a
_   = DataType
oMapDataType
	-- dataCast2 /must/ be eta-expanded in order to build on GHC 7.8.
	dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OMap k a))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f    = c (t k a) -> Maybe (c (OMap k a))
forall {k1} {k2} {k3} (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t k a)
forall d e. (Data d, Data e) => c (t d e)
f

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
oMapDataType String
"fromList" [] Fixity
Prefix

oMapDataType :: DataType
oMapDataType :: DataType
oMapDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Map.Ordered.Map" [Constr
fromListConstr]

-- | @'GHC.Exts.fromList' = 'fromList'@ (the value-lazy variant) and
-- @'GHC.Exts.toList' = 'assocs'@.
--
-- @since 0.2.4
instance Ord k => Exts.IsList (OMap k v) where
	type Item (OMap k v) = (k, v)
	fromList :: [Item (OMap k v)] -> OMap k v
fromList = [(k, v)] -> OMap k v
[Item (OMap k v)] -> OMap k v
forall k v. Ord k => [(k, v)] -> OMap k v
fromList
	toList :: OMap k v -> [Item (OMap k v)]
toList = OMap k v -> [(k, v)]
OMap k v -> [Item (OMap k v)]
forall k v. OMap k v -> [(k, v)]
assocs

#if MIN_VERSION_base(4,9,0)
-- | Uses the value-lazy variant of 'unionWithL'.
--
-- @since 0.2
instance (Ord k, Semigroup v) => Semigroup (Bias L (OMap k v)) where
	Bias OMap k v
o <> :: Bias L (OMap k v) -> Bias L (OMap k v) -> Bias L (OMap k v)
<> Bias OMap k v
o' = OMap k v -> Bias L (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias ((k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>)) OMap k v
o OMap k v
o')
-- | Uses the value-lazy variant of 'unionWithR'.
--
-- @since 0.2
instance (Ord k, Semigroup v) => Semigroup (Bias R (OMap k v)) where
	Bias OMap k v
o <> :: Bias R (OMap k v) -> Bias R (OMap k v) -> Bias R (OMap k v)
<> Bias OMap k v
o' = OMap k v -> Bias R (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias ((k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>)) OMap k v
o OMap k v
o')
#endif

-- | Empty maps and map union. When combining two sets that share elements, the
-- indices of the left argument are preferred, and the values are combined with
-- 'mappend'.
--
-- See the asymptotics of 'unionWithL'. Uses the value-lazy variant.
--
-- @since 0.2
instance (Ord k, Monoid v) => Monoid (Bias L (OMap k v)) where
	mempty :: Bias L (OMap k v)
mempty = OMap k v -> Bias L (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias OMap k v
forall k v. OMap k v
empty
	mappend :: Bias L (OMap k v) -> Bias L (OMap k v) -> Bias L (OMap k v)
mappend (Bias OMap k v
o) (Bias OMap k v
o') = OMap k v -> Bias L (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias ((k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a. Monoid a => a -> a -> a
mappend) OMap k v
o OMap k v
o')

-- | Empty maps and map union. When combining two sets that share elements, the
-- indices of the right argument are preferred, and the values are combined
-- with 'mappend'.
--
-- See the asymptotics of 'unionWithR'. Uses the value-lazy variant.
--
-- @since 0.2
instance (Ord k, Monoid v) => Monoid (Bias R (OMap k v)) where
	mempty :: Bias R (OMap k v)
mempty = OMap k v -> Bias R (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias OMap k v
forall k v. OMap k v
empty
	mappend :: Bias R (OMap k v) -> Bias R (OMap k v) -> Bias R (OMap k v)
mappend (Bias OMap k v
o) (Bias OMap k v
o') = OMap k v -> Bias R (OMap k v)
forall (dir :: IndexPreference) a. a -> Bias dir a
Bias ((k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a. Monoid a => a -> a -> a
mappend) OMap k v
o OMap k v
o')

-- | Values are traversed in insertion order, not key order.
--
-- /O(n*log(n))/ where /n/ is the size of the map.
--
-- @since 0.2
instance Ord k => Traversable (OMap k) where
	traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OMap k a -> f (OMap k b)
traverse a -> f b
f (OMap Map k (Tag, a)
tvs Map Tag (k, a)
kvs) = Map Tag (k, b) -> OMap k b
forall k v. Ord k => Map Tag (k, v) -> OMap k v
fromKV (Map Tag (k, b) -> OMap k b) -> f (Map Tag (k, b)) -> f (OMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((k, a) -> f (k, b)) -> Map Tag (k, a) -> f (Map Tag (k, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Tag a -> f (Map Tag b)
traverse (\(k
k,a
v) -> (,) k
k (b -> (k, b)) -> f b -> f (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v) Map Tag (k, a)
kvs

-- these are here rather than in Data.Map.Ordered to support the IsList,
-- Semigroup, and Monoid instances
infixr 5 <|, |< -- copy :
infixl 5 >|, |>
infixr 6 <>|, |<> -- copy <>

(<|) , (|<) :: Ord k => (,)  k v -> OMap k v -> OMap k v
(>|) , (|>) :: Ord k => OMap k v -> (,)  k v -> OMap k v

-- | When a key occurs in both maps, prefer the value from the second map.
--
-- See asymptotics of 'unionWithR'.
--
-- @since 0.2
(<>|) :: Ord k => OMap k v -> OMap k v -> OMap k v

-- | When a key occurs in both maps, prefer the value from the first map.
--
-- See asymptotics of 'unionWithL'.
--
-- @since 0.2
(|<>) :: Ord k => OMap k v -> OMap k v -> OMap k v

(k
k, v
v) <| :: forall k v. Ord k => (k, v) -> OMap k v -> OMap k v
<| OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap (k -> (Tag, v) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (Tag
t, v
v) Map k (Tag, v)
tvs) (Tag -> (k, v) -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Tag
t (k
k, v
v) Map Tag (k, v)
kvs) where
	t :: Tag
t = Tag -> ((Tag, v) -> Tag) -> Maybe (Tag, v) -> Tag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map Tag (k, v) -> Tag
forall a. Map Tag a -> Tag
nextLowerTag Map Tag (k, v)
kvs) (Tag, v) -> Tag
forall a b. (a, b) -> a
fst (k -> Map k (Tag, v) -> Maybe (Tag, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (Tag, v)
tvs)

(k
k, v
v) |< :: forall k v. Ord k => (k, v) -> OMap k v -> OMap k v
|< OMap k v
o = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap (k -> (Tag, v) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (Tag
t, v
v) Map k (Tag, v)
tvs) (Tag -> (k, v) -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Tag
t (k
k, v
v) Map Tag (k, v)
kvs) where
	t :: Tag
t = Map Tag (k, v) -> Tag
forall a. Map Tag a -> Tag
nextLowerTag Map Tag (k, v)
kvs
	OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs = k -> OMap k v -> OMap k v
forall k v. Ord k => k -> OMap k v -> OMap k v
delete k
k OMap k v
o

OMap k v
o >| :: forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
>| (k
k, v
v) = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap (k -> (Tag, v) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (Tag
t, v
v) Map k (Tag, v)
tvs) (Tag -> (k, v) -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Tag
t (k
k, v
v) Map Tag (k, v)
kvs) where
	t :: Tag
t = Map Tag (k, v) -> Tag
forall a. Map Tag a -> Tag
nextHigherTag Map Tag (k, v)
kvs
	OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs = k -> OMap k v -> OMap k v
forall k v. Ord k => k -> OMap k v -> OMap k v
delete k
k OMap k v
o

OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs |> :: forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
|> (k
k, v
v) = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap (k -> (Tag, v) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k (Tag
t, v
v) Map k (Tag, v)
tvs) (Tag -> (k, v) -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Tag
t (k
k, v
v) Map Tag (k, v)
kvs) where
	t :: Tag
t = Tag -> ((Tag, v) -> Tag) -> Maybe (Tag, v) -> Tag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map Tag (k, v) -> Tag
forall a. Map Tag a -> Tag
nextHigherTag Map Tag (k, v)
kvs) (Tag, v) -> Tag
forall a b. (a, b) -> a
fst (k -> Map k (Tag, v) -> Maybe (Tag, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (Tag, v)
tvs)

<>| :: forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
(<>|) = (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a b. a -> b -> a
const)
|<> :: forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
(|<>) = (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL ((v -> v -> v) -> k -> v -> v -> v
forall a b. a -> b -> a
const v -> v -> v
forall a b. a -> b -> a
const)

-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
-- second. If a key appears in both maps, the first argument's index takes
-- precedence, and the supplied function is used to combine the values.
--
-- /O(r*log(r))/ where /r/ is the size of the result
--
-- @since 0.2
unionWithL :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL :: forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithL = (Tag -> Tag -> Tag)
-> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(Tag -> Tag -> Tag)
-> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithInternal (\Tag
t Tag
t' -> Tag
t )

-- | Take the union. The first 'OMap' \'s argument's indices are lower than the
-- second. If a key appears in both maps, the second argument's index takes
-- precedence, and the supplied function is used to combine the values.
--
-- /O(r*log(r))/ where /r/ is the size of the result
--
-- @since 0.2
unionWithR :: Ord k => (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR :: forall k v.
Ord k =>
(k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithR = (Tag -> Tag -> Tag)
-> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
forall k v.
Ord k =>
(Tag -> Tag -> Tag)
-> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithInternal (\Tag
t Tag
t' -> Tag
t')

unionWithInternal :: Ord k => (Tag -> Tag -> Tag) -> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithInternal :: forall k v.
Ord k =>
(Tag -> Tag -> Tag)
-> (k -> v -> v -> v) -> OMap k v -> OMap k v -> OMap k v
unionWithInternal Tag -> Tag -> Tag
fT k -> v -> v -> v
fKV (OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) (OMap Map k (Tag, v)
tvs' Map Tag (k, v)
kvs') = Map k (Tag, v) -> OMap k v
forall k v. Ord k => Map k (Tag, v) -> OMap k v
fromTV Map k (Tag, v)
tvs'' where
	bump :: Tag
bump  = case Map Tag (k, v) -> Maybe Tag
forall a. Map Tag a -> Maybe Tag
maxTag Map Tag (k, v)
kvs  of
		Maybe Tag
Nothing -> Tag
0
		Just Tag
k  -> -Tag
kTag -> Tag -> Tag
forall a. Num a => a -> a -> a
-Tag
1
	bump' :: Tag
bump' = case Map Tag (k, v) -> Maybe Tag
forall a. Map Tag a -> Maybe Tag
minTag Map Tag (k, v)
kvs' of
		Maybe Tag
Nothing -> Tag
0
		Just Tag
k  -> -Tag
k
	tvs'' :: Map k (Tag, v)
tvs'' = (k -> (Tag, v) -> (Tag, v) -> (Tag, v))
-> Map k (Tag, v) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWithKey (\k
k (Tag
t,v
v) (Tag
t',v
v') -> (Tag -> Tag -> Tag
fT Tag
t Tag
t', k -> v -> v -> v
fKV k
k v
v v
v'))
		(((Tag, v) -> (Tag, v)) -> Map k (Tag, v) -> Map k (Tag, v)
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tag
t,v
v) -> (Tag
bump Tag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
t,v
v)) Map k (Tag, v)
tvs )
		(((Tag, v) -> (Tag, v)) -> Map k (Tag, v) -> Map k (Tag, v)
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tag
t,v
v) -> (Tag
bump'Tag -> Tag -> Tag
forall a. Num a => a -> a -> a
+Tag
t,v
v)) Map k (Tag, v)
tvs')

-- | @m \\\\ n@ deletes all the keys that exist in @n@ from @m@
--
-- /O(m*log(n))/ where /m/ is the size of the smaller map and /n/ is the size
-- of the larger map.
(\\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
o :: OMap k v
o@(OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) \\ :: forall k v v'. Ord k => OMap k v -> OMap k v' -> OMap k v
\\ o' :: OMap k v'
o'@(OMap Map k (Tag, v')
tvs' Map Tag (k, v')
kvs') = if OMap k v -> Tag
forall k a. OMap k a -> Tag
size OMap k v
o Tag -> Tag -> Bool
forall a. Ord a => a -> a -> Bool
< OMap k v' -> Tag
forall k a. OMap k a -> Tag
size OMap k v'
o'
	then (k -> v -> Bool) -> OMap k v -> OMap k v
forall k v. Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
filter (Bool -> v -> Bool
forall a b. a -> b -> a
const (Bool -> v -> Bool) -> (k -> Bool) -> k -> v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> OMap k v' -> Bool
forall k v. Ord k => k -> OMap k v -> Bool
`notMember` OMap k v'
o')) OMap k v
o
	else (k -> OMap k v -> OMap k v) -> OMap k v -> [k] -> OMap k v
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr k -> OMap k v -> OMap k v
forall k v. Ord k => k -> OMap k v -> OMap k v
delete OMap k v
o (((k, v') -> k) -> [(k, v')] -> [k]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v') -> k
forall a b. (a, b) -> a
fst (OMap k v' -> [(k, v')]
forall k v. OMap k v -> [(k, v)]
assocs OMap k v'
o'))

empty :: OMap k v
empty :: forall k v. OMap k v
empty = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap Map k (Tag, v)
forall k a. Map k a
M.empty Map Tag (k, v)
forall k a. Map k a
M.empty

-- This is here rather than in Data.Map.Ordered to support the Read and IsList
-- instances.
-- | If a key appears multiple times, the first occurrence is used for ordering
-- and the last occurrence is used for its value. The library author welcomes
-- comments on whether this default is sane.
fromList :: Ord k => [(k, v)] -> OMap k v
fromList :: forall k v. Ord k => [(k, v)] -> OMap k v
fromList = (OMap k v -> (k, v) -> OMap k v)
-> OMap k v -> [(k, v)] -> OMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OMap k v -> (k, v) -> OMap k v
forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
(|>) OMap k v
forall k v. OMap k v
empty

null :: OMap k v -> Bool
null :: forall k a. OMap k a -> Bool
null (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = Map k (Tag, v) -> Bool
forall k a. Map k a -> Bool
M.null Map k (Tag, v)
tvs

size :: OMap k v -> Int
size :: forall k a. OMap k a -> Tag
size (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = Map k (Tag, v) -> Tag
forall k a. Map k a -> Tag
M.size Map k (Tag, v)
tvs

member, notMember :: Ord k => k -> OMap k v -> Bool
member :: forall k v. Ord k => k -> OMap k v -> Bool
member    k
k (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = k -> Map k (Tag, v) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member    k
k Map k (Tag, v)
tvs
notMember :: forall k v. Ord k => k -> OMap k v -> Bool
notMember k
k (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = k -> Map k (Tag, v) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.notMember k
k Map k (Tag, v)
tvs

lookup :: Ord k => k -> OMap k v -> Maybe v
lookup :: forall k v. Ord k => k -> OMap k v -> Maybe v
lookup k
k (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = ((Tag, v) -> v) -> Maybe (Tag, v) -> Maybe v
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tag, v) -> v
forall a b. (a, b) -> b
snd (k -> Map k (Tag, v) -> Maybe (Tag, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (Tag, v)
tvs)

-- The Ord constraint is for compatibility with older (<0.5) versions of
-- containers.
-- | @filter f m@ contains exactly the key-value pairs of @m@ that satisfy @f@,
-- without changing the order they appear
filter :: Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
filter :: forall k v. Ord k => (k -> v -> Bool) -> OMap k v -> OMap k v
filter k -> v -> Bool
f (OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap ((k -> (Tag, v) -> Bool) -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\k
k (Tag
t, v
v) -> k -> v -> Bool
f k
k v
v) Map k (Tag, v)
tvs)
                               ((Tag -> (k, v) -> Bool) -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Tag
t (k
k, v
v) -> k -> v -> Bool
f k
k v
v) Map Tag (k, v)
kvs)

delete :: Ord k => k -> OMap k v -> OMap k v
delete :: forall k v. Ord k => k -> OMap k v -> OMap k v
delete k
k o :: OMap k v
o@(OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) = case k -> Map k (Tag, v) -> Maybe (Tag, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (Tag, v)
tvs of
	Maybe (Tag, v)
Nothing     -> OMap k v
o
	Just (Tag
t, v
_) -> Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap (k -> Map k (Tag, v) -> Map k (Tag, v)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
k Map k (Tag, v)
tvs) (Tag -> Map Tag (k, v) -> Map Tag (k, v)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Tag
t Map Tag (k, v)
kvs)

-- | Intersection. (The @/\\@ is intended to look a bit like the standard
-- mathematical notation for set intersection.)
--
-- See asymptotics of 'intersectionWith'.
--
-- @since 0.2
(/\|) :: Ord k => OMap k v -> OMap k v' -> OMap k v
OMap k v
o /\| :: forall k v v'. Ord k => OMap k v -> OMap k v' -> OMap k v
/\| OMap k v'
o' = (k -> v' -> v -> v) -> OMap k v' -> OMap k v -> OMap k v
forall k v v' v''.
Ord k =>
(k -> v -> v' -> v'') -> OMap k v -> OMap k v' -> OMap k v''
intersectionWith (\k
k v'
v' v
v -> v
v) OMap k v'
o' OMap k v
o

-- | Intersection. (The @/\\@ is intended to look a bit like the standard
-- mathematical notation for set intersection.)
--
-- See asymptotics of 'intersectionWith'.
--
-- @since 0.2
(|/\) :: Ord k => OMap k v -> OMap k v' -> OMap k v
OMap k v
o |/\ :: forall k v v'. Ord k => OMap k v -> OMap k v' -> OMap k v
|/\ OMap k v'
o' = (k -> v -> v' -> v) -> OMap k v -> OMap k v' -> OMap k v
forall k v v' v''.
Ord k =>
(k -> v -> v' -> v'') -> OMap k v -> OMap k v' -> OMap k v''
intersectionWith (\k
k v
v v'
v' -> v
v) OMap k v
o OMap k v'
o'

-- | Take the intersection. The first 'OMap' \'s argument's indices are used for
-- the result.
--
-- /O(m*log(n\/(m+1)) + r*log(r))/ where /m/ is the size of the smaller map, /n/
-- is the size of the larger map, and /r/ is the size of the result.
--
-- @since 0.2
intersectionWith ::
	Ord k =>
	(k -> v -> v' -> v'') ->
	OMap k v -> OMap k v' -> OMap k v''
intersectionWith :: forall k v v' v''.
Ord k =>
(k -> v -> v' -> v'') -> OMap k v -> OMap k v' -> OMap k v''
intersectionWith k -> v -> v' -> v''
f (OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) (OMap Map k (Tag, v')
tvs' Map Tag (k, v')
kvs') = Map k (Tag, v'') -> OMap k v''
forall k v. Ord k => Map k (Tag, v) -> OMap k v
fromTV
	(Map k (Tag, v'') -> OMap k v'') -> Map k (Tag, v'') -> OMap k v''
forall a b. (a -> b) -> a -> b
$ (k -> (Tag, v) -> (Tag, v') -> (Tag, v''))
-> Map k (Tag, v) -> Map k (Tag, v') -> Map k (Tag, v'')
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWithKey (\k
k (Tag
t,v
v) (Tag
t',v'
v') -> (Tag
t, k -> v -> v' -> v''
f k
k v
v v'
v')) Map k (Tag, v)
tvs Map k (Tag, v')
tvs'

fromTV :: Ord k => Map k (Tag, v) -> OMap k v
fromTV :: forall k v. Ord k => Map k (Tag, v) -> OMap k v
fromTV Map k (Tag, v)
tvs = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs where
	kvs :: Map Tag (k, v)
kvs = [(Tag, (k, v))] -> Map Tag (k, v)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Tag
t,(k
k,v
v)) | (k
k,(Tag
t,v
v)) <- Map k (Tag, v) -> [(k, (Tag, v))]
forall k a. Map k a -> [(k, a)]
M.toList Map k (Tag, v)
tvs]

fromKV :: Ord k => Map Tag (k, v) -> OMap k v
fromKV :: forall k v. Ord k => Map Tag (k, v) -> OMap k v
fromKV Map Tag (k, v)
kvs = Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
forall k v. Map k (Tag, v) -> Map Tag (k, v) -> OMap k v
OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs where
	tvs :: Map k (Tag, v)
tvs = [(k, (Tag, v))] -> Map k (Tag, v)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k
k,(Tag
t,v
v)) | (Tag
t,(k
k,v
v)) <- Map Tag (k, v) -> [(Tag, (k, v))]
forall k a. Map k a -> [(k, a)]
M.toList Map Tag (k, v)
kvs]

findIndex :: Ord k => k -> OMap k v -> Maybe Index
findIndex :: forall k v. Ord k => k -> OMap k v -> Maybe Tag
findIndex k
k o :: OMap k v
o@(OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) = do
	(Tag
t, v
_) <- k -> Map k (Tag, v) -> Maybe (Tag, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k (Tag, v)
tvs
	Tag -> Map Tag (k, v) -> Maybe Tag
forall k a. Ord k => k -> Map k a -> Maybe Tag
M.lookupIndex Tag
t Map Tag (k, v)
kvs

elemAt :: OMap k v -> Index -> Maybe (k, v)
elemAt :: forall k v. OMap k v -> Tag -> Maybe (k, v)
elemAt o :: OMap k v
o@(OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) Tag
i = do
	Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Tag
0 Tag -> Tag -> Bool
forall a. Ord a => a -> a -> Bool
<= Tag
i Bool -> Bool -> Bool
&& Tag
i Tag -> Tag -> Bool
forall a. Ord a => a -> a -> Bool
< Map Tag (k, v) -> Tag
forall k a. Map k a -> Tag
M.size Map Tag (k, v)
kvs)
	(k, v) -> Maybe (k, v)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((k, v) -> Maybe (k, v))
-> ((Tag, (k, v)) -> (k, v)) -> (Tag, (k, v)) -> Maybe (k, v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag, (k, v)) -> (k, v)
forall a b. (a, b) -> b
snd ((Tag, (k, v)) -> Maybe (k, v)) -> (Tag, (k, v)) -> Maybe (k, v)
forall a b. (a -> b) -> a -> b
$ Tag -> Map Tag (k, v) -> (Tag, (k, v))
forall k a. Tag -> Map k a -> (k, a)
M.elemAt Tag
i Map Tag (k, v)
kvs

-- | Return key-value pairs in the order they were inserted.
assocs :: OMap k v -> [(k, v)]
assocs :: forall k v. OMap k v -> [(k, v)]
assocs (OMap Map k (Tag, v)
_ Map Tag (k, v)
kvs) = ((Tag, (k, v)) -> (k, v)) -> [(Tag, (k, v))] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (Tag, (k, v)) -> (k, v)
forall a b. (a, b) -> b
snd ([(Tag, (k, v))] -> [(k, v)]) -> [(Tag, (k, v))] -> [(k, v)]
forall a b. (a -> b) -> a -> b
$ Map Tag (k, v) -> [(Tag, (k, v))]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Tag (k, v)
kvs

-- | Return key-value pairs in order of increasing key.
toAscList :: OMap k v -> [(k, v)]
toAscList :: forall k v. OMap k v -> [(k, v)]
toAscList (OMap Map k (Tag, v)
tvs Map Tag (k, v)
kvs) = ((k, (Tag, v)) -> (k, v)) -> [(k, (Tag, v))] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, (Tag
t, v
v)) -> (k
k, v
v)) ([(k, (Tag, v))] -> [(k, v)]) -> [(k, (Tag, v))] -> [(k, v)]
forall a b. (a -> b) -> a -> b
$ Map k (Tag, v) -> [(k, (Tag, v))]
forall k a. Map k a -> [(k, a)]
M.toAscList Map k (Tag, v)
tvs

-- | Convert an 'OMap' to a 'Map'.
--
-- /O(n)/, where /n/ is the size of the 'OMap'.
--
-- @since 0.2.2
toMap :: OMap k v -> Map k v
toMap :: forall k v. OMap k v -> Map k v
toMap (OMap Map k (Tag, v)
tvs Map Tag (k, v)
_) = ((Tag, v) -> v) -> Map k (Tag, v) -> Map k v
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tag, v) -> v
forall a b. (a, b) -> b
snd Map k (Tag, v)
tvs