{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeOperators     #-}

module Control.Empty where

import qualified Control.Applicative             as AP
import           Data.Functor.Compose
import qualified Data.Functor.Product            as FP
import qualified Data.IntMap                     as IntMap
import qualified Data.Map                        as Map
import           Data.Proxy
import           Data.Semigroup
import qualified Data.Sequence                   as Seq
import qualified Data.Set                        as Set
import           GHC.Conc
import           Text.ParserCombinators.ReadP
import           Text.ParserCombinators.ReadPrec

{-| The class of type of @* -> *@ which may be empty.
    There is only one law for HasEmpty and its enforced by the type.
    The law is that there exists a value in type f for which a is fully generic.
    This alone is often enough to uniquely determine the value for a given,
    data type.

    Additional laws for HasEmpty work backwards, @empty@ has a relationships
    with other classes. So if @f@ is a member of one of these classes,
    the following should hold.

    [/Functor identity/]

        @g \<$\> empty = empty@

    [/Applicative annihilation left/]

        @x \<*\> empty = empty@

    [/Applicative annihilation right/]

        @empty \<*\> x = empty@

    [/Monad identity/]

        @empty >>= f = empty@

    [/Alternative empty/]

        @empty = Alternative.empty@

    [/MonadPlus mzero/]

        @empty = mzero@

    [/Foldable identity/]

        @foldr f x empty = empty@

-}
class HasEmpty f where
    empty :: forall a. f a
    default empty :: AP.Alternative f => f a
    empty = AP.empty

instance HasEmpty Maybe
instance HasEmpty []
instance HasEmpty IO
instance HasEmpty STM
instance HasEmpty Proxy
instance HasEmpty Option
instance HasEmpty ReadP
instance HasEmpty ReadPrec

instance (AP.Alternative f, AP.Alternative g) => HasEmpty (FP.Product f g)
instance (AP.Alternative f, AP.Applicative g) => HasEmpty (Compose f g)

instance HasEmpty IntMap.IntMap where empty = mempty
instance HasEmpty (Map.Map k)   where empty = Map.empty
instance HasEmpty Seq.Seq       where empty = Seq.empty
instance HasEmpty Set.Set       where empty = Set.empty


coerce :: HasEmpty f => a -> f b
coerce _ = empty


isEmpty :: (HasEmpty f, Eq (f a)) => f a -> Bool
isEmpty = (== empty)