content: {-# language DeriveDataTypeable #-}
  {-# language PatternSynonyms #-}
  {-# language DeriveGeneric #-}
  {-# language DeriveTraversable #-}
  {-# language FlexibleInstances #-}
  {-# language UndecidableInstances #-}
  {-# language GeneralizedNewtypeDeriving #-}
  
  module Algebra.Zero
    ( SemigroupWithZero(..)
    , WithZero(Zero,NonZero,WithZero,runWithZero)
    ) where
  
  import Control.Applicative
  import Control.Monad
  import Control.Monad.Zip
  import Data.Data hiding (Prefix)
  import Data.Semigroup
  import Data.String
  import GHC.Generics hiding (Prefix, prec)
  import Prelude
  import Text.Read
  
  -- | @
  -- zero <> a = zero = a <> zero
  -- @
  class Semigroup a => SemigroupWithZero a where
    zero :: a
  
  instance SemigroupWithZero All where
    zero = All False
  
  instance SemigroupWithZero Any where
    zero = Any True
  
  instance SemigroupWithZero a => SemigroupWithZero (Dual a) where
    zero = Dual zero
  
  instance Num a => SemigroupWithZero (Product a) where
    zero = Product 0
  
  instance (Ord a, Bounded a) => SemigroupWithZero (Max a) where
    zero = Max maxBound
  
  instance (Ord a, Bounded a) => SemigroupWithZero (Min a) where
    zero = Min minBound
  
  -- | pushout
  class (SemigroupWithZero a, Monoid a) => MonoidWithZero a
  instance (SemigroupWithZero a, Monoid a) => MonoidWithZero a
  
  -- adjoin a zero element to a semigroup
  newtype WithZero a = WithZero { runWithZero :: Maybe a }
    deriving (Eq,Ord,Data,Generic,Generic1,Functor,Foldable,Traversable,Applicative,Alternative,Monad,MonadPlus,MonadZip)
  
  {-# complete Zero, NonZero #-}
  
  pattern Zero :: WithZero a
  pattern Zero = WithZero Nothing
  
  pattern NonZero :: a -> WithZero a
  pattern NonZero a = WithZero (Just a)
  
  instance Show a => Show (WithZero a) where
    showsPrec d (NonZero a) = showParen (d > 10) $ showString "NonZero " . showsPrec 11 a
    showsPrec _ _Zero = showString "Zero"
  
  instance Read a => Read (WithZero a) where
    readPrec = parens $ (prec 10 $ do Ident "Zero" <- lexP; return Zero)
                    +++ (prec 10 $ do Ident "NonZero" <- lexP; NonZero <$> step readPrec)
    readListPrec = readListPrecDefault
  
  instance Semigroup a => Semigroup (WithZero a) where
    (<>) = liftA2 (<>)
  
  instance Semigroup a => SemigroupWithZero (WithZero a) where
    zero = empty
  
  instance Monoid a => Monoid (WithZero a) where
    mempty = empty
    mappend = liftA2 mappend
  
  instance IsString a => IsString (WithZero a) where
    fromString = NonZero . fromString
  