{-|
Module      : Prosidy.Types.Set
Description : An unordered collection of unique items.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Prosidy.Types.Set (Set(..), asHashSet, fromHashSet, toHashSet) where

import           Data.HashSet                   ( HashSet )
import           GHC.Generics                   ( Generic )
import           Data.Aeson                     ( FromJSONKey
                                                , ToJSONKey
                                                , ToJSON(..)
                                                , FromJSON(..)
                                                )
import           Control.DeepSeq                ( NFData )
import           Data.Binary                    ( Binary(..) )
import           Data.Hashable                  ( Hashable(..) )
import qualified Data.HashSet                  as HS
import qualified Data.HashMap.Strict           as HM

-- | A newtype wrapper around an unordered collection of unique elements.
--
-- Currently, this is implemented as a wrapper around a 'HashSet'.
newtype Set a = Set (HashSet a)
  deriving stock ((forall x. Set a -> Rep (Set a) x)
-> (forall x. Rep (Set a) x -> Set a) -> Generic (Set a)
forall x. Rep (Set a) x -> Set a
forall x. Set a -> Rep (Set a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Set a) x -> Set a
forall a x. Set a -> Rep (Set a) x
$cto :: forall a x. Rep (Set a) x -> Set a
$cfrom :: forall a x. Set a -> Rep (Set a) x
Generic)
  deriving newtype (Set a -> Set a -> Bool
(Set a -> Set a -> Bool) -> (Set a -> Set a -> Bool) -> Eq (Set a)
forall a. Eq a => Set a -> Set a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set a -> Set a -> Bool
$c/= :: forall a. Eq a => Set a -> Set a -> Bool
== :: Set a -> Set a -> Bool
$c== :: forall a. Eq a => Set a -> Set a -> Bool
Eq, a -> Set a -> Bool
Set m -> m
Set a -> [a]
Set a -> Bool
Set a -> Int
Set a -> a
Set a -> a
Set a -> a
Set a -> a
(a -> m) -> Set a -> m
(a -> m) -> Set a -> m
(a -> b -> b) -> b -> Set a -> b
(a -> b -> b) -> b -> Set a -> b
(b -> a -> b) -> b -> Set a -> b
(b -> a -> b) -> b -> Set a -> b
(a -> a -> a) -> Set a -> a
(a -> a -> a) -> Set a -> a
(forall m. Monoid m => Set m -> m)
-> (forall m a. Monoid m => (a -> m) -> Set a -> m)
-> (forall m a. Monoid m => (a -> m) -> Set a -> m)
-> (forall a b. (a -> b -> b) -> b -> Set a -> b)
-> (forall a b. (a -> b -> b) -> b -> Set a -> b)
-> (forall b a. (b -> a -> b) -> b -> Set a -> b)
-> (forall b a. (b -> a -> b) -> b -> Set a -> b)
-> (forall a. (a -> a -> a) -> Set a -> a)
-> (forall a. (a -> a -> a) -> Set a -> a)
-> (forall a. Set a -> [a])
-> (forall a. Set a -> Bool)
-> (forall a. Set a -> Int)
-> (forall a. Eq a => a -> Set a -> Bool)
-> (forall a. Ord a => Set a -> a)
-> (forall a. Ord a => Set a -> a)
-> (forall a. Num a => Set a -> a)
-> (forall a. Num a => Set a -> a)
-> Foldable Set
forall a. Eq a => a -> Set a -> Bool
forall a. Num a => Set a -> a
forall a. Ord a => Set a -> a
forall m. Monoid m => Set m -> m
forall a. Set a -> Bool
forall a. Set a -> Int
forall a. Set a -> [a]
forall a. (a -> a -> a) -> Set a -> a
forall m a. Monoid m => (a -> m) -> Set a -> m
forall b a. (b -> a -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Set a -> a
$cproduct :: forall a. Num a => Set a -> a
sum :: Set a -> a
$csum :: forall a. Num a => Set a -> a
minimum :: Set a -> a
$cminimum :: forall a. Ord a => Set a -> a
maximum :: Set a -> a
$cmaximum :: forall a. Ord a => Set a -> a
elem :: a -> Set a -> Bool
$celem :: forall a. Eq a => a -> Set a -> Bool
length :: Set a -> Int
$clength :: forall a. Set a -> Int
null :: Set a -> Bool
$cnull :: forall a. Set a -> Bool
toList :: Set a -> [a]
$ctoList :: forall a. Set a -> [a]
foldl1 :: (a -> a -> a) -> Set a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Set a -> a
foldr1 :: (a -> a -> a) -> Set a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Set a -> a
foldl' :: (b -> a -> b) -> b -> Set a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldl :: (b -> a -> b) -> b -> Set a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Set a -> b
foldr' :: (a -> b -> b) -> b -> Set a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr :: (a -> b -> b) -> b -> Set a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldMap' :: (a -> m) -> Set a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Set a -> m
foldMap :: (a -> m) -> Set a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Set a -> m
fold :: Set m -> m
$cfold :: forall m. Monoid m => Set m -> m
Foldable, Int -> Set a -> ShowS
[Set a] -> ShowS
Set a -> String
(Int -> Set a -> ShowS)
-> (Set a -> String) -> ([Set a] -> ShowS) -> Show (Set a)
forall a. Show a => Int -> Set a -> ShowS
forall a. Show a => [Set a] -> ShowS
forall a. Show a => Set a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Set a] -> ShowS
$cshowList :: forall a. Show a => [Set a] -> ShowS
show :: Set a -> String
$cshow :: forall a. Show a => Set a -> String
showsPrec :: Int -> Set a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Set a -> ShowS
Show, Set a -> ()
(Set a -> ()) -> NFData (Set a)
forall a. NFData a => Set a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Set a -> ()
$crnf :: forall a. NFData a => Set a -> ()
NFData, b -> Set a -> Set a
NonEmpty (Set a) -> Set a
Set a -> Set a -> Set a
(Set a -> Set a -> Set a)
-> (NonEmpty (Set a) -> Set a)
-> (forall b. Integral b => b -> Set a -> Set a)
-> Semigroup (Set a)
forall b. Integral b => b -> Set a -> Set a
forall a. (Hashable a, Eq a) => NonEmpty (Set a) -> Set a
forall a. (Hashable a, Eq a) => Set a -> Set a -> Set a
forall a b. (Hashable a, Eq a, Integral b) => b -> Set a -> Set a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Set a -> Set a
$cstimes :: forall a b. (Hashable a, Eq a, Integral b) => b -> Set a -> Set a
sconcat :: NonEmpty (Set a) -> Set a
$csconcat :: forall a. (Hashable a, Eq a) => NonEmpty (Set a) -> Set a
<> :: Set a -> Set a -> Set a
$c<> :: forall a. (Hashable a, Eq a) => Set a -> Set a -> Set a
Semigroup, Semigroup (Set a)
Set a
Semigroup (Set a) =>
Set a
-> (Set a -> Set a -> Set a)
-> ([Set a] -> Set a)
-> Monoid (Set a)
[Set a] -> Set a
Set a -> Set a -> Set a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. (Hashable a, Eq a) => Semigroup (Set a)
forall a. (Hashable a, Eq a) => Set a
forall a. (Hashable a, Eq a) => [Set a] -> Set a
forall a. (Hashable a, Eq a) => Set a -> Set a -> Set a
mconcat :: [Set a] -> Set a
$cmconcat :: forall a. (Hashable a, Eq a) => [Set a] -> Set a
mappend :: Set a -> Set a -> Set a
$cmappend :: forall a. (Hashable a, Eq a) => Set a -> Set a -> Set a
mempty :: Set a
$cmempty :: forall a. (Hashable a, Eq a) => Set a
$cp1Monoid :: forall a. (Hashable a, Eq a) => Semigroup (Set a)
Monoid, Int -> Set a -> Int
Set a -> Int
(Int -> Set a -> Int) -> (Set a -> Int) -> Hashable (Set a)
forall a. Hashable a => Int -> Set a -> Int
forall a. Hashable a => Set a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Set a -> Int
$chash :: forall a. Hashable a => Set a -> Int
hashWithSalt :: Int -> Set a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Set a -> Int
Hashable)

instance (Hashable a, Eq a, ToJSONKey a) => ToJSON (Set a) where
    toJSON :: Set a -> Value
toJSON (Set hs :: HashSet a
hs) = HashMap a Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap a Bool -> Value) -> HashMap a Bool -> Value
forall a b. (a -> b) -> a -> b
$ (a -> HashMap a Bool) -> HashSet a -> HashMap a Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> Bool -> HashMap a Bool) -> Bool -> a -> HashMap a Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> HashMap a Bool
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Bool
True) HashSet a
hs
    toEncoding :: Set a -> Encoding
