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

-- | An 'OSet' behaves much like a 'Set', with mostly the same asymptotics, but
-- also remembers the order that values were inserted. All operations whose
-- asymptotics are worse than 'Set' have documentation saying so.
module Data.Set.Ordered
	( OSet
	-- * Trivial sets
	, empty, singleton
	-- * Insertion
	-- | Conventions:
	--
	-- * The open side of an angle bracket points to an 'OSet'
	--
	-- * The pipe appears on the side whose indices take precedence for keys that appear on both sides
	--
	-- * The left argument's indices are lower than the right argument's indices
	, (<|), (|<), (>|), (|>)
	, (<>|), (|<>)
	, Bias(Bias, unbiased), L, R
	-- * Query
	, null, size, member, notMember
	-- * Deletion
	, delete, filter, (\\), (|/\), (/\|)
	-- * Indexing
	, Index, findIndex, elemAt
	-- * List conversions
	, fromList, toAscList
	-- * 'Set' conversion
	, toSet
	) where

import Control.Monad (guard)
import Data.Data
import Data.Foldable (Foldable, foldl', foldMap, foldr, toList)
import Data.Function (on)
import Data.Map (Map)
import Data.Map.Util
import Data.Monoid (Monoid(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Set (Set) -- so the haddocks link to the right place
import Prelude hiding (filter, foldr, lookup, null)
import qualified Data.Map as M

data OSet a = OSet !(Map a Tag) !(Map Tag a)
	deriving Typeable

-- | Values appear in insertion order, not ascending order.
instance Foldable OSet where foldMap :: forall m a. Monoid m => (a -> m) -> OSet a -> m
foldMap a -> m
f (OSet Map a Int
_ Map Int a
vs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Int a
vs
instance         Eq   a  => Eq   (OSet a) where == :: OSet a -> OSet a -> Bool
(==)    = forall a. Eq a => a -> a -> Bool
(==)    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance         Ord  a  => Ord  (OSet a) where compare :: OSet a -> OSet a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance         Show a  => Show (OSet a) where showsPrec :: Int -> OSet a -> ShowS
showsPrec = forall a b. Show a => (b -> [a]) -> Int -> b -> ShowS
showsPrecList forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance (Ord a, Read a) => Read (OSet a) where readsPrec :: Int -> ReadS (OSet a)
readsPrec = forall a b. Read a => ([a] -> b) -> Int -> ReadS b
readsPrecList forall a. Ord a => [a] -> OSet a
fromList

-- This instance preserves data abstraction at the cost of inefficiency.
-- We provide limited reflection services for the sake of data abstraction.
instance (Data a, Ord a) => Data (OSet a) where
	gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OSet a -> c (OSet a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z OSet a
set = forall g. g -> c g
z forall a. Ord a => [a] -> OSet a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OSet a
set
	toConstr :: OSet a -> Constr
toConstr OSet a
_     = Constr
fromListConstr
	gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (OSet a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c  = case Constr -> Int
constrIndex Constr
c of
		Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. Ord a => [a] -> OSet a
fromList)
		Int
_ -> forall a. HasCallStack => String -> a
error String
"gunfold"
	dataTypeOf :: OSet a -> DataType
dataTypeOf OSet a
_   = DataType
oSetDataType
	-- dataCast1 /must/ be eta-expanded in order to build on GHC 7.8.
	dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (OSet a))
dataCast1 forall d. Data d => c (t d)
f    = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

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

oSetDataType :: DataType
oSetDataType :: DataType
oSetDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Set.Ordered.Set" [Constr
fromListConstr]

#if MIN_VERSION_base(4,9,0)
instance Ord a => Semigroup (Bias L (OSet a)) where Bias OSet a
o <> :: Bias L (OSet a) -> Bias L (OSet a) -> Bias L (OSet a)
<> Bias OSet a
o' = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias (OSet a
o forall a. Ord a => OSet a -> OSet a -> OSet a
|<> OSet a
o')
instance Ord a => Semigroup (Bias R (OSet a)) where Bias OSet a
o <> :: Bias R (OSet a) -> Bias R (OSet a) -> Bias R (OSet a)
<> Bias OSet a
o' = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias (OSet a
o forall a. Ord a => OSet a -> OSet a -> OSet a
<>| OSet a
o')
#endif

-- | Empty sets and set union. When combining two sets that share elements, the
-- indices of the left argument are preferred.
--
-- See the asymptotics of ('|<>').
instance Ord a => Monoid (Bias L (OSet a)) where
	mempty :: Bias L (OSet a)
mempty = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias forall a. OSet a
empty
	mappend :: Bias L (OSet a) -> Bias L (OSet a) -> Bias L (OSet a)
mappend (Bias OSet a
o) (Bias OSet a
o') = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias (OSet a
o forall a. Ord a => OSet a -> OSet a -> OSet a
|<> OSet a
o')

-- | Empty sets and set union. When combining two sets that share elements, the
-- indices of the right argument are preferred.
--
-- See the asymptotics of ('<>|').
instance Ord a => Monoid (Bias R (OSet a)) where
	mempty :: Bias R (OSet a)
mempty = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias forall a. OSet a
empty
	mappend :: Bias R (OSet a) -> Bias R (OSet a) -> Bias R (OSet a)
mappend (Bias OSet a
o) (Bias OSet a
o') = forall (dir :: IndexPreference) a. a -> Bias dir a
Bias (OSet a
o forall a. Ord a => OSet a -> OSet a -> OSet a
<>| OSet a
o')

infixr 5 <|, |<   -- copy :
infixl 5 >|, |>
infixr 6 <>|, |<> -- copy <>

(<|) , (|<)  :: Ord a =>      a -> OSet a -> OSet a
(>|) , (|>)  :: Ord a => OSet a ->      a -> OSet a

-- | /O(m*log(n)+n)/, where /m/ is the size of the smaller set and /n/ is the
-- size of the larger set.
(<>|) :: Ord a => OSet a -> OSet a -> OSet a

-- | /O(m*log(n)+n)/, where /m/ is the size of the smaller set and /n/ is the
-- size of the larger set.
(|<>) :: Ord a => OSet a -> OSet a -> OSet a

a
v <| :: forall a. Ord a => a -> OSet a -> OSet a
<| o :: OSet a
o@(OSet Map a Int
ts Map Int a
vs)
	| a
v forall a. Ord a => a -> OSet a -> Bool
`member` OSet a
o = OSet a
o
	| Bool
otherwise    = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
t Map a Int
ts) (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
t a
v Map Int a
vs) where
		t :: Int
t = forall a. Map Int a -> Int
nextLowerTag Map Int a
vs

a
v |< :: forall a. Ord a => a -> OSet a -> OSet a
|< OSet a
o = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
t Map a Int
ts) (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
t a
v Map Int a
vs) where
	t :: Int
t = forall a. Map Int a -> Int
nextLowerTag Map Int a
vs
	OSet Map a Int
ts Map Int a
vs = forall a. Ord a => a -> OSet a -> OSet a
delete a
v OSet a
o

o :: OSet a
o@(OSet Map a Int
ts Map Int a
vs) |> :: forall a. Ord a => OSet a -> a -> OSet a
|> a
v
	| a
v forall a. Ord a => a -> OSet a -> Bool
`member` OSet a
o = OSet a
o
	| Bool
otherwise    = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
t Map a Int
ts) (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
t a
v Map Int a
vs) where
		t :: Int
t = forall a. Map Int a -> Int
nextHigherTag Map Int a
vs

OSet a
o >| :: forall a. Ord a => OSet a -> a -> OSet a
>| a
v = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
v Int
t Map a Int
ts) (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
t a
v Map Int a
vs) where
	t :: Int
t = forall a. Map Int a -> Int
nextHigherTag Map Int a
vs
	OSet Map a Int
ts Map Int a
vs = forall a. Ord a => a -> OSet a -> OSet a
delete a
v OSet a
o

OSet a
o <>| :: forall a. Ord a => OSet a -> OSet a -> OSet a
<>| OSet a
o' = forall a. Ord a => OSet a -> OSet a -> OSet a
unsafeMappend (OSet a
o forall a. Ord a => OSet a -> OSet a -> OSet a
\\ OSet a
o') OSet a
o'
OSet a
o |<> :: forall a. Ord a => OSet a -> OSet a -> OSet a
|<> OSet a
o' = forall a. Ord a => OSet a -> OSet a -> OSet a
unsafeMappend OSet a
o (OSet a
o' forall a. Ord a => OSet a -> OSet a -> OSet a
\\ OSet a
o)

-- assumes that ts and ts' have disjoint keys
unsafeMappend :: OSet a -> OSet a -> OSet a
unsafeMappend (OSet Map a Int
ts Map Int a
vs) (OSet Map a Int
ts' Map Int a
vs')
	= forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map a Int
tsBumped Map a Int
tsBumped')
	       (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Int a
vsBumped Map Int a
vsBumped')
	where
	bump :: Int
bump  = case forall a. Map Int a -> Maybe Int
maxTag Map Int a
vs  of
		Maybe Int
Nothing -> Int
0
		Just Int
k  -> -Int
kforall a. Num a => a -> a -> a
-Int
1
	bump' :: Int
bump' = case forall a. Map Int a -> Maybe Int
minTag Map Int a
vs' of
		Maybe Int
Nothing -> Int
0
		Just Int
k  -> -Int
k
	tsBumped :: Map a Int
tsBumped  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
bump forall a. Num a => a -> a -> a
+) Map a Int
ts
	tsBumped' :: Map a Int
tsBumped' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int
bump'forall a. Num a => a -> a -> a
+) Map a Int
ts'
	vsBumped :: Map Int a
vsBumped  = (Int
bump forall a. Num a => a -> a -> a
+) forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
`M.mapKeysMonotonic` Map Int a
vs
	vsBumped' :: Map Int a
vsBumped' = (Int
bump'forall a. Num a => a -> a -> a
+) forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
`M.mapKeysMonotonic` Map Int a
vs'

-- | Set difference: @r \\\\ s@ deletes all the values in @s@ from @r@. The
-- order of @r@ is unchanged.
--
-- /O(m*log(n))/ where /m/ is the size of the smaller set and /n/ is the size
-- of the larger set.
(\\) :: Ord a => OSet a -> OSet a -> OSet a
o :: OSet a
o@(OSet Map a Int
ts Map Int a
vs) \\ :: forall a. Ord a => OSet a -> OSet a -> OSet a
\\ o' :: OSet a
o'@(OSet Map a Int
ts' Map Int a
vs') = if forall a. OSet a -> Int
size OSet a
o forall a. Ord a => a -> a -> Bool
< forall a. OSet a -> Int
size OSet a
o'
	then forall a. Ord a => (a -> Bool) -> OSet a -> OSet a
filter (forall a. Ord a => a -> OSet a -> Bool
`notMember` OSet a
o') OSet a
o
	else forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => a -> OSet a -> OSet a
delete OSet a
o Map Int a
vs'

-- | Intersection. (@/\\@ is meant to look a bit like the standard mathematical
-- notation for intersection.)
--
-- /O(m*log(n\/(m+1)) + r*log(r))/, where /m/ is the size of the smaller set,
-- /n/ the size of the larger set, and /r/ the size of the result.
(|/\) :: Ord a => OSet a -> OSet a -> OSet a
OSet Map a Int
ts Map Int a
vs |/\ :: forall a. Ord a => OSet a -> OSet a -> OSet a
|/\ OSet Map a Int
ts' Map Int a
vs' = forall a. Map a Int -> Map Int a -> OSet a
OSet Map a Int
ts'' Map Int a
vs'' where
	ts'' :: Map a Int
ts'' = forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection Map a Int
ts Map a Int
ts'
	vs'' :: Map Int a
vs'' = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Int
t, a
v) | (a
v, Int
t) <- forall k a. Map k a -> [(k, a)]
M.toList Map a Int
ts]

-- | @flip ('|/\')@
--
-- See asymptotics of '|/\'.
(/\|) :: Ord a => OSet a -> OSet a -> OSet a
/\| :: forall a. Ord a => OSet a -> OSet a -> OSet a
(/\|) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => OSet a -> OSet a -> OSet a
(/\|)

empty :: OSet a
empty :: forall a. OSet a
empty = forall a. Map a Int -> Map Int a -> OSet a
OSet forall k a. Map k a
M.empty forall k a. Map k a
M.empty

member, notMember :: Ord a => a -> OSet a -> Bool
member :: forall a. Ord a => a -> OSet a -> Bool
member    a
v (OSet Map a Int
ts Map Int a
_) = forall k a. Ord k => k -> Map k a -> Bool
M.member    a
v Map a Int
ts
notMember :: forall a. Ord a => a -> OSet a -> Bool
notMember a
v (OSet Map a Int
ts Map Int a
_) = forall k a. Ord k => k -> Map k a -> Bool
M.notMember a
v Map a Int
ts

size :: OSet a -> Int
size :: forall a. OSet a -> Int
size (OSet Map a Int
ts Map Int a
_) = forall k a. Map k a -> Int
M.size Map a Int
ts

-- the Ord constraint is for compatibility with older (<0.5) versions of
-- containers
filter :: Ord a => (a -> Bool) -> OSet a -> OSet a
filter :: forall a. Ord a => (a -> Bool) -> OSet a -> OSet a
filter a -> Bool
f (OSet Map a Int
ts Map Int a
vs) = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\a
v Int
t -> a -> Bool
f a
v) Map a Int
ts)
                             (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Int
t a
v -> a -> Bool
f a
v) Map Int a
vs)

