-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Data.Set
-- Copyright   :  (C) 2016-2025 David M. Johnson (@dmjio)
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Mutable 'Set' data structure in 'IO'.
--
-- A JavaScript [Set](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Set). This is a convenience for manipulating JavaScript data structures from Haskell.
--
-- We recommend using this module qualified.
--
-- > import qualified Miso.Data.Set as M
--
-----------------------------------------------------------------------------
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' by key.
insert :: ToJSVal key => key -> Set key -> 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 -> Set key -> 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 entry from a list, returns if the value was removed as t'Bool'.
delete :: ToJSVal key => key -> Set key -> 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 key value pairs.
fromList :: ToJSVal key => [key] -> 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 -> Set key -> 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 -> Set key -> 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 -> Set key -> 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 -> Set key -> 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 -> Set key -> 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 -> Set key -> 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]
-----------------------------------------------------------------------------