{-# LANGUAGE ScopedTypeVariables #-}
module Happy.Tabular.NameSet (
NameSet (..),
empty,
singleton,
fromList,
delete,
member,
null,
union,
unions,
difference,
(\\),
foldr,
toAscList
) where
import Prelude hiding (foldr, null)
import Data.Coerce
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Happy.Grammar
newtype NameSet = MkNameSet IntSet
deriving (ReadPrec [NameSet]
ReadPrec NameSet
Key -> ReadS NameSet
ReadS [NameSet]
(Key -> ReadS NameSet)
-> ReadS [NameSet]
-> ReadPrec NameSet
-> ReadPrec [NameSet]
-> Read NameSet
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS NameSet
readsPrec :: Key -> ReadS NameSet
$creadList :: ReadS [NameSet]
readList :: ReadS [NameSet]
$creadPrec :: ReadPrec NameSet
readPrec :: ReadPrec NameSet
$creadListPrec :: ReadPrec [NameSet]
readListPrec :: ReadPrec [NameSet]
Read, Key -> NameSet -> ShowS
[NameSet] -> ShowS
NameSet -> String
(Key -> NameSet -> ShowS)
-> (NameSet -> String) -> ([NameSet] -> ShowS) -> Show NameSet
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> NameSet -> ShowS
showsPrec :: Key -> NameSet -> ShowS
$cshow :: NameSet -> String
show :: NameSet -> String
$cshowList :: [NameSet] -> ShowS
showList :: [NameSet] -> ShowS
Show, NameSet -> NameSet -> Bool
(NameSet -> NameSet -> Bool)
-> (NameSet -> NameSet -> Bool) -> Eq NameSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameSet -> NameSet -> Bool
== :: NameSet -> NameSet -> Bool
$c/= :: NameSet -> NameSet -> Bool
/= :: NameSet -> NameSet -> Bool
Eq, Eq NameSet
Eq NameSet =>
(NameSet -> NameSet -> Ordering)
-> (NameSet -> NameSet -> Bool)
-> (NameSet -> NameSet -> Bool)
-> (NameSet -> NameSet -> Bool)
-> (NameSet -> NameSet -> Bool)
-> (NameSet -> NameSet -> NameSet)
-> (NameSet -> NameSet -> NameSet)
-> Ord NameSet
NameSet -> NameSet -> Bool
NameSet -> NameSet -> Ordering
NameSet -> NameSet -> NameSet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NameSet -> NameSet -> Ordering
compare :: NameSet -> NameSet -> Ordering
$c< :: NameSet -> NameSet -> Bool
< :: NameSet -> NameSet -> Bool
$c<= :: NameSet -> NameSet -> Bool
<= :: NameSet -> NameSet -> Bool
$c> :: NameSet -> NameSet -> Bool
> :: NameSet -> NameSet -> Bool
$c>= :: NameSet -> NameSet -> Bool
>= :: NameSet -> NameSet -> Bool
$cmax :: NameSet -> NameSet -> NameSet
max :: NameSet -> NameSet -> NameSet
$cmin :: NameSet -> NameSet -> NameSet
min :: NameSet -> NameSet -> NameSet
Ord)
empty :: NameSet
empty :: NameSet
empty = IntSet -> NameSet
forall a b. Coercible a b => a -> b
coerce IntSet
IntSet.empty
singleton :: Name -> NameSet
singleton :: Name -> NameSet
singleton = (Key -> IntSet) -> Name -> NameSet
forall a b. Coercible a b => a -> b
coerce Key -> IntSet
IntSet.singleton
fromList :: [Name] -> NameSet
fromList :: [Name] -> NameSet
fromList = ([Key] -> IntSet) -> [Name] -> NameSet
forall a b. Coercible a b => a -> b
coerce [Key] -> IntSet
IntSet.fromList
delete :: Name -> NameSet -> NameSet
delete :: Name -> NameSet -> NameSet
delete = (Key -> IntSet -> IntSet) -> Name -> NameSet -> NameSet
forall a b. Coercible a b => a -> b
coerce Key -> IntSet -> IntSet
IntSet.delete
member :: Name -> NameSet -> Bool
member :: Name -> NameSet -> Bool
member = (Key -> IntSet -> Bool) -> Name -> NameSet -> Bool
forall a b. Coercible a b => a -> b
coerce Key -> IntSet -> Bool
IntSet.member
null :: NameSet -> Bool
null :: NameSet -> Bool
null = (IntSet -> Bool) -> NameSet -> Bool
forall a b. Coercible a b => a -> b
coerce IntSet -> Bool
IntSet.null
union :: NameSet -> NameSet -> NameSet
union :: NameSet -> NameSet -> NameSet
union = (IntSet -> IntSet -> IntSet) -> NameSet -> NameSet -> NameSet
forall a b. Coercible a b => a -> b
coerce IntSet -> IntSet -> IntSet
IntSet.union
unions :: [NameSet] -> NameSet
unions :: [NameSet] -> NameSet
unions = IntSet -> NameSet
forall a b. Coercible a b => a -> b
coerce (IntSet -> NameSet)
-> ([NameSet] -> IntSet) -> [NameSet] -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions ([IntSet] -> IntSet)
-> ([NameSet] -> [IntSet]) -> [NameSet] -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSet -> IntSet) -> [NameSet] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameSet -> IntSet
forall a b. Coercible a b => a -> b
coerce
difference :: NameSet -> NameSet -> NameSet
difference :: NameSet -> NameSet -> NameSet
difference = (IntSet -> IntSet -> IntSet) -> NameSet -> NameSet -> NameSet
forall a b. Coercible a b => a -> b
coerce IntSet -> IntSet -> IntSet
IntSet.difference
(\\) :: NameSet -> NameSet -> NameSet
\\ :: NameSet -> NameSet -> NameSet
(\\) = (IntSet -> IntSet -> IntSet) -> NameSet -> NameSet -> NameSet
forall a b. Coercible a b => a -> b
coerce IntSet -> IntSet -> IntSet
(IntSet.\\)
foldr :: forall b. (Name -> b -> b) -> b -> NameSet -> b
foldr :: forall b. (Name -> b -> b) -> b -> NameSet -> b
foldr = ((Key -> b -> b) -> b -> IntSet -> b)
-> (Name -> b -> b) -> b -> NameSet -> b
forall a b. Coercible a b => a -> b
coerce ((Key -> b -> b) -> b -> IntSet -> b
forall b. (Key -> b -> b) -> b -> IntSet -> b
IntSet.foldr :: (Int -> b -> b) -> b -> IntSet -> b)
toAscList :: NameSet -> [Name]
toAscList :: NameSet -> [Name]
toAscList = (IntSet -> [Key]) -> NameSet -> [Name]
forall a b. Coercible a b => a -> b
coerce IntSet -> [Key]
IntSet.toAscList