#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
#endif
module Data.Functor.Coyoneda
( Coyoneda(..)
, liftCoyoneda, lowerCoyoneda, lowerM
, coyonedaToLan, lanToCoyoneda
, coyonedaToLift, liftToCoyoneda
) where
import Control.Applicative
import Control.Monad (MonadPlus(..), liftM)
import Control.Monad.Fix
import Control.Monad.Trans.Class
import Control.Comonad
import Control.Comonad.Trans.Class
import Data.Distributive
import Data.Function (on)
import Data.Functor.Adjunction
import Data.Functor.Bind
import Data.Functor.Extend
import Data.Functor.Identity
import Data.Functor.Kan.Lan
import Data.Functor.Kan.Lift
import Data.Functor.Plus
import Data.Functor.Representable
import Data.Key
import Data.Foldable
import Data.Traversable
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Prelude hiding (sequence, lookup, zipWith)
import Text.Read hiding (lift)
data Coyoneda f a where
Coyoneda :: (b -> a) -> f b -> Coyoneda f a
coyonedaToLan :: Coyoneda f a -> Lan Identity f a
coyonedaToLan (Coyoneda ba fb) = Lan (ba . runIdentity) fb
lanToCoyoneda :: Lan Identity f a -> Coyoneda f a
lanToCoyoneda (Lan iba fb) = Coyoneda (iba . Identity) fb
coyonedaToLift :: Coyoneda f a -> Lift Identity f a
coyonedaToLift (Coyoneda ba fb) = Lift $ \ f2iz -> ba <$> runIdentity (f2iz fb)
liftToCoyoneda :: Functor f => Lift Identity f a -> Coyoneda f a
liftToCoyoneda (Lift m) = Coyoneda id (m Identity)
instance Functor (Coyoneda f) where
fmap f (Coyoneda g v) = Coyoneda (f . g) v
type instance Key (Coyoneda f) = Key f
instance Keyed f => Keyed (Coyoneda f) where
mapWithKey f (Coyoneda k a) = Coyoneda id $ mapWithKey (\x -> f x . k) a
instance Apply f => Apply (Coyoneda f) where
m <.> n = liftCoyoneda $ lowerCoyoneda m <.> lowerCoyoneda n
instance Applicative f => Applicative (Coyoneda f) where
pure = liftCoyoneda . pure
m <*> n = liftCoyoneda $ lowerCoyoneda m <*> lowerCoyoneda n
instance Zip f => Zip (Coyoneda f) where
zipWith f m n = liftCoyoneda $ zipWith f (lowerCoyoneda m) (lowerCoyoneda n)
instance ZipWithKey f => ZipWithKey (Coyoneda f) where
zipWithKey f m n = liftCoyoneda $ zipWithKey f (lowerCoyoneda m) (lowerCoyoneda n)
instance Alternative f => Alternative (Coyoneda f) where
empty = liftCoyoneda empty
m <|> n = liftCoyoneda $ lowerCoyoneda m <|> lowerCoyoneda n
instance Alt f => Alt (Coyoneda f) where
m <!> n = liftCoyoneda $ lowerCoyoneda m <!> lowerCoyoneda n
instance Plus f => Plus (Coyoneda f) where
zero = liftCoyoneda zero
instance Bind m => Bind (Coyoneda m) where
Coyoneda f v >>- k = liftCoyoneda (v >>- lowerCoyoneda . k . f)
instance Monad m => Monad (Coyoneda m) where
return = Coyoneda id . return
Coyoneda f v >>= k = lift (v >>= lowerM . k . f)
instance MonadTrans Coyoneda where
lift = Coyoneda id
instance MonadFix f => MonadFix (Coyoneda f) where
mfix f = lift $ mfix (lowerM . f)
instance MonadPlus f => MonadPlus (Coyoneda f) where
mzero = lift mzero
m `mplus` n = lift $ lowerM m `mplus` lowerM n
instance (Functor f, Lookup f) => Lookup (Coyoneda f) where
lookup k f = lookup k (lowerCoyoneda f)
instance (Functor f, Indexable f) => Indexable (Coyoneda f) where
index = index . lowerCoyoneda
instance Representable f => Representable (Coyoneda f) where
tabulate = liftCoyoneda . tabulate
instance Extend w => Extend (Coyoneda w) where
extended k (Coyoneda f v) = Coyoneda id $ extended (k . Coyoneda f) v
instance Comonad w => Comonad (Coyoneda w) where
extend k (Coyoneda f v) = Coyoneda id $ extend (k . Coyoneda f) v
extract (Coyoneda f v) = f (extract v)
instance ComonadTrans Coyoneda where
lower (Coyoneda f a) = fmap f a
instance Foldable f => Foldable (Coyoneda f) where
foldMap f (Coyoneda k a) = foldMap (f . k) a
instance FoldableWithKey f => FoldableWithKey (Coyoneda f) where
foldMapWithKey f (Coyoneda k a) = foldMapWithKey (\x -> f x . k) a
instance Foldable1 f => Foldable1 (Coyoneda f) where
foldMap1 f (Coyoneda k a) = foldMap1 (f . k) a
instance FoldableWithKey1 f => FoldableWithKey1 (Coyoneda f) where
foldMapWithKey1 f (Coyoneda k a) = foldMapWithKey1 (\x -> f x . k) a
instance Traversable f => Traversable (Coyoneda f) where
traverse f (Coyoneda k a) = Coyoneda id <$> traverse (f . k) a
instance Traversable1 f => Traversable1 (Coyoneda f) where
traverse1 f (Coyoneda k a) = Coyoneda id <$> traverse1 (f . k) a
instance TraversableWithKey f => TraversableWithKey (Coyoneda f) where
traverseWithKey f (Coyoneda k a) = Coyoneda id <$> traverseWithKey (\x -> f x . k) a
instance TraversableWithKey1 f => TraversableWithKey1 (Coyoneda f) where
traverseWithKey1 f (Coyoneda k a) = Coyoneda id <$> traverseWithKey1 (\x -> f x . k) a
instance Distributive f => Distributive (Coyoneda f) where
collect f = liftCoyoneda . collect (lowerCoyoneda . f)
instance (Functor f, Show (f a)) => Show (Coyoneda f a) where
showsPrec d (Coyoneda f a) = showParen (d > 10) $
showString "liftCoyoneda " . showsPrec 11 (fmap f a)
#ifdef __GLASGOW_HASKELL__
instance (Functor f, Read (f a)) => Read (Coyoneda f a) where
readPrec = parens $ prec 10 $ do
Ident "liftCoyoneda" <- lexP
liftCoyoneda <$> step readPrec
#endif
instance (Functor f, Eq (f a)) => Eq (Coyoneda f a) where
(==) = (==) `on` lowerCoyoneda
instance (Functor f, Ord (f a)) => Ord (Coyoneda f a) where
compare = compare `on` lowerCoyoneda
instance Adjunction f g => Adjunction (Coyoneda f) (Coyoneda g) where
unit = liftCoyoneda . fmap liftCoyoneda . unit
counit = counit . fmap lowerCoyoneda . lowerCoyoneda
liftCoyoneda :: f a -> Coyoneda f a
liftCoyoneda = Coyoneda id
lowerCoyoneda :: Functor f => Coyoneda f a -> f a
lowerCoyoneda (Coyoneda f m) = fmap f m
lowerM :: Monad f => Coyoneda f a -> f a
lowerM (Coyoneda f m) = liftM f m