module Data.Monoid.Zero
(
MonoidZero(..),
AdjoinZero(..),
MonoidLZero(..),
AdjoinLZero(..),
MonoidRZero(..),
AdjoinRZero(..),
)
where
import Control.Applicative (pure, (<$>))
import Data.Foldable (Foldable (..))
import Data.Traversable (Traversable (..))
import Data.Monoid (Monoid(..), Product(..), All(..), Any(..))
class (Monoid m) => MonoidZero m where
zero :: m
newtype AdjoinZero m = AdjoinZero { adjoinZero :: Maybe m }
deriving (Functor, Eq, Ord)
instance (Show m) => Show (AdjoinZero m) where
show (AdjoinZero (Just m)) = show m
show (AdjoinZero Nothing) = "*"
instance Foldable AdjoinZero where
foldMap f (AdjoinZero (Just m)) = f m
foldMap f (AdjoinZero Nothing) = mempty
instance Traversable AdjoinZero where
traverse f (AdjoinZero (Just a)) = AdjoinZero . Just <$> f a
traverse f (AdjoinZero Nothing) = pure $ AdjoinZero Nothing
instance (Monoid m) => Monoid (AdjoinZero m) where
mempty = AdjoinZero $ Just $ mempty
AdjoinZero Nothing `mappend` _ = AdjoinZero Nothing
_ `mappend` AdjoinZero Nothing = AdjoinZero Nothing
AdjoinZero (Just m) `mappend` AdjoinZero (Just n) =
AdjoinZero $ Just (m `mappend` n)
instance (Monoid m) => MonoidZero (AdjoinZero m) where
zero = AdjoinZero Nothing
instance (Monoid m) => MonoidLZero (AdjoinZero m) where
lzero = AdjoinZero Nothing
instance (Monoid m) => MonoidRZero (AdjoinZero m) where
rzero = AdjoinZero Nothing
instance (Num n) => MonoidZero (Product n) where
zero = Product 0
instance MonoidZero All where
zero = All False
instance MonoidZero Any where
zero = Any True
instance MonoidZero () where
zero = ()
instance (MonoidZero a, MonoidZero b) => MonoidZero (a, b) where
zero = (zero, zero)
instance (MonoidZero a, MonoidZero b, MonoidZero c) => MonoidZero (a, b, c) where
zero = (zero, zero, zero)
instance (MonoidZero a, MonoidZero b, MonoidZero c, MonoidZero d) => MonoidZero (a, b, c, d) where
zero = (zero, zero, zero, zero)
instance (MonoidZero a, MonoidZero b, MonoidZero c, MonoidZero d, MonoidZero e) => MonoidZero (a, b, c, d, e) where
zero = (zero, zero, zero, zero, zero)
class (Monoid m) => MonoidLZero m where
lzero :: m
newtype AdjoinLZero m = AdjoinLZero { unAdjoinLZero :: (Bool, m) }
deriving (Functor, Eq, Ord)
instance Foldable AdjoinLZero where
foldMap f (AdjoinLZero (_, a)) = f a
instance Traversable AdjoinLZero where
traverse f (AdjoinLZero (b, a)) = AdjoinLZero . (b, ) <$> f a
instance (Show m) => Show (AdjoinLZero m) where
show (AdjoinLZero (b, m)) = (if b then "*" else "") ++ show m
instance (Monoid m) => Monoid (AdjoinLZero m) where
mempty = AdjoinLZero (False, mempty)
_ `mappend` AdjoinLZero (True, n) = AdjoinLZero (True, n)
AdjoinLZero (b, m) `mappend` AdjoinLZero (False, n) =
AdjoinLZero (b, m `mappend` n)
instance (Monoid m) => MonoidLZero (AdjoinLZero m) where
lzero = AdjoinLZero (True, mempty)
instance (Num n) => MonoidLZero (Product n) where
lzero = Product 0
instance MonoidLZero All where
lzero = All False
instance MonoidLZero Any where
lzero = Any True
instance MonoidLZero () where
lzero = ()
instance (MonoidLZero a, MonoidLZero b) => MonoidLZero (a, b) where
lzero = (lzero, lzero)
instance (MonoidLZero a, MonoidLZero b, MonoidLZero c) => MonoidLZero (a, b, c) where
lzero = (lzero, lzero, lzero)
instance (MonoidLZero a, MonoidLZero b, MonoidLZero c, MonoidLZero d) => MonoidLZero (a, b, c, d) where
lzero = (lzero, lzero, lzero, lzero)
instance (MonoidLZero a, MonoidLZero b, MonoidLZero c, MonoidLZero d, MonoidLZero e) => MonoidLZero (a, b, c, d, e) where
lzero = (lzero, lzero, lzero, lzero, lzero)
class (Monoid m) => MonoidRZero m where
rzero :: m
newtype AdjoinRZero m = AdjoinRZero { unAdjoinRZero :: (m, Bool) }
deriving (Functor, Eq, Ord)
instance Foldable AdjoinRZero where
foldMap f (AdjoinRZero (a, _)) = f a
instance Traversable AdjoinRZero where
traverse f (AdjoinRZero (a, b)) = AdjoinRZero . (, b) <$> f a
instance (Show m) => Show (AdjoinRZero m) where
show (AdjoinRZero (m, b)) = show m ++ (if b then "*" else "")
instance (Monoid m) => Monoid (AdjoinRZero m) where
mempty = AdjoinRZero (mempty, False)
AdjoinRZero (m, True) `mappend` _ = AdjoinRZero (m, True)
AdjoinRZero (m, False) `mappend` AdjoinRZero (n, b) =
AdjoinRZero (m `mappend` n, b)
instance (Monoid m) => MonoidRZero (AdjoinRZero m) where
rzero = AdjoinRZero (mempty, True)
instance (Num n) => MonoidRZero (Product n) where
rzero = Product 0
instance MonoidRZero All where
rzero = All False
instance MonoidRZero Any where
rzero = Any True
instance MonoidRZero () where
rzero = ()
instance (MonoidRZero a, MonoidRZero b) => MonoidRZero (a, b) where
rzero = (rzero, rzero)
instance (MonoidRZero a, MonoidRZero b, MonoidRZero c) => MonoidRZero (a, b, c) where
rzero = (rzero, rzero, rzero)
instance (MonoidRZero a, MonoidRZero b, MonoidRZero c, MonoidRZero d) => MonoidRZero (a, b, c, d) where
rzero = (rzero, rzero, rzero, rzero)
instance (MonoidRZero a, MonoidRZero b, MonoidRZero c, MonoidRZero d, MonoidRZero e) => MonoidRZero (a, b, c, d, e) where
rzero = (rzero, rzero, rzero, rzero, rzero)