{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}

module Data.Set.NonEmpty (
  NonEmptySet,
  fromFoldable,
  fromSet,
  singleton,
  toList,
  toSet,
) where

import Cardano.Ledger.Binary (DecCBOR (decCBOR), EncCBOR, decodeSet)
import Control.DeepSeq (NFData)
import qualified Data.Foldable as Foldable
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable (Typeable)
import NoThunks.Class (NoThunks)

newtype NonEmptySet a = NonEmptySet (Set a)
  deriving stock (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
$cshowsPrec :: forall a. Show a => Int -> NonEmptySet a -> ShowS
showsPrec :: Int -> NonEmptySet a -> ShowS
$cshow :: forall a. Show a => NonEmptySet a -> String
show :: NonEmptySet a -> String
$cshowList :: forall a. Show a => [NonEmptySet a] -> ShowS
showList :: [NonEmptySet a] -> ShowS
Show, 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
$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
/= :: NonEmptySet a -> NonEmptySet a -> Bool
Eq)
  deriving newtype (NonEmptySet a -> Encoding
(NonEmptySet a -> Encoding) -> EncCBOR (NonEmptySet a)
forall a. EncCBOR a => NonEmptySet a -> Encoding
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: forall a. EncCBOR a => NonEmptySet a -> Encoding
encCBOR :: NonEmptySet a -> Encoding
EncCBOR, Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
Proxy (NonEmptySet a) -> String
(Context -> NonEmptySet a -> IO (Maybe ThunkInfo))
-> (Context -> NonEmptySet a -> IO (Maybe ThunkInfo))
-> (Proxy (NonEmptySet a) -> String)
-> NoThunks (NonEmptySet a)
forall a.
NoThunks a =>
Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (NonEmptySet a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
noThunks :: Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NonEmptySet a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (NonEmptySet a) -> String
showTypeOf :: Proxy (NonEmptySet a) -> String
NoThunks, NonEmptySet a -> ()
(NonEmptySet a -> ()) -> NFData (NonEmptySet a)
forall a. NFData a => NonEmptySet a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => NonEmptySet a -> ()
rnf :: NonEmptySet a -> ()
NFData)

instance (Typeable a, Ord a, DecCBOR a) => DecCBOR (NonEmptySet a) where
  decCBOR :: forall s. Decoder s (NonEmptySet a)
decCBOR = do
    set <- Decoder s a -> Decoder s (Set a)
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
    case fromSet set of
      Maybe (NonEmptySet a)
Nothing -> String -> Decoder s (NonEmptySet a)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty set found, expected non-empty"
      Just NonEmptySet a
nes -> NonEmptySet a -> Decoder s (NonEmptySet a)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmptySet a
nes
  {-# INLINE decCBOR #-}

-- | \(O(1)\).
singleton :: a -> NonEmptySet a
singleton :: forall a. a -> NonEmptySet a
singleton = Set a -> NonEmptySet a
forall a. Set a -> NonEmptySet a
NonEmptySet (Set a -> NonEmptySet a) -> (a -> Set a) -> a -> NonEmptySet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Set a
forall a. a -> Set a
Set.singleton

-- | \(O(1)\).
fromSet :: Set a -> Maybe (NonEmptySet a)
fromSet :: forall a. Set a -> Maybe (NonEmptySet a)
fromSet Set a
set = if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
set then Maybe (NonEmptySet a)
forall a. Maybe a
Nothing else NonEmptySet a -> Maybe (NonEmptySet a)
forall a. a -> Maybe a
Just (Set a -> NonEmptySet a
forall a. Set a -> NonEmptySet a
NonEmptySet Set a
set)

-- | \(O(1)\).
toSet :: NonEmptySet a -> Set a
toSet :: forall a. NonEmptySet a -> Set a
toSet (NonEmptySet Set a
set) = Set a
set

-- | \(O(n \log n)\).
fromFoldable :: (Foldable f, Ord a) => f a -> Maybe (NonEmptySet a)
fromFoldable :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
f a -> Maybe (NonEmptySet a)
fromFoldable = Set a -> Maybe (NonEmptySet a)
forall a. Set a -> Maybe (NonEmptySet a)
fromSet (Set a -> Maybe (NonEmptySet a))
-> (f a -> Set a) -> f a -> Maybe (NonEmptySet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> a -> Set a) -> Set a -> f a -> Set a
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((a -> Set a -> Set a) -> Set a -> a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert) Set a
forall a. Set a
Set.empty

-- | \(O(n)\).
toList :: NonEmptySet a -> [a]
toList :: forall a. NonEmptySet a -> [a]
toList (NonEmptySet Set a
set) = Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
set