{-# 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 Data.Aeson (FromJSON (parseJSON), ToJSON)
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, [NonEmptySet a] -> Value
[NonEmptySet a] -> Encoding
NonEmptySet a -> Bool
NonEmptySet a -> Value
NonEmptySet a -> Encoding
(NonEmptySet a -> Value)
-> (NonEmptySet a -> Encoding)
-> ([NonEmptySet a] -> Value)
-> ([NonEmptySet a] -> Encoding)
-> (NonEmptySet a -> Bool)
-> ToJSON (NonEmptySet a)
forall a. ToJSON a => [NonEmptySet a] -> Value
forall a. ToJSON a => [NonEmptySet a] -> Encoding
forall a. ToJSON a => NonEmptySet a -> Bool
forall a. ToJSON a => NonEmptySet a -> Value
forall a. ToJSON a => NonEmptySet a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => NonEmptySet a -> Value
toJSON :: NonEmptySet a -> Value
$ctoEncoding :: forall a. ToJSON a => NonEmptySet a -> Encoding
toEncoding :: NonEmptySet a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [NonEmptySet a] -> Value
toJSONList :: [NonEmptySet a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [NonEmptySet a] -> Encoding
toEncodingList :: [NonEmptySet a] -> Encoding
$comitField :: forall a. ToJSON a => NonEmptySet a -> Bool
omitField :: NonEmptySet a -> Bool
ToJSON)

instance (Ord a, FromJSON a) => FromJSON (NonEmptySet a) where
  parseJSON :: Value -> Parser (NonEmptySet a)
parseJSON Value
v = do
    s <- Value -> Parser (Set a)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case fromSet s of
      Maybe (NonEmptySet a)
Nothing -> String -> Parser (NonEmptySet a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty set found, expected non-empty"
      Just NonEmptySet a
nes -> NonEmptySet a -> Parser (NonEmptySet a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmptySet a
nes

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