{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Also where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Newtype.Generics
import Data.Functor.Identity
import GHC.Generics
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,10,0)
import Data.Semigroup
#endif
class Also f a where
also :: f a -> f a -> f a
alsoZero :: f a
infixr 6 `also`
newtype Als f a = Als { getAls :: f a }
deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,
Monad, MonadPlus, Applicative, Alternative, Functor)
instance Newtype (Als f a)
instance Also f a => Semigroup (Als f a) where
(Als f) <> (Als g) = Als (f `also` g)
instance Also f a => Monoid (Als f a) where
mempty = Als alsoZero
#if !MIN_VERSION_base(4,11,0)
(Als f) `mappend` (Als g) = Als (f `also` g)
#endif
#if MIN_VERSION_base(4,11,0)
instance {-# OVERLAPPABLE #-} (Monoid a, Applicative f) => Also f a where
alsoZero = pure mempty
f `also` g = liftA2 (<>) f g
#else
instance {-# OVERLAPPABLE #-} (Monoid a, Applicative f) => Also f a where
alsoZero = pure mempty
f `also` g = liftA2 mappend f g
#endif
#if MIN_VERSION_base(4,11,0)
instance (Monoid a) => Also Identity a where
alsoZero = mempty
a `also` b = a <> b
#else
instance (Monoid a) => Also Identity a where
alsoZero = mempty
a `also` b = a `mappend` b
#endif
#if MIN_VERSION_base(4,11,0)
instance (Monoid a) => Also IO a where
alsoZero = mempty
a `also` b = a <> b
#else
instance (Monoid a) => Also IO a where
alsoZero = pure mempty
a `also` b = liftA2 mappend a b
#endif
instance (Also m a) => Also (IdentityT m) a where
alsoZero = IdentityT alsoZero
(IdentityT a) `also` (IdentityT b) = IdentityT $ a `also` b
instance (Also m r) => Also (ContT r m) a where
alsoZero = ContT . const $ alsoZero
(ContT f) `also` (ContT g) =
ContT $ \k -> (f k) `also` (g k)
instance (Also m a) => Also (ReaderT r m) a where
alsoZero = ReaderT $ const alsoZero
(ReaderT f) `also` (ReaderT g) = ReaderT $ \r -> f r `also` g r
instance (Also m (Either e a)) => Also (ExceptT e m) a where
alsoZero = ExceptT $ alsoZero
(ExceptT f) `also` (ExceptT g) = ExceptT $ f `also` g
instance (Also m (Maybe a)) => Also (MaybeT m) a where
alsoZero = MaybeT $ alsoZero
(MaybeT f) `also` (MaybeT g) = MaybeT $ f `also` g
instance (Also m a, Monad m) => Also (Lazy.StateT s m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y
instance (Also m a, Monad m) => Also (Strict.StateT s m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y
instance (Monoid w, Also m a, Monad m) => Also (Lazy.WriterT w m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y
instance (Monoid w, Also m a, Monad m) => Also (Strict.WriterT w m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y
instance (Monoid w, Also m a, Monad m) => Also (Lazy.RWST r w s m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y
instance (Monoid w, Also m a, Monad m) => Also (Strict.RWST r w s m) a where
alsoZero = lift alsoZero
f `also` g = do
(x, y) <- liftA2 (,) f g
lift $ pure x `also` pure y