-- | Provides the 'UniqueSeqNE' type.
module Charon.Data.UniqueSeqNE
  ( UniqueSeqNE (MkUniqueSeqNE),

    -- * Creation
    singleton,
    fromNonEmpty,
    unsafefromUniqueSeq,

    -- * Elimination
    toNonEmpty,
    toUniqueSeq,

    -- * Lookup
    member,
    (∈),
    (∉),

    -- * Operations
    prepend,
    append,
    Internal.union,
    (∪),
    (⋃),
    map,
    (↤),
    (↦),

    -- * Display
    displayShow,
    display,
  )
where

import Charon.Data.UniqueSeq.Internal (UniqueSeq (UnsafeUniqueSeq))
import Charon.Data.UniqueSeqNE.Internal
  ( UniqueSeqNE
      ( MkUniqueSeqNE,
        UnsafeUniqueSeqNE
      ),
  )
import Charon.Data.UniqueSeqNE.Internal qualified as Internal
import Charon.Prelude
import Data.Foldable (Foldable (toList))
import Data.HashSet qualified as HSet
import Data.Sequence (Seq (Empty))
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text qualified as T

singleton :: (Hashable a) => a -> UniqueSeqNE a
singleton :: forall a. Hashable a => a -> UniqueSeqNE a
singleton a
x = NESeq a -> HashSet a -> UniqueSeqNE a
forall a. NESeq a -> HashSet a -> UniqueSeqNE a
UnsafeUniqueSeqNE (a -> NESeq a
forall a. a -> NESeq a
NESeq.singleton a
x) (a -> HashSet a
forall a. Hashable a => a -> HashSet a
HSet.singleton a
x)

unsafefromUniqueSeq :: (HasCallStack) => UniqueSeq a -> UniqueSeqNE a
unsafefromUniqueSeq :: forall a. HasCallStack => UniqueSeq a -> UniqueSeqNE a
unsafefromUniqueSeq (UnsafeUniqueSeq Seq a
Empty HashSet a
_) =
  [Char] -> UniqueSeqNE a
forall a. HasCallStack => [Char] -> a
error [Char]
"Charon.Data.UniqueSeqNE.unsafefromUniqueSeq: empty UniqueSeq"
unsafefromUniqueSeq (UnsafeUniqueSeq (a
x :<| Seq a
xs) HashSet a
set) =
  NESeq a -> HashSet a -> UniqueSeqNE a
forall a. NESeq a -> HashSet a -> UniqueSeqNE a
UnsafeUniqueSeqNE (a
x a -> Seq a -> NESeq a
forall a. a -> Seq a -> NESeq a
:<|| Seq a
xs) HashSet a
set

toUniqueSeq :: UniqueSeqNE a -> UniqueSeq a
toUniqueSeq :: forall a. UniqueSeqNE a -> UniqueSeq a
toUniqueSeq (UnsafeUniqueSeqNE (a
x :<|| Seq a
xs) HashSet a
set) = Seq a -> HashSet a -> UniqueSeq a
forall a. Seq a -> HashSet a -> UniqueSeq a
UnsafeUniqueSeq (a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
xs) HashSet a
set

member :: (Hashable a) => a -> UniqueSeqNE a -> Bool
member :: forall a. Hashable a => a -> UniqueSeqNE a -> Bool
member a
y (UnsafeUniqueSeqNE NESeq a
_ HashSet a
useq) = a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HSet.member a
y HashSet a
useq

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

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