toEncoding (Set hs :: HashSet a
hs) = HashMap a Bool -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (HashMap a Bool -> Encoding) -> HashMap a Bool -> Encoding
forall a b. (a -> b) -> a -> b
$ (a -> HashMap a Bool) -> HashSet a -> HashMap a Bool
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> Bool -> HashMap a Bool) -> Bool -> a -> HashMap a Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Bool -> HashMap a Bool
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton Bool
True) HashSet a
hs

instance (Hashable a, Eq a, FromJSONKey a) => FromJSON (Set a) where
    parseJSON :: Value -> Parser (Set a)
parseJSON json :: Value
json = do
        HashMap a Bool
m <- Value -> Parser (HashMap a Bool)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
json
        Set a -> Parser (Set a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> Parser (Set a))
-> (HashMap a Bool -> Set a) -> HashMap a Bool -> Parser (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> Set a
forall a. HashSet a -> Set a
Set (HashSet a -> Set a)
-> (HashMap a Bool -> HashSet a) -> HashMap a Bool -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap a Bool -> HashSet a
forall k a. HashMap k a -> HashSet k
HM.keysSet (HashMap a Bool -> Parser (Set a))
-> HashMap a Bool -> Parser (Set a)
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> HashMap a Bool -> HashMap a Bool
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter Bool -> Bool
forall a. a -> a
id HashMap a Bool
m

instance (Eq a, Hashable a, Binary a) => Binary (Set a) where
    get :: Get (Set a)
get = HashSet a -> Set a
forall a. HashSet a -> Set a
Set (HashSet a -> Set a) -> ([a] -> HashSet a) -> [a] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([a] -> Set a) -> Get [a] -> Get (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [a]
forall t. Binary t => Get t
get

    put :: Set a -> Put
put (Set s :: HashSet a
s) = [a] -> Put
forall t. Binary t => t -> Put
put ([a] -> Put) -> [a] -> Put
forall a b. (a -> b) -> a -> b
$ HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList HashSet a
s

-- | Given a function which operates on 'HashSet's, return a function which
-- performs the same operation on a 'Set'.
asHashSet :: Functor f => (HashSet a -> f (HashSet b)) -> Set a -> f (Set b)
asHashSet :: (HashSet a -> f (HashSet b)) -> Set a -> f (Set b)
asHashSet f :: HashSet a -> f (HashSet b)
f (Set s :: HashSet a
s) = HashSet b -> Set b
forall a. HashSet a -> Set a
Set (HashSet b -> Set b) -> f (HashSet b) -> f (Set b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet a -> f (HashSet b)
f HashSet a
s

-- | Convert a 'Set' to a 'HashSet'.
toHashSet :: Set a -> HashSet a
toHashSet :: Set a -> HashSet a
toHashSet (Set s :: HashSet a
s) = HashSet a
s

-- | Convert a 'HashSet' to a 'Set'.
fromHashSet :: HashSet a -> Set a
fromHashSet :: HashSet a -> Set a
fromHashSet = HashSet a -> Set a
forall a. HashSet a -> Set a
Set