delete :: Ord a => a -> OSet a -> OSet a
delete :: forall a. Ord a => a -> OSet a -> OSet a
delete a
v o :: OSet a
o@(OSet Map a Int
ts Map Int a
vs) = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a Int
ts of
	Maybe Int
Nothing -> OSet a
o
	Just Int
t  -> forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
v Map a Int
ts) (forall k a. Ord k => k -> Map k a -> Map k a
M.delete Int
t Map Int a
vs)

singleton :: a -> OSet a
singleton :: forall a. a -> OSet a
singleton a
v = forall a. Map a Int -> Map Int a -> OSet a
OSet (forall k a. k -> a -> Map k a
M.singleton a
v Int
0) (forall k a. k -> a -> Map k a
M.singleton Int
0 a
v)

-- | If a value occurs multiple times, only the first occurrence is used.
fromList :: Ord a => [a] -> OSet a
fromList :: forall a. Ord a => [a] -> OSet a
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => OSet a -> a -> OSet a
(|>) forall a. OSet a
empty

null :: OSet a -> Bool
null :: forall a. OSet a -> Bool
null (OSet Map a Int
ts Map Int a
_) = forall k a. Map k a -> Bool
M.null Map a Int
ts

findIndex :: Ord a => a -> OSet a -> Maybe Index
findIndex :: forall a. Ord a => a -> OSet a -> Maybe Int
findIndex a
v o :: OSet a
o@(OSet Map a Int
ts Map Int a
vs) = do
	Int
t <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
v Map a Int
ts
	forall k a. Ord k => k -> Map k a -> Maybe Int
M.lookupIndex Int
t Map Int a
vs

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

-- | Returns values in ascending order. (Use 'toList' to return them in
-- insertion order.)
toAscList :: OSet a -> [a]
toAscList :: forall a. OSet a -> [a]
toAscList o :: OSet a
o@(OSet Map a Int
ts Map Int a
_) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (forall k a. Map k a -> [(k, a)]
M.toAscList Map a Int
ts)

-- | Convert an 'OSet' to a 'Set'.
--
-- /O(n)/, where /n/ is the size of the 'OSet'.
toSet :: OSet a -> Set a
toSet :: forall a. OSet a -> Set a
toSet (OSet Map a Int
ts Map Int a
_) = forall k a. Map k a -> Set k
M.keysSet Map a Int
ts