{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Provides a strict implementation of a non-empty set.
--
module Data.Set.Strict.NonEmptySet
    (
    -- * Type
      NonEmptySet

    -- * Construction
    , fromList
    , fromSet
    , singleton

    -- * Deconstruction
    , toList
    , toSet

    -- * Insertion
    , insert

    -- * Deletion
    , delete

    -- * Membership
    , member

    -- * Combination
    , union

    ) where

import Prelude

import Control.DeepSeq
    ( NFData )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict.NonEmptyMap
    ( NonEmptyMap )
import Data.Maybe
    ( isJust )
import Data.Set
    ( Set )
import GHC.Generics
    ( Generic (..) )

import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.NonEmptyMap as NonEmptyMap

-- | A non-empty set of elements of type 'a'.
--
newtype NonEmptySet a = NonEmptySet
    { NonEmptySet a -> NonEmptyMap a ()
elements :: NonEmptyMap a ()
    }
    deriving (NonEmptySet a -> NonEmptySet a -> Bool
(NonEmptySet a -> NonEmptySet a -> Bool)
-> (NonEmptySet a -> NonEmptySet a -> Bool) -> Eq (NonEmptySet a)
forall a. Eq a => NonEmptySet a -> NonEmptySet a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonEmptySet a -> NonEmptySet a -> Bool
$c/= :: forall a. Eq a => NonEmptySet a -> NonEmptySet a -> Bool
== :: NonEmptySet a -> NonEmptySet a -> Bool
$c== :: forall a. Eq a => NonEmptySet a -> NonEmptySet a -> Bool
Eq, (forall x. NonEmptySet a -> Rep (NonEmptySet a) x)
-> (forall x. Rep (NonEmptySet a) x -> NonEmptySet a)
-> Generic (NonEmptySet a)
forall x. Rep (NonEmptySet a) x -> NonEmptySet a
forall x. NonEmptySet a -> Rep (NonEmptySet a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NonEmptySet a) x -> NonEmptySet a
forall a x. NonEmptySet a -> Rep (NonEmptySet a) x
$cto :: forall a x. Rep (NonEmptySet a) x -> NonEmptySet a
$cfrom :: forall a x. NonEmptySet a -> Rep (NonEmptySet a) x
Generic, ReadPrec [NonEmptySet a]
ReadPrec (NonEmptySet a)
Int -> ReadS (NonEmptySet a)
ReadS [NonEmptySet a]
(Int -> ReadS (NonEmptySet a))
-> ReadS [NonEmptySet a]
-> ReadPrec (NonEmptySet a)
-> ReadPrec [NonEmptySet a]
-> Read (NonEmptySet a)
forall a. (Read a, Ord a) => ReadPrec [NonEmptySet a]
forall a. (Read a, Ord a) => ReadPrec (NonEmptySet a)
forall a. (Read a, Ord a) => Int -> ReadS (NonEmptySet a)
forall a. (Read a, Ord a) => ReadS [NonEmptySet a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NonEmptySet a]
$creadListPrec :: forall a. (Read a, Ord a) => ReadPrec [NonEmptySet a]
readPrec :: ReadPrec (NonEmptySet a)
$creadPrec :: forall a. (Read a, Ord a) => ReadPrec (NonEmptySet a)
readList :: ReadS [NonEmptySet a]
$creadList :: forall a. (Read a, Ord a) => ReadS [NonEmptySet a]
readsPrec :: Int -> ReadS (NonEmptySet a)
$creadsPrec :: forall a. (Read a, Ord a) => Int -> ReadS (NonEmptySet a)
Read, Int -> NonEmptySet a -> ShowS
[NonEmptySet a] -> ShowS
NonEmptySet a -> String
(Int -> NonEmptySet a -> ShowS)
-> (NonEmptySet a -> String)
-> ([NonEmptySet a] -> ShowS)
-> Show (NonEmptySet a)
forall a. Show a => Int -> NonEmptySet a -> ShowS
forall a. Show a => [NonEmptySet a] -> ShowS
forall a. Show a => NonEmptySet a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonEmptySet a] -> ShowS
$cshowList :: forall a. Show a => [NonEmptySet a] -> ShowS
show :: NonEmptySet a -> String
$cshow :: forall a. Show a => NonEmptySet a -> String
showsPrec :: Int -> NonEmptySet a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NonEmptySet a -> ShowS
Show)

instance Foldable NonEmptySet where
    foldMap :: (a -> m) -> NonEmptySet a -> m
foldMap a -> m
f NonEmptySet a
s = ((a, ()) -> m) -> NonEmpty (a, ()) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((a, ()) -> a) -> (a, ()) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ()) -> a
forall a b. (a, b) -> a
fst) (NonEmptyMap a () -> NonEmpty (a, ())
forall k v. NonEmptyMap k v -> NonEmpty (k, v)
NonEmptyMap.toList (NonEmptyMap a () -> NonEmpty (a, ()))
-> NonEmptyMap a () -> NonEmpty (a, ())
forall a b. (a -> b) -> a -> b
$ NonEmptySet a -> NonEmptyMap a ()
forall a. NonEmptySet a -> NonEmptyMap a ()
elements NonEmptySet a
s)

instance NFData a => NFData (NonEmptySet a)

fromList :: Ord a => NonEmpty a -> NonEmptySet a
fromList :: NonEmpty a -> NonEmptySet a
fromList = NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (NonEmptyMap a () -> NonEmptySet a)
-> (NonEmpty a -> NonEmptyMap a ()) -> NonEmpty a -> NonEmptySet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (a, ()) -> NonEmptyMap a ()
forall k v. Ord k => NonEmpty (k, v) -> NonEmptyMap k v
NonEmptyMap.fromList (NonEmpty (a, ()) -> NonEmptyMap a ())
-> (NonEmpty a -> NonEmpty (a, ()))
-> NonEmpty a
-> NonEmptyMap a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, ())) -> NonEmpty a -> NonEmpty (a, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ())

