{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE LambdaCase #-}

module Data.Empty where

-- | A type that may be empty.
-- If your type does not have a special empty value, just wrap it into 'Maybe',
-- it is free.
--
-- Based on Control.Lens.Empty.AsEmpty.
class AsEmpty a where
    empty :: a

    isEmpty :: a -> Bool
    default isEmpty :: Eq a => a -> Bool
    isEmpty a
a = a
forall a. AsEmpty a => a
empty a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a

    isNotEmpty :: a -> Bool
    default isNotEmpty :: Eq a => a -> Bool
    isNotEmpty a
a = a
forall a. AsEmpty a => a
empty a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a

instance AsEmpty (Maybe a) where
    empty :: Maybe a
empty = Maybe a
forall a. Maybe a
Nothing

    isEmpty :: Maybe a -> Bool
isEmpty = \case
        Maybe a
Nothing -> Bool
True
        Maybe a
_       -> Bool
False

    isNotEmpty :: Maybe a -> Bool
isNotEmpty = \case
        Maybe a
Nothing -> Bool
False
        Maybe a
_       -> Bool
True

instance AsEmpty Char where
    empty :: Char
empty = Char
'\NUL'