map :: (Hashable b) => (a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
map :: forall b a.
Hashable b =>
(a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
map a -> b
f (UnsafeUniqueSeqNE (a
x :<|| Seq a
seq) HashSet a
_) = NESeq b -> HashSet b -> UniqueSeqNE b
forall a. NESeq a -> HashSet a -> UniqueSeqNE a
UnsafeUniqueSeqNE (a -> b
f a
x b -> Seq b -> NESeq b
forall a. a -> Seq a -> NESeq a
:<|| Seq b
newSeq) HashSet b
newSet
  where
    (Seq b
newSeq, HashSet b
newSet) = (a -> (Seq b, HashSet b) -> (Seq b, HashSet b))
-> (Seq b, HashSet b) -> Seq a -> (Seq b, HashSet 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 -> (Seq b, HashSet b) -> (Seq b, HashSet b)
go (Seq b
forall a. Seq a
Seq.empty, b -> HashSet b
forall a. Hashable a => a -> HashSet a
HSet.singleton (a -> b
f a
x)) Seq a
seq
    go :: a -> (Seq b, HashSet b) -> (Seq b, HashSet b)
go a
z (Seq b
accSeq, HashSet b
accSet)
      | b -> HashSet b -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
Internal.notHSetMember b
y HashSet b
accSet = (b
y b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
:<| Seq b
accSeq, b -> HashSet b -> HashSet b
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert b
y HashSet b
accSet)
      | Bool
otherwise = (Seq b
accSeq, HashSet b
accSet)
      where
        y :: b
y = a -> b
f a
z

-- When building a UniqueSeqNE from some ordered Foldable, we want to
-- preserve order. Because we are dealing with NonEmpty, we hold onto the
-- head and prepend it when we are finished. Note that we need to add x to the
-- Set so that duplicates will not exist.
fromNonEmpty :: (Hashable a) => NonEmpty a -> UniqueSeqNE a
fromNonEmpty :: forall a. Hashable a => NonEmpty a -> UniqueSeqNE a
fromNonEmpty (a
x :| [a]
xs) = NESeq a -> HashSet a -> UniqueSeqNE a
forall a. NESeq a -> HashSet a -> UniqueSeqNE a
UnsafeUniqueSeqNE (a
x a -> Seq a -> NESeq a
forall a. a -> Seq a -> NESeq a
:<|| Seq a
seq) HashSet a
set
  where
    -- To preserve order, we must fold from the left
    (Seq a
seq, HashSet a
set) = ((Seq a, HashSet a) -> a -> (Seq a, HashSet a))
-> (Seq a, HashSet a) -> [a] -> (Seq a, HashSet a)
forall b a. (b -> a -> b) -> b -> [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)
f (Seq a
forall a. Seq a
Seq.empty, a -> HashSet a
forall a. Hashable a => a -> HashSet a
HSet.singleton a
x) [a]
xs
    f :: (Seq a, HashSet a) -> a -> (Seq a, HashSet a)
f = (a -> (Seq a, HashSet a) -> (Seq a, HashSet a))
-> (Seq a, HashSet a) -> a -> (Seq a, HashSet a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> Seq a -> Seq a)
-> a -> (Seq a, HashSet a) -> (Seq a, HashSet a)
forall a.
Hashable a =>
(a -> Seq a -> Seq a)
-> a -> (Seq a, HashSet a) -> (Seq a, HashSet 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
(:|>)))

toNonEmpty :: UniqueSeqNE a -> NonEmpty a
toNonEmpty :: forall a. UniqueSeqNE a -> NonEmpty a
toNonEmpty UniqueSeqNE a
useq = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs
  where
    (a
x :<|| Seq a
xs) = Optic' A_Getter NoIx (UniqueSeqNE a) (NESeq a)
-> UniqueSeqNE a -> NESeq a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx (UniqueSeqNE a) (NESeq a)
#seq UniqueSeqNE a
useq

insertSeq ::
  (Hashable a) =>
  (a -> Seq a -> NESeq a) ->
  a ->
  UniqueSeqNE a ->
  UniqueSeqNE a
insertSeq :: forall a.
Hashable a =>
(a -> Seq a -> NESeq a) -> a -> UniqueSeqNE a -> UniqueSeqNE a
insertSeq a -> Seq a -> NESeq a
seqIns a
y useq :: UniqueSeqNE a
useq@(UnsafeUniqueSeqNE (a
x :<|| Seq a
xs) HashSet a
set)
  | a -> HashSet a -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
Internal.notHSetMember a
y HashSet a
set = NESeq a -> HashSet a -> UniqueSeqNE a
forall a. NESeq a -> HashSet a -> UniqueSeqNE a
UnsafeUniqueSeqNE (a -> Seq a -> NESeq a
seqIns a
y (a
x a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
xs)) (a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert a
y HashSet a
set)
  | Bool
otherwise = UniqueSeqNE a
useq

insertSeq' ::
  (Hashable a) =>
  (a -> Seq a -> Seq a) ->
  a ->
  (Seq a, HashSet a) ->
  (Seq a, HashSet a)
insertSeq' :: forall a.
Hashable a =>
(a -> Seq a -> Seq a)
-> a -> (Seq a, HashSet a) -> (Seq a, HashSet a)
insertSeq' a -> Seq a -> Seq a
seqIns a
y (Seq a
seq, HashSet a
set)
  | a -> HashSet a -> Bool
forall a. Hashable a => a -> HashSet a -> Bool
Internal.notHSetMember a
y HashSet a
set = (a -> Seq a -> Seq a
seqIns a
y Seq a
seq, a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert a
y HashSet a
set)
  | Bool
otherwise = (Seq a
seq, HashSet a
set)

displayShow :: (Show a) => UniqueSeqNE a -> Text
displayShow :: forall a. Show a => UniqueSeqNE a -> Text
displayShow = (a -> Text) -> UniqueSeqNE a -> Text
forall a. (a -> Text) -> UniqueSeqNE a -> Text
display ([Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show)

display :: (a -> Text) -> UniqueSeqNE a -> Text
display :: forall a. (a -> Text) -> UniqueSeqNE a -> Text
display a -> Text
toText =
  Text -> [Text] -> Text
T.intercalate Text
","
    ([Text] -> Text)
-> (UniqueSeqNE a -> [Text]) -> UniqueSeqNE a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Text
toText
    ([a] -> [Text])
-> (UniqueSeqNE a -> [a]) -> UniqueSeqNE a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESeq a -> [a]
forall a. NESeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (NESeq a -> [a])
-> (UniqueSeqNE a -> NESeq a) -> UniqueSeqNE a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Getter NoIx (UniqueSeqNE a) (NESeq a)
-> UniqueSeqNE a -> NESeq a
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx (UniqueSeqNE a) (NESeq a)
#seq

-- | Operator alias for 'union'. U+222A.
--
-- @since 0.1
(∪) :: (Hashable a) => UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
∪ :: forall a.
Hashable a =>
UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
(∪) = UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
forall a.
Hashable a =>
UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
Internal.union

infixl 6 ∪

-- | Fold over 'union'. U+22C3.
--
-- @since 0.1
(⋃) :: (Hashable a) => NonEmpty (UniqueSeqNE a) -> UniqueSeqNE a
⋃ :: forall a. Hashable a => NonEmpty (UniqueSeqNE a) -> UniqueSeqNE a
(⋃) (UniqueSeqNE a
x :| [UniqueSeqNE a]
xs) = (UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a)
-> UniqueSeqNE a -> [UniqueSeqNE a] -> UniqueSeqNE a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
forall a.
Hashable a =>
UniqueSeqNE a -> UniqueSeqNE a -> UniqueSeqNE a
(∪) UniqueSeqNE a
x [UniqueSeqNE a]
xs

-- | Operator alias for 'member'. U+2216.
--
-- @since 0.1
(∈) :: (Hashable a) => a -> UniqueSeqNE a -> Bool
∈ :: forall a. Hashable a => a -> UniqueSeqNE a -> Bool
(∈) = a -> UniqueSeqNE a -> Bool
forall a. Hashable a => a -> UniqueSeqNE a -> Bool
member

infix 4 ∈

-- | Negation of '(∈)'. U+2209
--
-- @since 0.1
(∉) :: (Hashable a) => a -> UniqueSeqNE a -> Bool
∉ :: forall a. Hashable a => a -> UniqueSeqNE a -> Bool
(∉) a
x = Bool -> Bool
not (Bool -> Bool) -> (UniqueSeqNE a -> Bool) -> UniqueSeqNE a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UniqueSeqNE a -> Bool
forall a. Hashable a => a -> UniqueSeqNE a -> Bool
(∈) a
x

infix 4 ∉

-- | Flipped '(↤)'. U+21A6.
--
-- @since 0.1
(↦) :: (Hashable b) => UniqueSeqNE a -> (a -> b) -> UniqueSeqNE b
↦ :: forall b a.
Hashable b =>
UniqueSeqNE a -> (a -> b) -> UniqueSeqNE b
(↦) = ((a -> b) -> UniqueSeqNE a -> UniqueSeqNE b)
-> UniqueSeqNE a -> (a -> b) -> UniqueSeqNE b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
forall b a.
Hashable b =>
(a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
(↤)

infix 3 ↦

-- | Operator alias for 'map'. U+21A4.
--
-- @since 0.1
(↤) :: (Hashable b) => (a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
↤ :: forall b a.
Hashable b =>
(a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
(↤) = (a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
forall b a.
Hashable b =>
(a -> b) -> UniqueSeqNE a -> UniqueSeqNE b
map

infix 3 ↤