-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Data.Set
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- = Overview
--
-- "Miso.Data.Set" is a Haskell wrapper around the JavaScript
-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set Set>
-- object. Values of type @'Set' a@ live in JavaScript memory; all
-- operations run in 'IO' and mutate the underlying JS set in place.
--
-- Unlike 'Data.Set.Set', elements do not require an 'Ord' instance —
-- any type with a 'Miso.DSL.ToJSVal' instance can be stored, and equality
-- is determined by JavaScript's
-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Equality_comparisons_and_sameness SameValueZero>
-- algorithm.
--
-- Use this module when you need to share a set with a browser API or a
-- third-party JavaScript library. For pure Haskell processing, prefer
-- 'Data.Set.Set'.
--
-- Import qualified to avoid clashing with 'Prelude':
--
-- @
-- import qualified "Miso.Data.Set" as S
-- @
--
-- = Quick start
--
-- @
-- import qualified "Miso.Data.Set" as S
--
-- example :: IO ()
-- example = do
--   s  <- S.'fromList' [1, 2, 3 :: Int]
--   S.'insert' 4 s
--   b  <- S.'member' 2 s   -- True
--   n  <- S.'size' s       -- 4
--   S.'delete' 1 s
--   pure ()
-- @
--
-- = Operations
--
-- * __Construction__: 'new', 'fromList'
-- * __Access__: 'member', 'size'
-- * __Mutation__: 'insert', 'delete', 'clear'
-- * __Set algebra__: 'union', 'intersection', 'difference', 'isSubset', 'isSuperset', 'isDisjoint'
--
-- = See also
--
-- * "Miso.Data.Array" — mutable JS 'Miso.Data.Array.Array'
-- * "Miso.Data.Map" — mutable JS 'Miso.Data.Map.Map'
-- * "Miso.DSL" — 'Miso.DSL.ToJSVal' \/ 'Miso.DSL.FromJSVal' used by element types
-----------------------------------------------------------------------------
module Miso.Data.Set
  ( -- * Type
    Set
    -- * Construction
  , new
  , fromList
    -- * Operations
  , insert
  , member
  , clear
  , size
  , delete
  , union
  , intersection
  , difference
  , isSubset
  , isSuperset
  , isDisjoint
  ) where
-----------------------------------------------------------------------------
import           Control.Monad (void, forM_)
import           Prelude hiding (lookup)
-----------------------------------------------------------------------------
import           Miso.DSL (jsg, JSVal, ToJSVal, FromJSVal, (!))
import qualified Miso.DSL as DSL
import           Miso.FFI (callFunction)
-----------------------------------------------------------------------------
newtype Set key = Set JSVal deriving (JSVal -> IO (Maybe (Set key))
JSVal -> IO (Set key)
(JSVal -> IO (Maybe (Set key)))
-> (JSVal -> IO (Set key)) -> FromJSVal (Set key)
forall key. JSVal -> IO (Maybe (Set key))
forall key. JSVal -> IO (Set key)
forall a. (JSVal -> IO (Maybe a)) -> (JSVal -> IO a) -> FromJSVal a
$cfromJSVal :: forall key. JSVal -> IO (Maybe (Set key))
fromJSVal :: JSVal -> IO (Maybe (Set key))
$cfromJSValUnchecked :: forall key. JSVal -> IO (Set key)
fromJSValUnchecked :: JSVal -> IO (Set key)
FromJSVal, Set key -> IO JSVal
(Set key -> IO JSVal) -> ToJSVal (Set key)
forall key. Set key -> IO JSVal
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: forall key. Set key -> IO JSVal
toJSVal :: Set key -> IO JSVal
ToJSVal)
-----------------------------------------------------------------------------
-- | Constructs a new JS [Set](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set) in t'IO'.
--
new :: IO (Set key)
new :: forall key. IO (Set key)
new = JSVal -> Set key
forall key. JSVal -> Set key
Set (JSVal -> Set key) -> IO JSVal -> IO (Set key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JSVal -> [JSVal] -> IO JSVal
forall constructor args.
(ToObject constructor, ToArgs args) =>
constructor -> args -> IO JSVal
DSL.new (MisoString -> IO JSVal
jsg MisoString
"Set") ([] :: [JSVal])
-----------------------------------------------------------------------------
-- | Inserts a value into the t'Set'.
insert
  :: ToJSVal key
  => key
  -- ^ Element to add
  -> Set key
  -- ^ Set to mutate
  -> IO ()
insert :: forall key. ToJSVal key => key -> Set key -> IO ()
insert key
key (Set JSVal
m) = do
  _ <- JSVal -> MisoString -> [key] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"add" [key
key]
  pure ()
-----------------------------------------------------------------------------
-- | Empties the t'Set'.
clear :: Set key -> IO ()
clear :: forall key. Set key -> IO ()
clear (Set JSVal
m) = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSVal -> MisoString -> () -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"clear" ())
-----------------------------------------------------------------------------
-- | Return the size of t'Set'.
size :: Set key -> IO Int
size :: forall key. Set key -> IO Int
size (Set JSVal
m) = JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
m JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"size"
-----------------------------------------------------------------------------
-- | Checks existence of 'key' in t'Set', returns t'Bool.
member
  :: ToJSVal key
  => key
  -- ^ Element to test for membership
  -> Set key
  -- ^ Set to query
  -> IO Bool
