{-# LANGUAGE UndecidableInstances #-}

-- | Provides the 'UniqueSeq' type.
module Charon.Data.UniqueSeq.Internal
  ( -- * Type
    UniqueSeq (MkUniqueSeq, ..),

    -- * Creation
    fromFoldable,

    -- * Operations
    prepend,
    append,
    union,

    -- * Utils
    insertSeq,
    notHSetMember,
  )
where

import Charon.Prelude
import Data.HashSet qualified as HSet
import Data.Sequence qualified as Seq
import GHC.IsList (IsList (Item, fromList, toList))

-- | Like 'Seq' but with the guarantee that all elements are unique. This
-- comes with the cost of O(2n) space.
data UniqueSeq a = UnsafeUniqueSeq
  { forall a. UniqueSeq a -> Seq a
seq :: Seq a,
    forall a. UniqueSeq a -> HashSet a
set :: HashSet a
  }
  deriving stock (UniqueSeq a -> UniqueSeq a -> Bool
(UniqueSeq a -> UniqueSeq a -> Bool)
-> (UniqueSeq a -> UniqueSeq a -> Bool) -> Eq (UniqueSeq a)
forall a. Eq a => UniqueSeq a -> UniqueSeq a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => UniqueSeq a -> UniqueSeq a -> Bool
== :: UniqueSeq a -> UniqueSeq a -> Bool
$c/= :: forall a. Eq a => UniqueSeq a -> UniqueSeq a -> Bool
/= :: UniqueSeq a -> UniqueSeq a -> Bool
Eq, Int -> UniqueSeq a -> ShowS
[UniqueSeq a] -> ShowS
UniqueSeq a -> String
(Int -> UniqueSeq a -> ShowS)
-> (UniqueSeq a -> String)
-> ([UniqueSeq a] -> ShowS)
-> Show (UniqueSeq a)
forall a. Show a => Int -> UniqueSeq a -> ShowS
forall a. Show a => [UniqueSeq a] -> ShowS
forall a. Show a => UniqueSeq a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> UniqueSeq a -> ShowS
showsPrec :: Int -> UniqueSeq a -> ShowS
$cshow :: forall a. Show a => UniqueSeq a -> String
show :: UniqueSeq a -> String
$cshowList :: forall a. Show a => [UniqueSeq a] -> ShowS
showList :: [UniqueSeq a] -> ShowS
Show)

instance Foldable UniqueSeq where
  foldr :: forall a b. (a -> b -> b) -> b -> UniqueSeq a -> b
foldr a -> b -> b
f b
x (UnsafeUniqueSeq Seq a
seq HashSet a
_) = (a -> b -> b) -> b -> Seq a -> b
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
x Seq a
seq

pattern MkUniqueSeq :: Seq a -> HashSet a -> UniqueSeq a
pattern $mMkUniqueSeq :: forall {r} {a}.
UniqueSeq a -> (Seq a -> HashSet a -> r) -> ((# #) -> r) -> r
MkUniqueSeq seq set <- UnsafeUniqueSeq seq set

{-# COMPLETE MkUniqueSeq #-}

instance
  (k ~ A_Getter, b ~ Seq a, c ~ Seq a) =>
  LabelOptic "seq" k (UniqueSeq a) (UniqueSeq a) b c
  where
  labelOptic :: Optic k NoIx (UniqueSeq a) (UniqueSeq a) b c
labelOptic = (UniqueSeq a -> b) -> Getter (UniqueSeq a) b
forall s a. (s -> a) -> Getter s a
to (\(UnsafeUniqueSeq Seq a
seq HashSet a
_) -> b
Seq a
seq)

instance
  (k ~ A_Getter, b ~ HashSet a, c ~ HashSet a) =>
  LabelOptic "set" k (UniqueSeq a) (UniqueSeq a) b c
  where
  labelOptic :: Optic k NoIx (UniqueSeq a) (UniqueSeq a) b c
labelOptic = (UniqueSeq a -> b) -> Getter (UniqueSeq a) b
forall s a. (s -> a) -> Getter s a
to (\(UnsafeUniqueSeq Seq a
_ HashSet a
set) -> b
HashSet a
set)

instance (Hashable a) => Semigroup (UniqueSeq a) where
  <> :: UniqueSeq a -> UniqueSeq a -> UniqueSeq a
(<>) = UniqueSeq a -> UniqueSeq a -> UniqueSeq a
forall a. Hashable a => UniqueSeq a -> UniqueSeq a -> UniqueSeq a
union

instance (Hashable a) => Monoid (UniqueSeq a) where
  mempty :: UniqueSeq a
mempty = Seq a -> HashSet a -> UniqueSeq a
forall a. Seq a -> HashSet a -> UniqueSeq a
UnsafeUniqueSeq Seq a
forall a. Seq a
Seq.empty HashSet a
forall a. HashSet a
HSet.empty

instance (Hashable a) => IsList (UniqueSeq a) where
  type Item (UniqueSeq a) = a
  toList :: UniqueSeq a -> [Item (UniqueSeq a)]
toList (UnsafeUniqueSeq Seq a
seq HashSet a
_) = Seq a -> [Item (Seq a)]
forall l. IsList l => l -> [Item l]
toList Seq a
seq
  fromList :: [Item (UniqueSeq a)] -> UniqueSeq a
fromList = [a] -> UniqueSeq a
[Item (UniqueSeq a)] -> UniqueSeq a
forall (f :: * -> *) a.
(Foldable f, Hashable a) =>
f a -> UniqueSeq a
fromFoldable

union :: forall a. (Hashable a) => UniqueSeq a -> UniqueSeq a -> UniqueSeq a
union :: forall a. Hashable a => UniqueSeq a -> UniqueSeq a -> UniqueSeq a
union (UnsafeUniqueSeq Seq a
xseq HashSet a
_) (UnsafeUniqueSeq Seq a
yseq HashSet a
_) =
  Seq a -> HashSet a -> UniqueSeq a
forall a. Seq a -> HashSet a -> UniqueSeq a
UnsafeUniqueSeq Seq a
newSeq HashSet a
newSet
  where
    -- To preserve order, we must fold from the left
    (Seq a
newSeq, HashSet a
newSet) = ((Seq a, HashSet a) -> a -> (Seq a, HashSet a))
-> (Seq a, HashSet a) -> Seq a -> (Seq a, HashSet a)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Seq a, HashSet a) -> a -> (Seq a, HashSet a)
go (Seq a
forall a. Seq a
Seq.empty, HashSet a
forall a. HashSet a
HSet.empty) (Seq a
xseq Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
yseq)
    go :: (Seq a, HashSet a) -> a -> (Seq a, HashSet a)
    go :: (Seq a, HashSet a) -> a -> (Seq a, HashSet a)
go (Seq a
accSeq, HashSet a
accSet) a
z
      | a -> HashSet a -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
notHSetMember a
z HashSet a
accSet = (Seq a
accSeq Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
z, a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert a
z HashSet a
accSet)
      | Bool
otherwise = (Seq a
accSeq, HashSet a
accSet)

-- To preserve order, we must fold from the left
fromFoldable :: (Foldable f, Hashable a) => f a -> UniqueSeq a
fromFoldable :: forall (f :: * -> *) a.
(Foldable f, Hashable a) =>
f a -> UniqueSeq a
fromFoldable = (UniqueSeq a -> a -> UniqueSeq a)
-> UniqueSeq a -> f a -> UniqueSeq a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqueSeq a -> a -> UniqueSeq a
forall a. Hashable a => UniqueSeq a -> a -> UniqueSeq a
append (Seq a -> HashSet a -> UniqueSeq a
forall a. Seq a -> HashSet a -> UniqueSeq a
UnsafeUniqueSeq Seq a
forall a. Seq a
Seq.empty HashSet a
forall a. HashSet a
HSet.empty)

append :: (Hashable a) => UniqueSeq a -> a -> UniqueSeq a
append :: forall a. Hashable a => UniqueSeq a -> a -> UniqueSeq a
append = (a -> UniqueSeq a -> UniqueSeq a)
-> UniqueSeq a -> a -> UniqueSeq a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
forall a.
Hashable a =>
(a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
insertSeq ((Seq a -> a -> Seq a) -> a -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(:|>)))

prepend :: (Hashable a) => a -> UniqueSeq a -> UniqueSeq a
prepend :: forall a. Hashable a => a -> UniqueSeq a -> UniqueSeq a
prepend = (a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
forall a.
Hashable a =>
(a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
insertSeq a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
(:<|)

insertSeq :: (Hashable a) => (a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
insertSeq :: forall a.
Hashable a =>
(a -> Seq a -> Seq a) -> a -> UniqueSeq a -> UniqueSeq a
insertSeq a -> Seq a -> Seq a
seqIns a
x useq :: UniqueSeq a
useq@(UnsafeUniqueSeq Seq a
seq HashSet a
set)
  | a -> HashSet a -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
notHSetMember a
x HashSet a
set = Seq a -> HashSet a -> UniqueSeq a
forall a. Seq a -> HashSet a -> UniqueSeq a
UnsafeUniqueSeq (a -> Seq a -> Seq a
seqIns a
x Seq a
seq) (a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert a
x HashSet a
set)
  | Bool
otherwise = UniqueSeq a
useq

notHSetMember :: (Hashable a) => a -> HashSet a -> Bool
notHSetMember :: forall a. Hashable a => a -> HashSet a -> Bool
notHSetMember a
x = Bool -> Bool
not (Bool -> Bool) -> (HashSet a -> Bool) -> HashSet a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HSet.member a
x