module Data.Functor.ProductIsomorphic.Instances (
WrappedFunctor (..),
WrappedAlter (..),
) where
import Data.Monoid (Monoid, mempty, (<>))
import Control.Applicative
((<$>), Applicative, pure, (<*>),
Alternative, empty, (<|>),
Const (..))
import Data.Functor.ProductIsomorphic.Class
(ProductIsoFunctor(..), ProductIsoApplicative (..),
ProductIsoAlternative (..), ProductIsoEmpty (..))
instance ProductIsoFunctor (Const a) where
_ |$| Const a = Const a
instance Monoid a => ProductIsoApplicative (Const a) where
pureP _ = Const mempty
Const a |*| Const b = Const $ a <> b
instance Monoid a => ProductIsoEmpty (Const a) () where
pureE = pureP ()
peRight (Const a) = Const a
peLeft (Const a) = Const a
newtype WrappedFunctor f a = WrapFunctor { unwrapFunctor :: f a }
instance Functor f => ProductIsoFunctor (WrappedFunctor f) where
f |$| fa = WrapFunctor $ f <$> unwrapFunctor fa
instance Applicative f => ProductIsoApplicative (WrappedFunctor f) where
pureP = WrapFunctor . pure
WrapFunctor ff |*| WrapFunctor fa = WrapFunctor $ ff <*> fa
instance Alternative f => ProductIsoAlternative (WrappedFunctor f) where
emptyP = WrapFunctor empty
WrapFunctor fa1 ||| WrapFunctor fa2 = WrapFunctor $ fa1 <|> fa2
instance Applicative f => ProductIsoEmpty (WrappedFunctor f) () where
pureE = pureP ()
peRight = WrapFunctor . fmap fst . unwrapFunctor
peLeft = WrapFunctor . fmap snd . unwrapFunctor
newtype WrappedAlter f a b = WrapAlter { unWrapAlter :: Const (f a) b }
instance ProductIsoFunctor (WrappedAlter f a) where
_ |$| WrapAlter (Const fa) = WrapAlter $ Const fa
instance Alternative f => ProductIsoApplicative (WrappedAlter f a) where
pureP _ = WrapAlter $ Const empty
WrapAlter (Const a) |*| WrapAlter (Const b) = WrapAlter $ Const $ a <|> b
instance Alternative f => ProductIsoEmpty (WrappedAlter f a) () where
pureE = pureP ()
peRight = WrapAlter . fmap fst . unWrapAlter
peLeft = WrapAlter . fmap snd . unWrapAlter