{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.IntSet.NonEmpty.Internal (
NEIntSet(..)
, Key
, nonEmptySet
, withNonEmpty
, toSet
, singleton
, fromList
, toList
, union
, unions
, valid
, insertMinSet
, insertMaxSet
, disjointSet
) where
import Control.DeepSeq
import Control.Monad
import Data.Data
import Data.Function
import Data.IntSet.Internal (IntSet(..), Key)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Semigroup
import Data.Semigroup.Foldable (Foldable1)
import Text.Read
import qualified Data.Aeson as A
import qualified Data.Foldable as F
import qualified Data.IntSet as S
import qualified Data.Semigroup.Foldable as F1
data NEIntSet =
NEIntSet { NEIntSet -> Key
neisV0 :: !Key
, NEIntSet -> IntSet
neisIntSet :: !IntSet
}
deriving (Typeable)
instance Eq NEIntSet where
NEIntSet
t1 == :: NEIntSet -> NEIntSet -> Bool
== NEIntSet
t2 = IntSet -> Key
S.size (NEIntSet -> IntSet
neisIntSet NEIntSet
t1) Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== IntSet -> Key
S.size (NEIntSet -> IntSet
neisIntSet NEIntSet
t2)
Bool -> Bool -> Bool
&& NEIntSet -> NonEmpty Key
toList NEIntSet
t1 NonEmpty Key -> NonEmpty Key -> Bool
forall a. Eq a => a -> a -> Bool
== NEIntSet -> NonEmpty Key
toList NEIntSet
t2
instance Ord NEIntSet where
compare :: NEIntSet -> NEIntSet -> Ordering
compare = NonEmpty Key -> NonEmpty Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NonEmpty Key -> NonEmpty Key -> Ordering)
-> (NEIntSet -> NonEmpty Key) -> NEIntSet -> NEIntSet -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
< :: NEIntSet -> NEIntSet -> Bool
(<) = NonEmpty Key -> NonEmpty Key -> Bool
forall a. Ord a => a -> a -> Bool
(<) (NonEmpty Key -> NonEmpty Key -> Bool)
-> (NEIntSet -> NonEmpty Key) -> NEIntSet -> NEIntSet -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
> :: NEIntSet -> NEIntSet -> Bool
(>) = NonEmpty Key -> NonEmpty Key -> Bool
forall a. Ord a => a -> a -> Bool
(>) (NonEmpty Key -> NonEmpty Key -> Bool)
-> (NEIntSet -> NonEmpty Key) -> NEIntSet -> NEIntSet -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
<= :: NEIntSet -> NEIntSet -> Bool
(<=) = NonEmpty Key -> NonEmpty Key -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (NonEmpty Key -> NonEmpty Key -> Bool)
-> (NEIntSet -> NonEmpty Key) -> NEIntSet -> NEIntSet -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
>= :: NEIntSet -> NEIntSet -> Bool
(>=) = NonEmpty Key -> NonEmpty Key -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (NonEmpty Key -> NonEmpty Key -> Bool)
-> (NEIntSet -> NonEmpty Key) -> NEIntSet -> NEIntSet -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NEIntSet -> NonEmpty Key
toList
instance Show NEIntSet where
showsPrec :: Key -> NEIntSet -> ShowS
showsPrec Key
p NEIntSet
xs = Bool -> ShowS -> ShowS
showParen (Key
p Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Key -> ShowS
forall a. Show a => a -> ShowS
shows (NEIntSet -> NonEmpty Key
toList NEIntSet
xs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
instance Read NEIntSet where
readPrec :: ReadPrec NEIntSet
readPrec = ReadPrec NEIntSet -> ReadPrec NEIntSet
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec NEIntSet -> ReadPrec NEIntSet)
-> ReadPrec NEIntSet -> ReadPrec NEIntSet
forall a b. (a -> b) -> a -> b
$ Key -> ReadPrec NEIntSet -> ReadPrec NEIntSet
forall a. Key -> ReadPrec a -> ReadPrec a
prec Key
10 (ReadPrec NEIntSet -> ReadPrec NEIntSet)
-> ReadPrec NEIntSet -> ReadPrec NEIntSet
forall a b. (a -> b) -> a -> b
$ do
Ident String
"fromList" <- ReadPrec Lexeme
lexP
NonEmpty Key
xs <- ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key))
-> (ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key))
-> ReadPrec (NonEmpty Key)
-> ReadPrec (NonEmpty Key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key)
forall a. Key -> ReadPrec a -> ReadPrec a
prec Key
10 (ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key))
-> ReadPrec (NonEmpty Key) -> ReadPrec (NonEmpty Key)
forall a b. (a -> b) -> a -> b
$ ReadPrec (NonEmpty Key)
forall a. Read a => ReadPrec a
readPrec
NEIntSet -> ReadPrec NEIntSet
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Key -> NEIntSet
fromList NonEmpty Key
xs)
readListPrec :: ReadPrec [NEIntSet]
readListPrec = ReadPrec [NEIntSet]
forall a. Read a => ReadPrec [a]
readListPrecDefault
instance NFData NEIntSet where
rnf :: NEIntSet -> ()
rnf (NEIntSet Key
x IntSet
s) = Key -> ()
forall a. NFData a => a -> ()
rnf Key
x () -> () -> ()
`seq` IntSet -> ()
forall a. NFData a => a -> ()
rnf IntSet
s
instance Data NEIntSet where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NEIntSet -> c NEIntSet
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z NEIntSet
is = (NonEmpty Key -> NEIntSet) -> c (NonEmpty Key -> NEIntSet)
forall g. g -> c g
z NonEmpty Key -> NEIntSet
fromList c (NonEmpty Key -> NEIntSet) -> NonEmpty Key -> c NEIntSet
forall d b. Data d => c (d -> b) -> d -> c b
`f` (NEIntSet -> NonEmpty Key
toList NEIntSet
is)
toConstr :: NEIntSet -> Constr
toConstr NEIntSet
_ = Constr
fromListConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NEIntSet
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Key
constrIndex Constr
c of
Key
1 -> c (NonEmpty Key -> NEIntSet) -> c NEIntSet
forall b r. Data b => c (b -> r) -> c r
k ((NonEmpty Key -> NEIntSet) -> c (NonEmpty Key -> NEIntSet)
forall r. r -> c r
z NonEmpty Key -> NEIntSet
fromList)
Key
_ -> String -> c NEIntSet
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: NEIntSet -> DataType
dataTypeOf NEIntSet
_ = DataType
intSetDataType
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
intSetDataType String
"fromList" [] Fixity
Prefix
intSetDataType :: DataType
intSetDataType :: DataType
intSetDataType = String -> [Constr] -> DataType
mkDataType String
"Data.IntSet.NonEmpty.Internal.NEIntSet" [Constr
fromListConstr]
instance A.ToJSON NEIntSet where
toJSON :: NEIntSet -> Value
toJSON = IntSet -> Value
forall a. ToJSON a => a -> Value
A.toJSON (IntSet -> Value) -> (NEIntSet -> IntSet) -> NEIntSet -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet
toEncoding :: NEIntSet -> Encoding
toEncoding = IntSet -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (IntSet -> Encoding)
-> (NEIntSet -> IntSet) -> NEIntSet -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet
instance A.FromJSON NEIntSet where
parseJSON :: Value -> Parser NEIntSet
parseJSON = Parser NEIntSet
-> (NEIntSet -> Parser NEIntSet) -> IntSet -> Parser NEIntSet
forall r. r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty (String -> Parser NEIntSet
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) NEIntSet -> Parser NEIntSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(IntSet -> Parser NEIntSet)
-> (Value -> Parser IntSet) -> Value -> Parser NEIntSet
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser IntSet
forall a. FromJSON a => Value -> Parser a
A.parseJSON
where
err :: String
err = String
"NEIntSet: Non-empty set expected, but empty set found"
nonEmptySet :: IntSet -> Maybe NEIntSet
nonEmptySet :: IntSet -> Maybe NEIntSet
nonEmptySet = (((Key, IntSet) -> NEIntSet)
-> Maybe (Key, IntSet) -> Maybe NEIntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Key, IntSet) -> NEIntSet)
-> Maybe (Key, IntSet) -> Maybe NEIntSet)
-> ((Key -> IntSet -> NEIntSet) -> (Key, IntSet) -> NEIntSet)
-> (Key -> IntSet -> NEIntSet)
-> Maybe (Key, IntSet)
-> Maybe NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> IntSet -> NEIntSet) -> (Key, IntSet) -> NEIntSet
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) Key -> IntSet -> NEIntSet
NEIntSet (Maybe (Key, IntSet) -> Maybe NEIntSet)
-> (IntSet -> Maybe (Key, IntSet)) -> IntSet -> Maybe NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Key, IntSet)
S.minView
{-# INLINE nonEmptySet #-}
withNonEmpty
:: r
-> (NEIntSet -> r)
-> IntSet
-> r
withNonEmpty :: r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty r
def NEIntSet -> r
f = r -> (NEIntSet -> r) -> Maybe NEIntSet -> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NEIntSet -> r
f (Maybe NEIntSet -> r) -> (IntSet -> Maybe NEIntSet) -> IntSet -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe NEIntSet
nonEmptySet
{-# INLINE withNonEmpty #-}
toSet :: NEIntSet -> IntSet
toSet :: NEIntSet -> IntSet
toSet (NEIntSet Key
x IntSet
s) = Key -> IntSet -> IntSet
insertMinSet Key
x IntSet
s
{-# INLINE toSet #-}
singleton :: Key -> NEIntSet
singleton :: Key -> NEIntSet
singleton Key
x = Key -> IntSet -> NEIntSet
NEIntSet Key
x IntSet
S.empty
{-# INLINE singleton #-}
fromList :: NonEmpty Key -> NEIntSet
fromList :: NonEmpty Key -> NEIntSet
fromList (Key
x :| [Key]
s) = NEIntSet -> (NEIntSet -> NEIntSet) -> IntSet -> NEIntSet
forall r. r -> (NEIntSet -> r) -> IntSet -> r
withNonEmpty (Key -> NEIntSet
singleton Key
x) (NEIntSet -> NEIntSet -> NEIntSet
forall a. Semigroup a => a -> a -> a
<> Key -> NEIntSet
singleton Key
x)
(IntSet -> NEIntSet) -> ([Key] -> IntSet) -> [Key] -> NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> IntSet
S.fromList
([Key] -> NEIntSet) -> [Key] -> NEIntSet
forall a b. (a -> b) -> a -> b
$ [Key]
s
{-# INLINE fromList #-}
toList :: NEIntSet -> NonEmpty Key
toList :: NEIntSet -> NonEmpty Key
toList (NEIntSet Key
x IntSet
s) = Key
x Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| IntSet -> [Key]
S.toList IntSet
s
{-# INLINE toList #-}
union
:: NEIntSet
-> NEIntSet
-> NEIntSet
union :: NEIntSet -> NEIntSet -> NEIntSet
union n1 :: NEIntSet
n1@(NEIntSet Key
x1 IntSet
s1) n2 :: NEIntSet
n2@(NEIntSet Key
x2 IntSet
s2) = case Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key
x1 Key
x2 of
Ordering
LT -> Key -> IntSet -> NEIntSet
NEIntSet Key
x1 (IntSet -> NEIntSet)
-> (NEIntSet -> IntSet) -> NEIntSet -> NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union IntSet
s1 (IntSet -> IntSet) -> (NEIntSet -> IntSet) -> NEIntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEIntSet -> IntSet
toSet (NEIntSet -> NEIntSet) -> NEIntSet -> NEIntSet
forall a b. (a -> b) -> a -> b
$ NEIntSet
n2
Ordering
EQ -> Key -> IntSet -> NEIntSet
NEIntSet Key
x1 (IntSet -> NEIntSet) -> (IntSet -> IntSet) -> IntSet -> NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union IntSet
s1 (IntSet -> NEIntSet) -> IntSet -> NEIntSet
forall a b. (a -> b) -> a -> b
$ IntSet
s2
Ordering
GT -> Key -> IntSet -> NEIntSet
NEIntSet Key
x2 (IntSet -> NEIntSet) -> (IntSet -> IntSet) -> IntSet -> NEIntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet -> IntSet
S.union (NEIntSet -> IntSet
toSet NEIntSet
n1) (IntSet -> NEIntSet) -> IntSet -> NEIntSet
forall a b. (a -> b) -> a -> b
$ IntSet
s2
{-# INLINE union #-}
unions
:: Foldable1 f
=> f NEIntSet
-> NEIntSet
unions :: f NEIntSet -> NEIntSet
unions (f NEIntSet -> NonEmpty NEIntSet
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty->(NEIntSet
s :| [NEIntSet]
ss)) = (NEIntSet -> NEIntSet -> NEIntSet)
-> NEIntSet -> [NEIntSet] -> NEIntSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' NEIntSet -> NEIntSet -> NEIntSet
union NEIntSet
s [NEIntSet]
ss
{-# INLINE unions #-}
instance Semigroup NEIntSet where
<> :: NEIntSet -> NEIntSet -> NEIntSet
(<>) = NEIntSet -> NEIntSet -> NEIntSet
union
{-# INLINE (<>) #-}
sconcat :: NonEmpty NEIntSet -> NEIntSet
sconcat = NonEmpty NEIntSet -> NEIntSet
forall (f :: * -> *). Foldable1 f => f NEIntSet -> NEIntSet
unions
{-# INLINE sconcat #-}
valid :: NEIntSet -> Bool
valid :: NEIntSet -> Bool
valid (NEIntSet Key
x IntSet
s) = ((Key, IntSet) -> Bool) -> Maybe (Key, IntSet) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Key
x Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<) (Key -> Bool) -> ((Key, IntSet) -> Key) -> (Key, IntSet) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, IntSet) -> Key
forall a b. (a, b) -> a
fst) (IntSet -> Maybe (Key, IntSet)
S.minView IntSet
s)
insertMinSet :: Key -> IntSet -> IntSet
insertMinSet :: Key -> IntSet -> IntSet
insertMinSet = Key -> IntSet -> IntSet
S.insert
{-# INLINABLE insertMinSet #-}
insertMaxSet :: Key -> IntSet -> IntSet
insertMaxSet :: Key -> IntSet -> IntSet
insertMaxSet = Key -> IntSet -> IntSet
S.insert
{-# INLINABLE insertMaxSet #-}
disjointSet :: IntSet -> IntSet -> Bool
#if MIN_VERSION_containers(0,5,11)
disjointSet :: IntSet -> IntSet -> Bool
disjointSet = IntSet -> IntSet -> Bool
S.disjoint
#else
disjointSet xs = S.null . S.intersection xs
#endif
{-# INLINE disjointSet #-}