fromSet :: Set a -> Maybe (NonEmptySet a)
fromSet :: Set a -> Maybe (NonEmptySet a)
fromSet = (NonEmptyMap a () -> NonEmptySet a)
-> Maybe (NonEmptyMap a ()) -> Maybe (NonEmptySet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (Maybe (NonEmptyMap a ()) -> Maybe (NonEmptySet a))
-> (Set a -> Maybe (NonEmptyMap a ()))
-> Set a
-> Maybe (NonEmptySet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a () -> Maybe (NonEmptyMap a ())
forall k v. Map k v -> Maybe (NonEmptyMap k v)
NonEmptyMap.fromMap (Map a () -> Maybe (NonEmptyMap a ()))
-> (Set a -> Map a ()) -> Set a -> Maybe (NonEmptyMap a ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ()) -> Set a -> Map a ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> a -> ()
forall a b. a -> b -> a
const ())

toList :: NonEmptySet a -> NonEmpty a
toList :: NonEmptySet a -> NonEmpty a
toList = ((a, ()) -> a) -> NonEmpty (a, ()) -> NonEmpty a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ()) -> a
forall a b. (a, b) -> a
fst (NonEmpty (a, ()) -> NonEmpty a)
-> (NonEmptySet a -> NonEmpty (a, ()))
-> NonEmptySet a
-> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMap a () -> NonEmpty (a, ())
forall k v. NonEmptyMap k v -> NonEmpty (k, v)
NonEmptyMap.toList (NonEmptyMap a () -> NonEmpty (a, ()))
-> (NonEmptySet a -> NonEmptyMap a ())
-> NonEmptySet a
-> NonEmpty (a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptySet a -> NonEmptyMap a ()
forall a. NonEmptySet a -> NonEmptyMap a ()
elements

toSet :: Ord a => NonEmptySet a -> Set a
toSet :: NonEmptySet a -> Set a
toSet = Map a () -> Set a
forall k a. Map k a -> Set k
Map.keysSet (Map a () -> Set a)
-> (NonEmptySet a -> Map a ()) -> NonEmptySet a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyMap a () -> Map a ()
forall k v. Ord k => NonEmptyMap k v -> Map k v
NonEmptyMap.toMap (NonEmptyMap a () -> Map a ())
-> (NonEmptySet a -> NonEmptyMap a ()) -> NonEmptySet a -> Map a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptySet a -> NonEmptyMap a ()
forall a. NonEmptySet a -> NonEmptyMap a ()
elements

insert :: Ord a => a -> NonEmptySet a -> NonEmptySet a
insert :: a -> NonEmptySet a -> NonEmptySet a
insert a
a (NonEmptySet NonEmptyMap a ()
m) = NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (NonEmptyMap a () -> NonEmptySet a)
-> NonEmptyMap a () -> NonEmptySet a
forall a b. (a -> b) -> a -> b
$ a -> () -> NonEmptyMap a () -> NonEmptyMap a ()
forall k v. Ord k => k -> v -> NonEmptyMap k v -> NonEmptyMap k v
NonEmptyMap.insert a
a () NonEmptyMap a ()
m

delete :: Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
delete :: a -> NonEmptySet a -> Maybe (NonEmptySet a)
delete a
a (NonEmptySet NonEmptyMap a ()
m) = (NonEmptyMap a () -> NonEmptySet a)
-> Maybe (NonEmptyMap a ()) -> Maybe (NonEmptySet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (a -> NonEmptyMap a () -> Maybe (NonEmptyMap a ())
forall k a.
Ord k =>
k -> NonEmptyMap k a -> Maybe (NonEmptyMap k a)
NonEmptyMap.delete a
a NonEmptyMap a ()
m)

member :: Ord a => a -> NonEmptySet a -> Bool
member :: a -> NonEmptySet a -> Bool
member a
a (NonEmptySet NonEmptyMap a ()
m) = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ a -> NonEmptyMap a () -> Maybe ()
forall k v. Ord k => k -> NonEmptyMap k v -> Maybe v
NonEmptyMap.lookup a
a NonEmptyMap a ()
m

singleton :: Ord a => a -> NonEmptySet a
singleton :: a -> NonEmptySet a
singleton a
a = NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (NonEmptyMap a () -> NonEmptySet a)
-> NonEmptyMap a () -> NonEmptySet a
forall a b. (a -> b) -> a -> b
$ a -> () -> NonEmptyMap a ()
forall k v. Ord k => k -> v -> NonEmptyMap k v
NonEmptyMap.singleton a
a ()

union :: Ord a => NonEmptySet a -> NonEmptySet a -> NonEmptySet a
union :: NonEmptySet a -> NonEmptySet a -> NonEmptySet a
union (NonEmptySet NonEmptyMap a ()
x) (NonEmptySet NonEmptyMap a ()
y) = NonEmptyMap a () -> NonEmptySet a
forall a. NonEmptyMap a () -> NonEmptySet a
NonEmptySet (NonEmptyMap a () -> NonEmptySet a)
-> NonEmptyMap a () -> NonEmptySet a
forall a b. (a -> b) -> a -> b
$
    (() -> () -> ())
-> NonEmptyMap a () -> NonEmptyMap a () -> NonEmptyMap a ()
forall k v.
Ord k =>
(v -> v -> v)
-> NonEmptyMap k v -> NonEmptyMap k v -> NonEmptyMap k v
NonEmptyMap.unionWith () -> () -> ()
forall a b. a -> b -> a
const NonEmptyMap a ()
x NonEmptyMap a ()
y