module Distribution.Compat.NonEmptySet (
NonEmptySet,
singleton,
insert,
delete,
toNonEmpty,
fromNonEmpty,
toList,
toSet,
member,
map,
) where
import Prelude (Bool (..), Eq, Maybe (..), Ord (..), Read, Show (..), String, error, otherwise, return, showParen, showString, ($), (++), (.))
import Control.DeepSeq (NFData (..))
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup (Semigroup (..))
import Data.Typeable (Typeable)
import qualified Data.Foldable as F
import qualified Data.Set as Set
import Distribution.Compat.Binary (Binary (..))
import Distribution.Utils.Structured
#if MIN_VERSION_binary(0,6,0)
import Control.Applicative (empty)
#else
import Control.Monad (fail)
#endif
newtype NonEmptySet a = NES (Set.Set a)
deriving (Eq, Ord, Typeable, Data, Read)
instance Show a => Show (NonEmptySet a) where
showsPrec d s = showParen (d > 10)
$ showString "fromNonEmpty "
. showsPrec 11 (toNonEmpty s)
instance Binary a => Binary (NonEmptySet a) where
put (NES s) = put s
get = do
xs <- get
if Set.null xs
#if MIN_VERSION_binary(0,6,0)
then empty
#else
then fail "NonEmptySet: empty"
#endif
else return (NES xs)
instance Structured a => Structured (NonEmptySet a) where
structure = containerStructure
instance NFData a => NFData (NonEmptySet a) where
rnf (NES x) = rnf x
instance Ord a => Semigroup (NonEmptySet a) where
NES x <> NES y = NES (Set.union x y)
instance F.Foldable NonEmptySet where
foldMap f (NES s) = F.foldMap f s
foldr f z (NES s) = F.foldr f z s
#if MIN_VERSION_base(4,8,0)
toList = toList
null _ = False
length (NES s) = F.length s
#endif
singleton :: a -> NonEmptySet a
singleton = NES . Set.singleton
insert :: Ord a => a -> NonEmptySet a -> NonEmptySet a
insert x (NES xs) = NES (Set.insert x xs)
delete :: Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
delete x (NES xs)
| Set.null res = Nothing
| otherwise = Just (NES xs)
where
res = Set.delete x xs
fromNonEmpty :: Ord a => NonEmpty a -> NonEmptySet a
fromNonEmpty (x :| xs) = NES (Set.fromList (x : xs))
toNonEmpty :: NonEmptySet a -> NonEmpty a
toNonEmpty (NES s) = case Set.toList s of
[] -> panic "toNonEmpty"
x:xs -> x :| xs
toList :: NonEmptySet a -> [a]
toList (NES s) = Set.toList s
toSet :: NonEmptySet a -> Set.Set a
toSet (NES s) = s
member :: Ord a => a -> NonEmptySet a -> Bool
member x (NES xs) = Set.member x xs
map
:: ( Ord b
#if !MIN_VERSION_containers(0,5,2)
, Ord a
#endif
)
=> (a -> b) -> NonEmptySet a -> NonEmptySet b
map f (NES x) = NES (Set.map f x)
panic :: String -> a
panic msg = error $ "NonEmptySet invariant violated: " ++ msg