member :: forall key. ToJSVal key => key -> Set key -> IO Bool
member key
key (Set JSVal
m) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> JSVal -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"has" (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< key -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
DSL.toJSVal key
key
-----------------------------------------------------------------------------
-- | Removes an element from the t'Set', returns 'True' if it existed.
delete
  :: ToJSVal key
  => key
  -- ^ Element to remove
  -> Set key
  -- ^ Set to mutate
  -> IO Bool
delete :: forall key. ToJSVal key => key -> Set key -> IO Bool
delete key
key (Set JSVal
m) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> MisoString -> JSVal -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
m MisoString
"delete" (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< key -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
DSL.toJSVal key
key
-----------------------------------------------------------------------------
-- | Construct a t'Set' from a list of elements.
fromList
  :: ToJSVal key
  => [key]
  -- ^ Elements to populate the new set with
  -> IO (Set key)
fromList :: forall key. ToJSVal key => [key] -> IO (Set key)
fromList [key]
xs = do
  m <- IO (Set key)
forall key. IO (Set key)
new
  forM_ xs $ \key
k ->
    key -> Set key -> IO ()
forall key. ToJSVal key => key -> Set key -> IO ()
insert key
k Set key
m
  pure m
-----------------------------------------------------------------------------
-- | The union of two t'Set'
union
  :: ToJSVal key
  => Set key -- ^ First set
  -> Set key -- ^ Second set
  -> IO (Set key)
union :: forall key. ToJSVal key => Set key -> Set key -> IO (Set key)
union (Set JSVal
x) (Set JSVal
y) = JSVal -> Set key
forall key. JSVal -> Set key
Set (JSVal -> Set key) -> IO JSVal -> IO (Set key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"union" [JSVal
y]
-----------------------------------------------------------------------------
-- | The intersection of two t'Set'
intersection
  :: ToJSVal key
  => Set key -- ^ First set
  -> Set key -- ^ Second set
  -> IO (Set key)
intersection :: forall key. ToJSVal key => Set key -> Set key -> IO (Set key)
intersection (Set JSVal
x) (Set JSVal
y) = JSVal -> Set key
forall key. JSVal -> Set key
Set (JSVal -> Set key) -> IO JSVal -> IO (Set key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"intersection" [JSVal
y]
-----------------------------------------------------------------------------
-- | The symmetric difference of two t'Set'
difference
  :: ToJSVal key
  => Set key -- ^ First set
  -> Set key -- ^ Second set
  -> IO (Set key)
difference :: forall key. ToJSVal key => Set key -> Set key -> IO (Set key)
difference (Set JSVal
x) (Set JSVal
y) = JSVal -> Set key
forall key. JSVal -> Set key
Set (JSVal -> Set key) -> IO JSVal -> IO (Set key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"symmetricDifference" [JSVal
y]
-----------------------------------------------------------------------------
-- | Checks if one t'Set' is a subset of another t'Set'
isSubset
  :: ToJSVal key
  => Set key -- ^ Candidate subset
  -> Set key -- ^ Potential superset
  -> IO Bool
isSubset :: forall key. ToJSVal key => Set key -> Set key -> IO Bool
isSubset (Set JSVal
x) (Set JSVal
y) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"isSubsetOf" [JSVal
y]
-----------------------------------------------------------------------------
-- | Checks if one t'Set' is a superset of another t'Set'
isSuperset
  :: ToJSVal key
  => Set key -- ^ Candidate superset
  -> Set key -- ^ Potential subset
  -> IO Bool
isSuperset :: forall key. ToJSVal key => Set key -> Set key -> IO Bool
isSuperset (Set JSVal
x) (Set JSVal
y) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"isSupersetOf" [JSVal
y]
-----------------------------------------------------------------------------
-- | Checks if one t'Set' is disjoint from another t'Set'
isDisjoint
  :: ToJSVal key
  => Set key -- ^ First set
  -> Set key -- ^ Second set (disjoint means they share no elements)
  -> IO Bool
isDisjoint :: forall key. ToJSVal key => Set key -> Set key -> IO Bool
isDisjoint (Set JSVal
x) (Set JSVal
y) = JSVal -> IO Bool
forall a. FromJSVal a => JSVal -> IO a
DSL.fromJSValUnchecked (JSVal -> IO Bool) -> IO JSVal -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  JSVal -> MisoString -> [JSVal] -> IO JSVal
forall args. ToArgs args => JSVal -> MisoString -> args -> IO JSVal
callFunction JSVal
x MisoString
"isDisjointFrom" [JSVal
y]
-----------------------------------------------------------------------------