{- | A type for sets of things identified by 'Unique's, usually names.
 This approach is preferred when it is more efficient to compare the associated
 'Unique's instead of the underlying type.
-}

module PlutusCore.Name.UniqueSet (
  UniqueSet (..),
  insertByUnique,
  insertByName,
  singletonName,
  fromFoldable,
  fromUniques,
  fromNames,
  memberByUnique,
  memberByName,
  notMemberByName,
  (\\),
  union,
  setOfByUnique,
  setOfByName,
) where

import Control.Lens (Getting, view)
import Control.Lens.Getter (views)
import Data.Coerce (Coercible, coerce)
import Data.IntSet qualified as IS
import Data.IntSet.Lens qualified as IS
import Data.List as List (foldl')
import PlutusCore.Name.Unique (HasUnique (..), Unique (Unique))

{- | A set containing 'Unique's. Since 'Unique' is equivalent to 'Int'
 (see "PlutusCore.Name.Unique"), we can use an 'IntSet' representation for this type.
-}
newtype UniqueSet unique = UniqueSet
  { forall unique. UniqueSet unique -> IntSet
unUniqueSet :: IS.IntSet
  }
  deriving stock (Int -> UniqueSet unique -> ShowS
[UniqueSet unique] -> ShowS
UniqueSet unique -> String
(Int -> UniqueSet unique -> ShowS)
-> (UniqueSet unique -> String)
-> ([UniqueSet unique] -> ShowS)
-> Show (UniqueSet unique)
forall unique. Int -> UniqueSet unique -> ShowS
forall unique. [UniqueSet unique] -> ShowS
forall unique. UniqueSet unique -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall unique. Int -> UniqueSet unique -> ShowS
showsPrec :: Int -> UniqueSet unique -> ShowS
$cshow :: forall unique. UniqueSet unique -> String
show :: UniqueSet unique -> String
$cshowList :: forall unique. [UniqueSet unique] -> ShowS
showList :: [UniqueSet unique] -> ShowS
Show, UniqueSet unique -> UniqueSet unique -> Bool
(UniqueSet unique -> UniqueSet unique -> Bool)
-> (UniqueSet unique -> UniqueSet unique -> Bool)
-> Eq (UniqueSet unique)
forall unique. UniqueSet unique -> UniqueSet unique -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall unique. UniqueSet unique -> UniqueSet unique -> Bool
== :: UniqueSet unique -> UniqueSet unique -> Bool
$c/= :: forall unique. UniqueSet unique -> UniqueSet unique -> Bool
/= :: UniqueSet unique -> UniqueSet unique -> Bool
Eq)
  deriving newtype (NonEmpty (UniqueSet unique) -> UniqueSet unique
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
(UniqueSet unique -> UniqueSet unique -> UniqueSet unique)
-> (NonEmpty (UniqueSet unique) -> UniqueSet unique)
-> (forall b.
    Integral b =>
    b -> UniqueSet unique -> UniqueSet unique)
-> Semigroup (UniqueSet unique)
forall b. Integral b => b -> UniqueSet unique -> UniqueSet unique
forall unique. NonEmpty (UniqueSet unique) -> UniqueSet unique
forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall unique b.
Integral b =>
b -> UniqueSet unique -> UniqueSet unique
$c<> :: forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
<> :: UniqueSet unique -> UniqueSet unique -> UniqueSet unique
$csconcat :: forall unique. NonEmpty (UniqueSet unique) -> UniqueSet unique
sconcat :: NonEmpty (UniqueSet unique) -> UniqueSet unique
$cstimes :: forall unique b.
Integral b =>
b -> UniqueSet unique -> UniqueSet unique
stimes :: forall b. Integral b => b -> UniqueSet unique -> UniqueSet unique
Semigroup, Semigroup (UniqueSet unique)
UniqueSet unique
Semigroup (UniqueSet unique) =>
UniqueSet unique
-> (UniqueSet unique -> UniqueSet unique -> UniqueSet unique)
-> ([UniqueSet unique] -> UniqueSet unique)
-> Monoid (UniqueSet unique)
[UniqueSet unique] -> UniqueSet unique
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
forall unique. Semigroup (UniqueSet unique)
forall unique. UniqueSet unique
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall unique. [UniqueSet unique] -> UniqueSet unique
forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
$cmempty :: forall unique. UniqueSet unique
mempty :: UniqueSet unique
$cmappend :: forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
mappend :: UniqueSet unique -> UniqueSet unique -> UniqueSet unique
$cmconcat :: forall unique. [UniqueSet unique] -> UniqueSet unique
mconcat :: [UniqueSet unique] -> UniqueSet unique
Monoid)

-- | Insert a @unique@.
insertByUnique ::
  (Coercible unique Unique) =>
  unique ->
  UniqueSet unique ->
  UniqueSet unique
insertByUnique :: forall unique.
Coercible unique Unique =>
unique -> UniqueSet unique -> UniqueSet unique
insertByUnique = (IntSet -> IntSet) -> UniqueSet unique -> UniqueSet unique
forall a b. Coercible a b => a -> b
coerce ((IntSet -> IntSet) -> UniqueSet unique -> UniqueSet unique)
-> (unique -> IntSet -> IntSet)
-> unique
-> UniqueSet unique
-> UniqueSet unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IntSet -> IntSet
IS.insert (Int -> IntSet -> IntSet)
-> (unique -> Int) -> unique -> IntSet -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. unique -> Int
forall a b. Coercible a b => a -> b
coerce

-- | Insert the @unique@ associated to the @name@.
insertByName :: (HasUnique name unique) => name -> UniqueSet unique -> UniqueSet unique
insertByName :: forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> UniqueSet unique
insertByName = unique -> UniqueSet unique -> UniqueSet unique
forall unique.
Coercible unique Unique =>
unique -> UniqueSet unique -> UniqueSet unique
insertByUnique (unique -> UniqueSet unique -> UniqueSet unique)
-> (name -> unique) -> name -> UniqueSet unique -> UniqueSet unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting unique name unique -> name -> unique
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting unique name unique
forall a unique. HasUnique a unique => Lens' a unique
Lens' name unique
unique

-- | Create the singleton set of the @unique@ associated to the @name@.
singletonName :: (HasUnique name unique) => name -> UniqueSet unique
singletonName :: forall name unique.
HasUnique name unique =>
name -> UniqueSet unique
singletonName name
n = name -> UniqueSet unique -> UniqueSet unique
forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> UniqueSet unique
insertByName name
n UniqueSet unique
forall a. Monoid a => a
mempty

-- | Convert a 'Foldable' into a 'UniqueSet' using the given insertion function.
fromFoldable ::
  (Foldable f) =>
  (i -> UniqueSet unique -> UniqueSet unique) ->
  f i ->
  UniqueSet unique
fromFoldable :: forall (f :: * -> *) i unique.
Foldable f =>
(i -> UniqueSet unique -> UniqueSet unique)
-> f i -> UniqueSet unique
fromFoldable i -> UniqueSet unique -> UniqueSet unique
ins = (UniqueSet unique -> i -> UniqueSet unique)
-> UniqueSet unique -> f i -> UniqueSet unique
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((i -> UniqueSet unique -> UniqueSet unique)
-> UniqueSet unique -> i -> UniqueSet unique
forall a b c. (a -> b -> c) -> b -> a -> c
flip i -> UniqueSet unique -> UniqueSet unique
ins) UniqueSet unique
forall a. Monoid a => a
mempty

-- | Convert a 'Foldable' with uniques into a 'UniqueSet'.
fromUniques :: (Foldable f) => (Coercible Unique unique) => f unique -> UniqueSet unique
fromUniques :: forall (f :: * -> *) unique.
(Foldable f, Coercible Unique unique) =>
f unique -> UniqueSet unique
fromUniques = (unique -> UniqueSet unique -> UniqueSet unique)
-> f unique -> UniqueSet unique
forall (f :: * -> *) i unique.
Foldable f =>
(i -> UniqueSet unique -> UniqueSet unique)
-> f i -> UniqueSet unique
fromFoldable unique -> UniqueSet unique -> UniqueSet unique
forall unique.
Coercible unique Unique =>
unique -> UniqueSet unique -> UniqueSet unique
insertByUnique

-- | Convert a 'Foldable' with names into a 'UniqueSet'.
fromNames :: (Foldable f) => (HasUnique name unique) => f name -> UniqueSet unique
fromNames :: forall (f :: * -> *) name unique.
(Foldable f, HasUnique name unique) =>
f name -> UniqueSet unique
fromNames = (name -> UniqueSet unique -> UniqueSet unique)
-> f name -> UniqueSet unique
forall (f :: * -> *) i unique.
Foldable f =>
(i -> UniqueSet unique -> UniqueSet unique)
-> f i -> UniqueSet unique
fromFoldable name -> UniqueSet unique -> UniqueSet unique
forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> UniqueSet unique
insertByName

-- | Is the @unique@ a member of the set?
memberByUnique :: (Coercible unique Unique) => unique -> UniqueSet unique -> Bool
memberByUnique :: forall unique.
Coercible unique Unique =>
unique -> UniqueSet unique -> Bool
memberByUnique unique
uniq = Int -> IntSet -> Bool
IS.member (unique -> Int
forall a b. Coercible a b => a -> b
coerce unique
uniq) (IntSet -> Bool)
-> (UniqueSet unique -> IntSet) -> UniqueSet unique -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqueSet unique -> IntSet
forall unique. UniqueSet unique -> IntSet
unUniqueSet

-- | Is the @name@ associated to the @unique@ a member of the set?
memberByName :: (HasUnique name unique) => name -> UniqueSet unique -> Bool
memberByName :: forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> Bool
memberByName = unique -> UniqueSet unique -> Bool
forall unique.
Coercible unique Unique =>
unique -> UniqueSet unique -> Bool
memberByUnique (unique -> UniqueSet unique -> Bool)
-> (name -> unique) -> name -> UniqueSet unique -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting unique name unique -> name -> unique
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting unique name unique
forall a unique. HasUnique a unique => Lens' a unique
Lens' name unique
unique

{- | The negation of 'memberByName', useful for converting to operator form,
 e.g. @name `notMemberByName` set@.
-}
notMemberByName :: (HasUnique name unique) => name -> UniqueSet unique -> Bool
notMemberByName :: forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> Bool
notMemberByName name
n = Bool -> Bool
not (Bool -> Bool)
-> (UniqueSet unique -> Bool) -> UniqueSet unique -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> UniqueSet unique -> Bool
forall name unique.
HasUnique name unique =>
name -> UniqueSet unique -> Bool
memberByName name
n

-- | The difference of two 'UniqueSet's.
(\\) :: UniqueSet unique -> UniqueSet unique -> UniqueSet unique
\\ :: forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
(\\) (UniqueSet IntSet
s1) (UniqueSet IntSet
s2) = IntSet -> UniqueSet unique
forall unique. IntSet -> UniqueSet unique
UniqueSet (IntSet -> UniqueSet unique) -> IntSet -> UniqueSet unique
forall a b. (a -> b) -> a -> b
$ IntSet
s1 IntSet -> IntSet -> IntSet
IS.\\ IntSet
s2

-- | The union of two 'UniqueSet's.
union :: UniqueSet unique -> UniqueSet unique -> UniqueSet unique
union :: forall unique.
UniqueSet unique -> UniqueSet unique -> UniqueSet unique
union (UniqueSet IntSet
s1) (UniqueSet IntSet
s2) = IntSet -> UniqueSet unique
forall unique. IntSet -> UniqueSet unique
UniqueSet (IntSet -> UniqueSet unique) -> IntSet -> UniqueSet unique
forall a b. (a -> b) -> a -> b
$ IntSet
s1 IntSet -> IntSet -> IntSet
`IS.union` IntSet
s2

-- | Build a set of @unique@s from the 'Getting'.
setOfByUnique ::
  (Coercible unique Unique) =>
  Getting (UniqueSet unique) s unique ->
  s ->
  UniqueSet unique
setOfByUnique :: forall unique s.
Coercible unique Unique =>
Getting (UniqueSet unique) s unique -> s -> UniqueSet unique
setOfByUnique Getting (UniqueSet unique) s unique
g = IntSet -> UniqueSet unique
forall unique. IntSet -> UniqueSet unique
UniqueSet (IntSet -> UniqueSet unique)
-> (s -> IntSet) -> s -> UniqueSet unique
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting IntSet s Int -> s -> IntSet
forall s. Getting IntSet s Int -> s -> IntSet
IS.setOf (Getting (UniqueSet unique) s unique -> Getting IntSet s Int
forall a b. Coercible a b => a -> b
coerce Getting (UniqueSet unique) s unique
g)

-- | Build a set of @unique@s associated to the names in the 'Getting'.
setOfByName ::
  (HasUnique name unique) =>
  Getting (UniqueSet unique) s name ->
  s ->
  UniqueSet unique
setOfByName :: forall name unique s.
HasUnique name unique =>
Getting (UniqueSet unique) s name -> s -> UniqueSet unique
setOfByName Getting (UniqueSet unique) s name
l = Getting (UniqueSet unique) s name
-> (name -> UniqueSet unique) -> s -> UniqueSet unique
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Getting (UniqueSet unique) s name
l name -> UniqueSet unique
forall name unique.
HasUnique name unique =>
name -> UniqueSet unique
singletonName