-- | A class for Annihilators, which define a binary function '>|>' that follows
-- the mathematical properties of: absorbing element, associativity, and
-- commutativity.
module Control.Annihilator
    ( Annihilator(..)
    , (<|<)
    , aconcat
    , amappend
    , amconcat
    , avoid
    )
    where


-- | Annihilators are semigroups with annihilators, i.e. the
-- following laws should hold:
--
-- prop> ann >|> b = ann
-- prop> a >|> ann = ann
-- prop> a >|> b = b
class Annihilator a where
    -- | Annihilating element of '>|>'.
    ann :: a

    -- | Annihilating operator, returns the rightmost element if no
    -- annihilators 'ann' are present.
    (>|>) :: a -> a -> a


instance Annihilator () where
    ann = ()
    {-# INLINE ann #-}

    _ >|> _ = ()
    {-# INLINE (>|>) #-}

instance Annihilator (Maybe a) where
    ann = Nothing
    {-# INLINE ann #-}

    Nothing >|> _ = Nothing
    _ >|> Nothing = Nothing
    _ >|> a = a
    {-# INLINE (>|>) #-}

instance Annihilator ([] a) where
    ann = []
    {-# INLINE ann #-}

    [] >|> _ = []
    _ >|> [] = []
    _ >|> a = a
    {-# INLINE (>|>) #-}

instance (Annihilator a, Annihilator b) => Annihilator (a, b) where
    ann = (ann, ann)
    {-# INLINE ann #-}

    (a1, b1) >|> (a2, b2) = (a1 >|> a2, b1 >|> b2)
    {-# INLINE (>|>) #-}


-- | Flipped version of '>|>'.
(<|<) :: Annihilator a => a -> a -> a
(<|<) = flip (>|>)
{-# INLINE (<|<) #-}

-- | Annihilating concatenation.
aconcat :: (Annihilator a, Foldable t) => t a -> a
aconcat as
    | null as   = ann
    | otherwise = foldr1 (>|>) as
{-# INLINE aconcat #-}

-- | Monadic append with the annihilating operator guarding each argument.
amappend :: (Annihilator a, Monoid a) => a -> a -> a
amappend a b = (a >|> b) `mappend` (a <|< b)
{-# INLINE amappend #-}

-- | Monadic concatenation with the annihilating operator guarding each argument.
amconcat :: (Annihilator a, Monoid a, Foldable t) => t a -> a
amconcat as
    | null as   = ann
    | otherwise = foldr1 amappend as
{-# INLINE amconcat  #-}

isAnn :: (Annihilator a, Eq a) => a -> Bool
isAnn = (ann ==)

-- | Discard the argument and return 'ann'.
avoid :: Annihilator a => a -> a
avoid = const ann
{-# INLINE avoid #-}