kleisli-0.0.4: src/Data/Kleisli.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}

{- HLINT ignore "Use camelCase" -}

-- |
-- Module      : Data.Kleisli
-- Description : Kleisli-like newtypes with different type parameter orderings
--
-- Three newtype wrappers around @p a (f b)@ with different type parameter
-- orderings, enabling different type class instances:
--
-- * 'Kleisli' @p a f b@ — functor in @b@
-- * 'ProKleisli' @p f a b@ — profunctor in @(a, b)@, category/arrow instances
-- * 'ContraKleisli' @p b f a@ — contravariant in @a@
--
-- All three are representationally identical and connected by isomorphisms.
module Data.Kleisli
  ( -- * Types
    Kleisli (..),
    ProKleisli (..),
    ContraKleisli (..),

    -- * Kleisli type aliases
    Kleisli',
    KleisliA,
    KleisliA',

    -- * ProKleisli type aliases
    ProKleisli',
    ProKleisliA,
    ProKleisliA',

    -- * ContraKleisli type aliases
    ContraKleisli',
    ContraKleisliA,
    ContraKleisliA',

    -- * Kleisli isomorphisms
    kleisli',
    mkKleisli',
    _Kleisli_ProKleisli,
    _Kleisli_ContraKleisli,

    -- * ProKleisli isomorphisms
    proKleisli',
    mkProKleisli',
    _ProKleisli_Kleisli,
    _ProKleisli_ContraKleisli,

    -- * ContraKleisli isomorphisms
    contraKleisli',
    mkContraKleisli',
    _ContraKleisli_ProKleisli,
    _ContraKleisli_Kleisli,

    -- * Functor layer mapping
    hoistKleisli,
    hoistKleisli',
    pureKleisli,
    hoistProKleisli,
    hoistProKleisli',
    pureProKleisli,
    hoistContraKleisli,
    hoistContraKleisli',
    pureContraKleisli,

    -- * Maybe
    fromMaybe,
  )
where

import Control.Applicative (Alternative)
import Control.Arrow (Arrow, ArrowApply, ArrowChoice, ArrowLoop, ArrowPlus, ArrowZero)
import qualified Control.Arrow as Arrow (Kleisli (..))
import Control.Category (Category)
import Control.Comonad (Comonad (..), ComonadApply ((<@>)))
import Control.Comonad.Traced.Class (ComonadTraced (..))
import Control.DeepSeq (NFData (..))
import Control.Lens hiding (Traversing, (<.>))
import Control.Monad (MonadPlus)
import Control.Monad.Cont.Class (MonadCont)
import Control.Monad.Error.Class (MonadError)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader.Class (MonadReader)
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.Reader (ReaderT (..))
import Control.Monad.Writer.Class (MonadWriter)
import Control.Monad.Zip (MonadZip)
import Control.Selective (Selective)
import Data.Distributive (Distributive (..))
import Data.Functor.Alt (Alt (..))
import Data.Functor.Apply (Apply (..))
import Data.Functor.Bind (Bind (..))
import Data.Functor.Bind.Trans (BindTrans)
import Data.Functor.Contravariant (Op (..))
import Data.Functor.Contravariant.Conclude (Conclude)
import Data.Functor.Contravariant.Decide (Decide (..))
import Data.Functor.Contravariant.Divise (Divise (..))
import Data.Functor.Contravariant.Divisible (Decidable, Divisible (..))
import qualified Data.Functor.Contravariant.Rep as CRep (Representable (..))
import Data.Functor.Extend (Extend (..))
import Data.Functor.Plus (Plus (..))
import qualified Data.Functor.Rep as FRep (Rep, Representable (..))
import qualified Data.Maybe as Maybe
import Data.Profunctor (Closed, Strong)
import Data.Profunctor.Choice (Cochoice)
import Data.Profunctor.Mapping (Mapping)
import qualified Data.Profunctor.Rep as PRep (Representable (..))
import Data.Profunctor.Sieve (Sieve (..))
import Data.Profunctor.Strong (Costrong)
import Data.Profunctor.Traversing (Traversing)
import Data.Profunctor.Types (Star (..))
import Data.Semigroupoid (Semigroupoid)
import GHC.Generics (Generic)

-- $setup
-- >>> import Control.Applicative (Alternative(..))
-- >>> import Control.Monad (MonadPlus(..))
-- >>> import Control.Monad.Trans.Class (lift)
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> import Data.Functor.Bind.Trans (liftB)
-- >>> import Data.Profunctor (lmap, rmap)
-- >>> import Control.Lens (view, review)

-- | A newtype around @p a (f b)@ with the functor parameter @f@ as the
-- penultimate type variable, enabling 'Functor' and related instances in @b@.
--
-- >>> let k = Kleisli (\x -> Just (x + 1))
-- >>> let Kleisli f = k in f 3
-- Just 4
newtype Kleisli p a f b = Kleisli (p a (f b))
  deriving stock (Generic)

-- | A newtype around @p a (f b)@ with the functor parameter @f@ as the
-- first type variable after @p@, enabling 'Profunctor', 'Category', and
-- 'Arrow' instances when @p@ is @(->)@.
--
-- >>> let k = ProKleisli (\x -> Just (x + 1))
-- >>> let ProKleisli f = k in f 3
-- Just 4
newtype ProKleisli p f a b = ProKleisli (p a (f b))
  deriving stock (Generic)

-- | A newtype around @p a (f b)@ with @a@ as the last type variable,
-- enabling 'Contravariant' and related instances.
--
-- >>> let k = ContraKleisli (\x -> Just (x + 1))
-- >>> let ContraKleisli f = k in f 3
-- Just 4
newtype ContraKleisli p b f a = ContraKleisli (p a (f b))
  deriving stock (Generic)

-- | @'Kleisli' p a 'Identity' b@, eliminating the functor layer.
--
-- >>> let k = Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int
-- >>> let Kleisli f = k in runIdentity (f 5)
-- 6
type Kleisli' p a b = Kleisli p a Identity b

-- | @'Kleisli' (->) a f b@, specialising the profunctor to @(->)@.
--
-- >>> let k = Kleisli Just :: KleisliA Int Maybe Int
-- >>> let Kleisli f = k in f 5
-- Just 5
type KleisliA a f b = Kleisli (->) a f b

-- | @'KleisliA' a 'Identity' b@, specialising both profunctor and functor.
--
-- >>> let k = Kleisli (Identity . (+1)) :: KleisliA' Int Int
-- >>> let Kleisli f = k in f 5
-- Identity 6
type KleisliA' a b = KleisliA a Identity b

-- | @'ProKleisli' p 'Identity' a b@, eliminating the functor layer.
--
-- >>> let k = ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int
-- >>> let ProKleisli f = k in runIdentity (f 5)
-- 6
type ProKleisli' p a b = ProKleisli p Identity a b

-- | @'ProKleisli' (->) f a b@, specialising the profunctor to @(->)@.
--
-- >>> let k = ProKleisli Just :: ProKleisliA Maybe Int Int
-- >>> let ProKleisli f = k in f 5
-- Just 5
type ProKleisliA f a b = ProKleisli (->) f a b

-- | @'ProKleisliA' 'Identity' a b@, specialising both profunctor and functor.
--
-- >>> let k = ProKleisli (Identity . (+1)) :: ProKleisliA' Int Int
-- >>> let ProKleisli f = k in f 5
-- Identity 6
type ProKleisliA' a b = ProKleisliA Identity a b

-- | @'ContraKleisli' p b 'Identity' a@, eliminating the functor layer.
--
-- >>> let k = ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int
-- >>> let ContraKleisli f = k in runIdentity (f 5)
-- 6
type ContraKleisli' p b a = ContraKleisli p b Identity a

-- | @'ContraKleisli' (->) b f a@, specialising the profunctor to @(->)@.
--
-- >>> let k = ContraKleisli Just :: ContraKleisliA Int Maybe Int
-- >>> let ContraKleisli f = k in f 5
-- Just 5
type ContraKleisliA b f a = ContraKleisli (->) b f a

-- | @'ContraKleisliA' b 'Identity' a@, specialising both profunctor and functor.
--
-- >>> let k = ContraKleisli (Identity . (+1)) :: ContraKleisliA' Int Int
-- >>> let ContraKleisli f = k in f 5
-- Identity 6
type ContraKleisliA' b a = ContraKleisliA b Identity a

-- | An isomorphism between @'Kleisli'' p a b@ and @p a b@, mapping through
-- the 'Identity' wrapper using 'rmap'.
--
-- >>> view kleisli' (Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int) 5
-- 6
-- >>> let Kleisli f = review kleisli' (+1) :: Kleisli' (->) Int Int in runIdentity (f 5)
-- 6
kleisli' :: (Profunctor p, Profunctor p') => Iso (Kleisli' p a b) (Kleisli' p' a' b') (p a b) (p' a' b')
kleisli' = iso (\(Kleisli x) -> rmap runIdentity x) (Kleisli . rmap Identity)
{-# INLINE kleisli' #-}

-- | Construct a 'Kleisli'' from a plain profunctor value, wrapping the
-- result in 'Identity'.
--
-- >>> let Kleisli f = mkKleisli' (+1) :: Kleisli' (->) Int Int in runIdentity (f 5)
-- 6
mkKleisli' :: (Profunctor p) => p a b -> Kleisli' p a b
mkKleisli' = review kleisli'
{-# INLINE mkKleisli' #-}

-- | An isomorphism between 'Kleisli' and 'ProKleisli', reordering type parameters.
--
-- >>> let ProKleisli f = view _Kleisli_ProKleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) in f 5
-- Just 5
_Kleisli_ProKleisli :: Iso (Kleisli p a f b) (Kleisli p' a' f' b') (ProKleisli p f a b) (ProKleisli p' f' a' b')
_Kleisli_ProKleisli = iso (\(Kleisli x) -> ProKleisli x) (\(ProKleisli x) -> Kleisli x)
{-# INLINE _Kleisli_ProKleisli #-}

-- | An isomorphism between 'Kleisli' and 'ContraKleisli', reordering type parameters.
--
-- >>> let ContraKleisli f = view _Kleisli_ContraKleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) in f 5
-- Just 5
_Kleisli_ContraKleisli :: Iso (Kleisli p a f b) (Kleisli p' a' f' b') (ContraKleisli p b f a) (ContraKleisli p' b' f' a')
_Kleisli_ContraKleisli = iso (\(Kleisli x) -> ContraKleisli x) (\(ContraKleisli x) -> Kleisli x)
{-# INLINE _Kleisli_ContraKleisli #-}

-- | An isomorphism between @'ProKleisli'' p a b@ and @p a b@, mapping through
-- the 'Identity' wrapper using 'rmap'.
--
-- >>> view proKleisli' (ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int) 5
-- 6
-- >>> let ProKleisli f = review proKleisli' (+1) :: ProKleisli' (->) Int Int in runIdentity (f 5)
-- 6
proKleisli' :: (Profunctor p, Profunctor p') => Iso (ProKleisli' p a b) (ProKleisli' p' a' b') (p a b) (p' a' b')
proKleisli' = iso (\(ProKleisli x) -> rmap runIdentity x) (ProKleisli . rmap Identity)
{-# INLINE proKleisli' #-}

-- | Construct a 'ProKleisli'' from a plain profunctor value, wrapping the
-- result in 'Identity'.
--
-- >>> let ProKleisli f = mkProKleisli' (+1) :: ProKleisli' (->) Int Int in runIdentity (f 5)
-- 6
mkProKleisli' :: (Profunctor p) => p a b -> ProKleisli' p a b
mkProKleisli' = review proKleisli'
{-# INLINE mkProKleisli' #-}

-- | An isomorphism between 'ProKleisli' and 'Kleisli', reordering type parameters.
--
-- >>> let Kleisli f = view _ProKleisli_Kleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5
-- Just 5
_ProKleisli_Kleisli :: Iso (ProKleisli p f a b) (ProKleisli p' f' a' b') (Kleisli p a f b) (Kleisli p' a' f' b')
_ProKleisli_Kleisli = iso (\(ProKleisli x) -> Kleisli x) (\(Kleisli x) -> ProKleisli x)
{-# INLINE _ProKleisli_Kleisli #-}

-- | An isomorphism between 'ProKleisli' and 'ContraKleisli', reordering type parameters.
--
-- >>> let ContraKleisli f = view _ProKleisli_ContraKleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5
-- Just 5
_ProKleisli_ContraKleisli :: Iso (ProKleisli p f a b) (ProKleisli p' f' a' b') (ContraKleisli p b f a) (ContraKleisli p' b' f' a')
_ProKleisli_ContraKleisli = iso (\(ProKleisli x) -> ContraKleisli x) (\(ContraKleisli x) -> ProKleisli x)
{-# INLINE _ProKleisli_ContraKleisli #-}

-- | An isomorphism between @'ContraKleisli'' p b a@ and @p a b@, mapping through
-- the 'Identity' wrapper using 'rmap'.
--
-- >>> view contraKleisli' (ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int) 5
-- 6
-- >>> let ContraKleisli f = review contraKleisli' (+1) :: ContraKleisli' (->) Int Int in runIdentity (f 5)
-- 6
contraKleisli' :: (Profunctor p, Profunctor p') => Iso (ContraKleisli' p b a) (ContraKleisli' p' b' a') (p a b) (p' a' b')
contraKleisli' = iso (\(ContraKleisli x) -> rmap runIdentity x) (ContraKleisli . rmap Identity)
{-# INLINE contraKleisli' #-}

-- | Construct a 'ContraKleisli'' from a plain profunctor value, wrapping the
-- result in 'Identity'.
--
-- >>> let ContraKleisli f = mkContraKleisli' (+1) :: ContraKleisli' (->) Int Int in runIdentity (f 5)
-- 6
mkContraKleisli' :: (Profunctor p) => p a b -> ContraKleisli' p b a
mkContraKleisli' = review contraKleisli'
{-# INLINE mkContraKleisli' #-}

-- | An isomorphism between 'ContraKleisli' and 'ProKleisli', reordering type parameters.
--
-- >>> let ProKleisli f = view _ContraKleisli_ProKleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5
-- Just 5
_ContraKleisli_ProKleisli :: Iso (ContraKleisli p b f a) (ContraKleisli p' b' f' a') (ProKleisli p f a b) (ProKleisli p' f' a' b')
_ContraKleisli_ProKleisli = iso (\(ContraKleisli x) -> ProKleisli x) (\(ProKleisli x) -> ContraKleisli x)
{-# INLINE _ContraKleisli_ProKleisli #-}

-- | An isomorphism between 'ContraKleisli' and 'Kleisli', reordering type parameters.
--
-- >>> let Kleisli f = view _ContraKleisli_Kleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5
-- Just 5
_ContraKleisli_Kleisli :: Iso (ContraKleisli p b f a) (ContraKleisli p' b' f' a') (Kleisli p a f b) (Kleisli p' a' f' b')
_ContraKleisli_Kleisli = iso (\(ContraKleisli x) -> Kleisli x) (\(Kleisli x) -> ContraKleisli x)
{-# INLINE _ContraKleisli_Kleisli #-}

-- | Map over the functor layer of a 'Kleisli' using 'rmap'.
--
-- >>> let Kleisli f = hoistKleisli (Just . runIdentity) (Kleisli (Identity . (+1)) :: Kleisli (->) Int Identity Int) in f 5
-- Just 6
hoistKleisli :: (Profunctor p) => (f b -> g c) -> Kleisli p a f b -> Kleisli p a g c
hoistKleisli h (Kleisli k) = Kleisli (rmap h k)
{-# INLINE hoistKleisli #-}

-- | Map over the functor layer of a 'Kleisli'' using 'dimap', first stripping
-- the 'Identity' wrapper.
--
-- >>> let Kleisli f = hoistKleisli' Just (Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int) in f 5
-- Just 6
hoistKleisli' :: (Profunctor p) => (b -> g c) -> Kleisli' p a b -> Kleisli p a g c
hoistKleisli' h = hoistKleisli (h . runIdentity)
{-# INLINE hoistKleisli' #-}

-- | Lift a 'Kleisli'' (with 'Identity' as the functor) into an arbitrary
-- 'Applicative' functor using 'pure'.
--
-- >>> let Kleisli f = pureKleisli (Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int) :: Kleisli (->) Int Maybe Int in f 5
-- Just 6
pureKleisli :: (Profunctor p, Applicative g) => Kleisli' p a x -> Kleisli p a g x
pureKleisli = hoistKleisli' pure
{-# INLINE pureKleisli #-}

-- | Map over the functor layer of a 'ProKleisli' using 'rmap'.
--
-- >>> let ProKleisli f = hoistProKleisli (Just . runIdentity) (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in f 5
-- Just 6
hoistProKleisli :: (Profunctor p) => (f b -> g c) -> ProKleisli p f a b -> ProKleisli p g a c
hoistProKleisli h (ProKleisli k) = ProKleisli (rmap h k)
{-# INLINE hoistProKleisli #-}

-- | Map over the functor layer of a 'ProKleisli'' using 'dimap', first
-- stripping the 'Identity' wrapper.
--
-- >>> let ProKleisli f = hoistProKleisli' Just (ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int) in f 5
-- Just 6
hoistProKleisli' :: (Profunctor p) => (b -> g c) -> ProKleisli' p a b -> ProKleisli p g a c
hoistProKleisli' h = hoistProKleisli (h . runIdentity)
{-# INLINE hoistProKleisli' #-}

-- | Lift a 'ProKleisli'' (with 'Identity' as the functor) into an arbitrary
-- 'Applicative' functor using 'pure'.
--
-- >>> let ProKleisli f = pureProKleisli (ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int) :: ProKleisli (->) Maybe Int Int in f 5
-- Just 6
pureProKleisli :: (Profunctor p, Applicative g) => ProKleisli' p a x -> ProKleisli p g a x
pureProKleisli = hoistProKleisli' pure
{-# INLINE pureProKleisli #-}

-- | Map over the functor layer of a 'ContraKleisli' using 'rmap'.
--
-- >>> let ContraKleisli f = hoistContraKleisli (Just . runIdentity) (ContraKleisli (Identity . (+1)) :: ContraKleisli (->) Int Identity Int) in f 5
-- Just 6
hoistContraKleisli :: (Profunctor p) => (f b -> g c) -> ContraKleisli p b f a -> ContraKleisli p c g a
hoistContraKleisli h (ContraKleisli k) = ContraKleisli (rmap h k)
{-# INLINE hoistContraKleisli #-}

-- | Map over the functor layer of a 'ContraKleisli'' using 'dimap', first
-- stripping the 'Identity' wrapper.
--
-- >>> let ContraKleisli f = hoistContraKleisli' Just (ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int) in f 5
-- Just 6
hoistContraKleisli' :: (Profunctor p) => (b -> g c) -> ContraKleisli' p b a -> ContraKleisli p c g a
hoistContraKleisli' h = hoistContraKleisli (h . runIdentity)
{-# INLINE hoistContraKleisli' #-}

-- | Lift a 'ContraKleisli'' (with 'Identity' as the functor) into an arbitrary
-- 'Applicative' functor using 'pure'.
--
-- >>> let ContraKleisli f = pureContraKleisli (ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int) :: ContraKleisli (->) Int Maybe Int in f 5
-- Just 6
pureContraKleisli :: (Profunctor p, Applicative g) => ContraKleisli' p x a -> ContraKleisli p x g a
pureContraKleisli = hoistContraKleisli' pure
{-# INLINE pureContraKleisli #-}

-- | Replace 'Nothing' results with a default value, collapsing the 'Maybe'
-- layer into 'Identity'.
--
-- >>> let Kleisli f = fromMaybe 0 (Kleisli Just :: KleisliA Int Maybe Int) in runIdentity (f 5)
-- 5
-- >>> let Kleisli f = fromMaybe 0 (Kleisli (const Nothing) :: KleisliA Int Maybe Int) in runIdentity (f 5)
-- 0
-- >>> let ProKleisli f = fromMaybe 0 (ProKleisli Just :: ProKleisliA Maybe Int Int) in runIdentity (f 5)
-- 5
-- >>> let ProKleisli f = fromMaybe 0 (ProKleisli (const Nothing) :: ProKleisliA Maybe Int Int) in runIdentity (f 5)
-- 0
-- >>> let ContraKleisli f = fromMaybe 0 (ContraKleisli Just :: ContraKleisliA Int Maybe Int) in runIdentity (f 5)
-- 5
-- >>> let ContraKleisli f = fromMaybe 0 (ContraKleisli (const Nothing) :: ContraKleisliA Int Maybe Int) in runIdentity (f 5)
-- 0
fromMaybe ::
  (Unwrapped t ~ (a -> Identity b), Unwrapped s ~ (a -> Maybe b),  Rewrapped s t, Rewrapped t s) => b -> s -> t
fromMaybe b = over _Wrapped (\k -> (Identity . Maybe.fromMaybe b) . k)
{-# SPECIALIZE fromMaybe :: b -> KleisliA a Maybe b -> KleisliA' a b #-}
{-# SPECIALIZE fromMaybe :: b -> ProKleisliA Maybe a b -> ProKleisliA' a b #-}
{-# SPECIALIZE fromMaybe :: b -> ContraKleisliA b Maybe a -> ContraKleisliA' b a #-}

-- | >>> import Control.Lens (op, _Wrapped')
-- >>> op Kleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) 5
-- Just 5
instance (Kleisli p' a' f' b' ~ t) => Rewrapped (Kleisli p a f b) t

instance Wrapped (Kleisli p a f b) where
  type Unwrapped (Kleisli p a f b) = p a (f b)
  _Wrapped' = iso (\(Kleisli x) -> x) Kleisli
  {-# INLINE _Wrapped' #-}

-- | >>> import Control.DeepSeq (rnf)
-- >>> rnf (Kleisli Just :: Kleisli (->) Int Maybe Int)
-- ()
instance (NFData (p a (f b))) => NFData (Kleisli p a f b) where
  rnf (Kleisli x) = rnf x
  {-# INLINE rnf #-}

-- | >>> let Kleisli f = Kleisli (\_ -> [1,2]) <> Kleisli (\_ -> [3,4]) :: Kleisli (->) Int [] Int in f 0
-- [1,2,3,4]
deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (Kleisli (->) a f b)

-- | >>> let Kleisli f = mempty :: Kleisli (->) Int [] Int in f 5
-- []
deriving via (a -> f b) instance (Monoid (f b)) => Monoid (Kleisli (->) a f b)

-- | >>> let Kleisli f = fmap (+1) (Kleisli Just) in f 5
-- Just 6
instance (Functor f) => Functor (Kleisli (->) a f) where
  fmap g (Kleisli k) = Kleisli (fmap g . k)
  {-# INLINE fmap #-}

-- | >>> let Kleisli f = pure 42 :: Kleisli (->) String Maybe Int in f "ignored"
-- Just 42
deriving via (Star f a) instance (Applicative f) => Applicative (Kleisli (->) a f)

-- | >>> let Kleisli f = (Kleisli Just :: Kleisli (->) Int Maybe Int) >>= \x -> Kleisli (\_ -> Just (x + 1)) in f 5
-- Just 6
deriving via (Star f a) instance (Monad f) => Monad (Kleisli (->) a f)

-- | >>> let Kleisli f = Kleisli (\a -> Just (a+)) <.> Kleisli (\a -> Just (a*2)) in f 3
-- Just 9
instance (Apply f) => Apply (Kleisli (->) a f) where
  Kleisli f <.> Kleisli x = Kleisli (\a -> f a <.> x a)
  {-# INLINE (<.>) #-}

-- | >>> let Kleisli f = Kleisli Just >>- \x -> Kleisli (\_ -> Just (x + 1)) in f 5
-- Just 6
instance (Bind f) => Bind (Kleisli (->) a f) where
  Kleisli m >>- f = Kleisli (\a -> m a >>- \x -> let Kleisli g = f x in g a)
  {-# INLINE (>>-) #-}

-- | >>> let Kleisli f = Kleisli (\_ -> Nothing) <!> Kleisli Just :: Kleisli (->) Int Maybe Int in f 5
-- Just 5
instance (Alt f) => Alt (Kleisli (->) a f) where
  Kleisli f <!> Kleisli g = Kleisli (\a -> f a <!> g a)
  {-# INLINE (<!>) #-}

-- | >>> let Kleisli f = zero :: Kleisli (->) Int Maybe Int in f 5
-- Nothing
instance (Plus f) => Plus (Kleisli (->) a f) where
  zero = Kleisli (const zero)
  {-# INLINE zero #-}

-- | >>> let Kleisli f = empty :: Kleisli (->) Int Maybe Int in f 5
-- Nothing
deriving via (ReaderT a f) instance (Alternative f) => Alternative (Kleisli (->) a f)

-- | >>> let Kleisli f = mzero :: Kleisli (->) Int Maybe Int in f 5
-- Nothing
deriving via (ReaderT a f) instance (MonadPlus f) => MonadPlus (Kleisli (->) a f)

-- | >>> import Control.Monad.Fix (mfix)
-- >>> let Kleisli f = mfix (\_ -> Kleisli (\_ -> Just 42)) :: Kleisli (->) Int Maybe Int in f 5
-- Just 42
deriving via (ReaderT a f) instance (MonadFix f) => MonadFix (Kleisli (->) a f)

-- | >>> let Kleisli f = (fail "oops" :: Kleisli (->) Int Maybe Int) in f 5
-- Nothing
deriving via (ReaderT a f) instance (MonadFail f) => MonadFail (Kleisli (->) a f)

-- | >>> import Control.Monad.Reader.Class (ask)
-- >>> let Kleisli f = ask :: Kleisli (->) Int Maybe Int in f 5
-- Just 5
deriving via (ReaderT a f) instance (Monad f) => MonadReader a (Kleisli (->) a f)

-- | >>> import Control.Monad.IO.Class (liftIO)
-- >>> let Kleisli f = liftIO (pure 42) :: Kleisli (->) String IO Int in f "ignored"
-- 42
deriving via (ReaderT a f) instance (MonadIO f) => MonadIO (Kleisli (->) a f)

-- | >>> import Control.Monad.Writer.Class (tell)
-- >>> import Control.Monad.Trans.Writer (runWriterT, WriterT)
-- >>> let Kleisli f = tell "hello" :: Kleisli (->) Int (WriterT String Maybe) () in runWriterT (f 5)
-- Just ((),"hello")
deriving via (ReaderT a f) instance (MonadWriter w f) => MonadWriter w (Kleisli (->) a f)

-- | >>> import Control.Monad.State.Class (get, put)
-- >>> import Control.Monad.Trans.State (runStateT, StateT)
-- >>> let Kleisli f = put 99 :: Kleisli (->) String (StateT Int Maybe) () in runStateT (f "ignored") 0
-- Just ((),99)
deriving via (ReaderT a f) instance (MonadState s f) => MonadState s (Kleisli (->) a f)

-- | >>> import Control.Monad.Error.Class (throwError)
-- >>> import Control.Monad.Trans.Except (runExceptT, ExceptT)
-- >>> let Kleisli f = throwError "oops" :: Kleisli (->) Int (ExceptT String Maybe) () in runExceptT (f 5)
-- Just (Left "oops")
deriving via (ReaderT a f) instance (MonadError e f) => MonadError e (Kleisli (->) a f)

-- | >>> import Control.Monad.Cont.Class (callCC)
-- >>> import Control.Monad.Trans.Cont (runContT, ContT)
-- >>> let Kleisli f = callCC (\k -> k 42) :: Kleisli (->) String (ContT Int Maybe) Int
-- >>> runContT (f "ignored") Just
-- Just 42
deriving via (ReaderT a f) instance (MonadCont f) => MonadCont (Kleisli (->) a f)

-- | >>> import Control.Selective (select, ifS)
-- >>> let Kleisli f = ifS (Kleisli (\_ -> Just True)) (Kleisli (\_ -> Just 1)) (Kleisli (\_ -> Just 2)) in f ()
-- Just 1
deriving via (ReaderT a f) instance (Selective f) => Selective (Kleisli (->) a f)

-- | >>> import Control.Monad.Zip (mzip)
-- >>> let Kleisli f = mzip (Kleisli (\_ -> [1,2])) (Kleisli (\_ -> [3,4])) in f ()
-- [(1,3),(2,4)]
deriving via (ReaderT a f) instance (MonadZip f) => MonadZip (Kleisli (->) a f)

-- | >>> let Kleisli f = lift (Just 42) :: Kleisli (->) String Maybe Int in f "ignored"
-- Just 42
deriving via (ReaderT a) instance MonadTrans (Kleisli (->) a)

-- | >>> let Kleisli f = liftB (Just 42) :: Kleisli (->) String Maybe Int in f "ignored"
-- Just 42
deriving via (ReaderT a) instance BindTrans (Kleisli (->) a)

-- | >>> import Data.Functor.Extend (duplicated)
-- >>> let Kleisli g = duplicated (Kleisli (\s -> Just (length s)) :: Kleisli (->) String Maybe Int) in fmap (\(Kleisli h) -> h " world") (g "hello")
-- Just (Just 11)
instance (Semigroup a, Applicative f) => Extend (Kleisli (->) a f) where
  duplicated (Kleisli w) = Kleisli (\a -> pure (Kleisli (w . (<>) a)))
  {-# INLINE duplicated #-}

-- | >>> import Control.Comonad (extract)
-- >>> extract (Kleisli (\s -> (s, length s)) :: Kleisli (->) String ((,) String) Int)
-- 0
instance (Monoid a, Comonad f, Applicative f) => Comonad (Kleisli (->) a f) where
  extract (Kleisli w) = extract (w mempty)
  {-# INLINE extract #-}
  duplicate (Kleisli w) = Kleisli (\a -> pure (Kleisli (w . (<>) a)))
  {-# INLINE duplicate #-}

-- | >>> import Control.Comonad ((<@>))
-- >>> let Kleisli f = Kleisli (\s -> (s, (+ length s))) <@> Kleisli (\s -> (s, 10)) :: Kleisli (->) String ((,) String) Int in f ""
-- ("",10)
instance (Monoid a, Comonad f, Applicative f) => ComonadApply (Kleisli (->) a f) where
  (<@>) = (<*>)
  {-# INLINE (<@>) #-}

-- | >>> import Control.Comonad.Traced.Class (trace)
-- >>> trace "!" (Kleisli (\s -> (s, length s)) :: Kleisli (->) String ((,) String) Int)
-- 1
instance (Monoid a, Comonad f, Applicative f) => ComonadTraced a (Kleisli (->) a f) where
  trace m (Kleisli w) = extract (w m)
  {-# INLINE trace #-}

-- | >>> import Data.Distributive (distribute)
-- >>> let xs = [Kleisli (\n -> Identity (n+1)), Kleisli (\n -> Identity (n*2))] :: [Kleisli (->) Int Identity Int]
-- >>> let Kleisli f = distribute xs in runIdentity (f 3)
-- [4,6]
instance (Distributive f) => Distributive (Kleisli (->) a f) where
  distribute gs = Kleisli (\a -> distribute (fmap (\(Kleisli k) -> k a) gs))
  {-# INLINE distribute #-}

-- | >>> import Data.Functor.Rep (index)
-- >>> let k = Kleisli (\a -> Identity (a * 2)) :: Kleisli (->) Int Identity Int
-- >>> index k (3, ())
-- 6
instance (FRep.Representable f) => FRep.Representable (Kleisli (->) a f) where
  type Rep (Kleisli (->) a f) = (a, FRep.Rep f)
  tabulate f = Kleisli (\a -> FRep.tabulate (\r -> f (a, r)))
  {-# INLINE tabulate #-}
  index (Kleisli k) (a, r) = FRep.index (k a) r
  {-# INLINE index #-}

-- | >>> import Control.Lens (op, _Wrapped')
-- >>> op ProKleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) 5
-- Just 5
instance (ProKleisli p' f' a' b' ~ t) => Rewrapped (ProKleisli p f a b) t

instance Wrapped (ProKleisli p f a b) where
  type Unwrapped (ProKleisli p f a b) = p a (f b)
  _Wrapped' = iso (\(ProKleisli x) -> x) ProKleisli
  {-# INLINE _Wrapped' #-}

-- | >>> import Control.DeepSeq (rnf)
-- >>> rnf (ProKleisli Just :: ProKleisli (->) Maybe Int Int)
-- ()
instance (NFData (p a (f b))) => NFData (ProKleisli p f a b) where
  rnf (ProKleisli x) = rnf x
  {-# INLINE rnf #-}

-- | >>> let ProKleisli f = ProKleisli (\_ -> [1,2]) <> ProKleisli (\_ -> [3,4]) :: ProKleisli (->) [] Int Int in f 0
-- [1,2,3,4]
deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (ProKleisli (->) f a b)

-- | >>> let ProKleisli f = mempty :: ProKleisli (->) [] Int Int in f 5
-- []
deriving via (a -> f b) instance (Monoid (f b)) => Monoid (ProKleisli (->) f a b)

-- | >>> let ProKleisli f = fmap (+1) (ProKleisli Just) in f 5
-- Just 6
instance (Functor f) => Functor (ProKleisli (->) f a) where
  fmap g (ProKleisli k) = ProKleisli (fmap g . k)
  {-# INLINE fmap #-}

-- | >>> let ProKleisli f = pure 42 :: ProKleisli (->) Maybe String Int in f "ignored"
-- Just 42
deriving via (Star f a) instance (Applicative f) => Applicative (ProKleisli (->) f a)

-- | >>> let ProKleisli f = return 42 :: ProKleisli (->) Maybe String Int in f "ignored"
-- Just 42
deriving via (Star f a) instance (Monad f) => Monad (ProKleisli (->) f a)

-- | >>> let ProKleisli f = ProKleisli (\a -> Just (a+)) <.> ProKleisli (\a -> Just (a*2)) in f 3
-- Just 9
instance (Apply f) => Apply (ProKleisli (->) f a) where
  ProKleisli f <.> ProKleisli x = ProKleisli (\a -> f a <.> x a)
  {-# INLINE (<.>) #-}

-- | >>> let ProKleisli f = ProKleisli Just >>- \x -> ProKleisli (\_ -> Just (x + 1)) in f 5
-- Just 6
instance (Bind f) => Bind (ProKleisli (->) f a) where
  ProKleisli m >>- f = ProKleisli (\a -> m a >>- \x -> let ProKleisli g = f x in g a)
  {-# INLINE (>>-) #-}

-- | >>> let ProKleisli f = ProKleisli (\_ -> Nothing) <!> ProKleisli Just :: ProKleisli (->) Maybe Int Int in f 5
-- Just 5
instance (Alt f) => Alt (ProKleisli (->) f a) where
  ProKleisli f <!> ProKleisli g = ProKleisli (\a -> f a <!> g a)
  {-# INLINE (<!>) #-}

-- | >>> let ProKleisli f = zero :: ProKleisli (->) Maybe Int Int in f 5
-- Nothing
instance (Plus f) => Plus (ProKleisli (->) f a) where
  zero = ProKleisli (const zero)
  {-# INLINE zero #-}

-- | >>> let ProKleisli f = empty :: ProKleisli (->) Maybe Int Int in f 5
-- Nothing
deriving via (ReaderT a f) instance (Alternative f) => Alternative (ProKleisli (->) f a)

-- | >>> let ProKleisli f = mzero :: ProKleisli (->) Maybe Int Int in f 5
-- Nothing
deriving via (ReaderT a f) instance (MonadPlus f) => MonadPlus (ProKleisli (->) f a)

-- | >>> import Control.Monad.Fix (mfix)
-- >>> let ProKleisli f = mfix (\_ -> ProKleisli (\_ -> Just 42)) :: ProKleisli (->) Maybe Int Int in f 5
-- Just 42
deriving via (ReaderT a f) instance (MonadFix f) => MonadFix (ProKleisli (->) f a)

-- | >>> let ProKleisli f = (fail "oops" :: ProKleisli (->) Maybe Int Int) in f 5
-- Nothing
deriving via (ReaderT a f) instance (MonadFail f) => MonadFail (ProKleisli (->) f a)

-- | >>> import Control.Monad.Reader.Class (ask)
-- >>> let ProKleisli f = ask :: ProKleisli (->) Maybe Int Int in f 5
-- Just 5
deriving via (ReaderT a f) instance (Monad f) => MonadReader a (ProKleisli (->) f a)

-- | >>> import Control.Monad.IO.Class (liftIO)
-- >>> let ProKleisli f = liftIO (pure 42) :: ProKleisli (->) IO String Int in f "ignored"
-- 42
deriving via (ReaderT a f) instance (MonadIO f) => MonadIO (ProKleisli (->) f a)

-- | >>> import Control.Monad.Writer.Class (tell)
-- >>> import Control.Monad.Trans.Writer (runWriterT, WriterT)
-- >>> let ProKleisli f = tell "hello" :: ProKleisli (->) (WriterT String Maybe) Int () in runWriterT (f 5)
-- Just ((),"hello")
deriving via (ReaderT a f) instance (MonadWriter w f) => MonadWriter w (ProKleisli (->) f a)

-- | >>> import Control.Monad.State.Class (get, put)
-- >>> import Control.Monad.Trans.State (runStateT, StateT)
-- >>> let ProKleisli f = put 99 :: ProKleisli (->) (StateT Int Maybe) String () in runStateT (f "ignored") 0
-- Just ((),99)
deriving via (ReaderT a f) instance (MonadState s f) => MonadState s (ProKleisli (->) f a)

-- | >>> import Control.Monad.Error.Class (throwError)
-- >>> import Control.Monad.Trans.Except (runExceptT, ExceptT)
-- >>> let ProKleisli f = throwError "oops" :: ProKleisli (->) (ExceptT String Maybe) Int () in runExceptT (f 5)
-- Just (Left "oops")
deriving via (ReaderT a f) instance (MonadError e f) => MonadError e (ProKleisli (->) f a)

-- | >>> import Control.Monad.Cont.Class (callCC)
-- >>> import Control.Monad.Trans.Cont (runContT, ContT)
-- >>> let ProKleisli f = callCC (\k -> k 42) :: ProKleisli (->) (ContT Int Maybe) String Int
-- >>> runContT (f "ignored") Just
-- Just 42
deriving via (ReaderT a f) instance (MonadCont f) => MonadCont (ProKleisli (->) f a)

-- | >>> import Control.Selective (ifS)
-- >>> let ProKleisli f = ifS (ProKleisli (\_ -> Just True)) (ProKleisli (\_ -> Just 1)) (ProKleisli (\_ -> Just 2)) in f ()
-- Just 1
deriving via (ReaderT a f) instance (Selective f) => Selective (ProKleisli (->) f a)

-- | >>> import Control.Monad.Zip (mzip)
-- >>> let ProKleisli f = mzip (ProKleisli (\_ -> [1,2])) (ProKleisli (\_ -> [3,4])) in f ()
-- [(1,3),(2,4)]
deriving via (ReaderT a f) instance (MonadZip f) => MonadZip (ProKleisli (->) f a)

-- | >>> import Data.Functor.Extend (duplicated)
-- >>> let ProKleisli g = duplicated (ProKleisli (\s -> Just (length s)) :: ProKleisli (->) Maybe String Int) in fmap (\(ProKleisli h) -> h " world") (g "hello")
-- Just (Just 11)
instance (Semigroup a, Applicative f) => Extend (ProKleisli (->) f a) where
  duplicated (ProKleisli w) = ProKleisli (\a -> pure (ProKleisli (w . (<>) a)))
  {-# INLINE duplicated #-}

-- | >>> import Control.Comonad (extract)
-- >>> extract (ProKleisli (\s -> (s, length s)) :: ProKleisli (->) ((,) String) String Int)
-- 0
instance (Monoid a, Comonad f, Applicative f) => Comonad (ProKleisli (->) f a) where
  extract (ProKleisli w) = extract (w mempty)
  {-# INLINE extract #-}
  duplicate (ProKleisli w) = ProKleisli (\a -> pure (ProKleisli (w . (<>) a)))
  {-# INLINE duplicate #-}

-- | >>> import Control.Comonad ((<@>))
-- >>> let ProKleisli f = ProKleisli (\s -> (s, (+ length s))) <@> ProKleisli (\s -> (s, 10)) :: ProKleisli (->) ((,) String) String Int in f ""
-- ("",10)
instance (Monoid a, Comonad f, Applicative f) => ComonadApply (ProKleisli (->) f a) where
  (<@>) = (<*>)
  {-# INLINE (<@>) #-}

-- | >>> import Control.Comonad.Traced.Class (trace)
-- >>> trace "!" (ProKleisli (\s -> (s, length s)) :: ProKleisli (->) ((,) String) String Int)
-- 1
instance (Monoid a, Comonad f, Applicative f) => ComonadTraced a (ProKleisli (->) f a) where
  trace m (ProKleisli w) = extract (w m)
  {-# INLINE trace #-}

-- | >>> import Data.Distributive (distribute)
-- >>> let xs = [ProKleisli (\n -> Identity (n+1)), ProKleisli (\n -> Identity (n*2))] :: [ProKleisli (->) Identity Int Int]
-- >>> let ProKleisli f = distribute xs in runIdentity (f 3)
-- [4,6]
instance (Distributive f) => Distributive (ProKleisli (->) f a) where
  distribute gs = ProKleisli (\a -> distribute (fmap (\(ProKleisli k) -> k a) gs))
  {-# INLINE distribute #-}

-- | >>> import Data.Functor.Rep (index)
-- >>> let k = ProKleisli (\a -> Identity (a * 2)) :: ProKleisli (->) Identity Int Int
-- >>> index k (3, ())
-- 6
instance (FRep.Representable f) => FRep.Representable (ProKleisli (->) f a) where
  type Rep (ProKleisli (->) f a) = (a, FRep.Rep f)
  tabulate f = ProKleisli (\a -> FRep.tabulate (\r -> f (a, r)))
  {-# INLINE tabulate #-}
  index (ProKleisli k) (a, r) = FRep.index (k a) r
  {-# INLINE index #-}

-- | >>> let ProKleisli f = lmap (+1) (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5
-- Just 6
--
-- >>> let ProKleisli f = rmap (+1) (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5
-- Just 6
instance (Functor f) => Profunctor (ProKleisli (->) f) where
  dimap f g (ProKleisli k) = ProKleisli (fmap g . k . f)
  {-# INLINE dimap #-}
  lmap f (ProKleisli k) = ProKleisli (k . f)
  {-# INLINE lmap #-}
  rmap g (ProKleisli k) = ProKleisli (fmap g . k)
  {-# INLINE rmap #-}

-- | >>> import Data.Profunctor (Strong(..))
-- >>> let ProKleisli f = first' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (5, "hi")
-- Just (5,"hi")
deriving via (Star f) instance (Functor f) => Strong (ProKleisli (->) f)

-- | >>> import Data.Profunctor.Choice (Choice(..))
-- >>> let ProKleisli f = left' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (Left 5)
-- Just (Left 5)
deriving via (Star f) instance (Applicative f) => Choice (ProKleisli (->) f)

-- | >>> import Data.Profunctor.Choice (Cochoice(..))
-- >>> let ProKleisli f = unleft (ProKleisli (\e -> [e]) :: ProKleisli (->) [] (Either Int ()) (Either Int ())) in f 5
-- [5]
deriving via (Star f) instance (Traversable f) => Cochoice (ProKleisli (->) f)

-- | >>> import Data.Profunctor (Closed(..))
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> let ProKleisli f = closed (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in runIdentity (f (const 5)) ()
-- 6
deriving via (Star f) instance (Distributive f) => Closed (ProKleisli (->) f)

-- | >>> import Data.Profunctor.Traversing (Traversing(..))
-- >>> let ProKleisli f = traverse' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f [1,2,3]
-- Just [1,2,3]
deriving via (Star f) instance (Applicative f) => Traversing (ProKleisli (->) f)

-- | >>> import Data.Profunctor.Mapping (Mapping(..))
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> let ProKleisli f = map' (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in f [1,2,3]
-- Identity [2,3,4]
deriving via (Star f) instance (Applicative f, Distributive f) => Mapping (ProKleisli (->) f)

-- | >>> import Data.Profunctor.Sieve (sieve)
-- >>> sieve (ProKleisli Just :: ProKleisli (->) Maybe Int Int) 5
-- Just 5
instance (Functor f) => Sieve (ProKleisli (->) f) f where
  sieve (ProKleisli f) = f
  {-# INLINE sieve #-}

-- | >>> import qualified Data.Profunctor.Rep as PRep (tabulate)
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> let ProKleisli f = PRep.tabulate Identity :: ProKleisli (->) Identity Int Int in f 5
-- Identity 5
instance (Functor f, Distributive f) => PRep.Representable (ProKleisli (->) f) where
  type Rep (ProKleisli (->) f) = f
  tabulate = ProKleisli
  {-# INLINE tabulate #-}

-- | >>> import Data.Profunctor.Strong (Costrong(..))
-- >>> let ProKleisli f = unfirst (ProKleisli (\(x,y) -> Just (x+1, y)) :: ProKleisli (->) Maybe (Int, String) (Int, String)) in f 5
-- Just 6
deriving via (Arrow.Kleisli f) instance (MonadFix f) => Costrong (ProKleisli (->) f)

-- | >>> import Data.Semigroupoid (o)
-- >>> let ProKleisli f = ProKleisli (\x -> Just (x + 1)) `o` ProKleisli (\x -> Just (x * 2)) in f 3
-- Just 7
deriving via (Arrow.Kleisli f) instance (Bind f) => Semigroupoid (ProKleisli (->) f)

-- | >>> import Control.Category (id)
-- >>> let ProKleisli f = (Control.Category.id :: ProKleisli (->) Maybe Int Int) in f 5
-- Just 5
deriving via (Arrow.Kleisli f) instance (Monad f) => Category (ProKleisli (->) f)

-- | >>> import Control.Arrow (arr, (>>>))
-- >>> let ProKleisli f = arr (+1) >>> arr (*2) :: ProKleisli (->) Maybe Int Int in f 3
-- Just 8
deriving via (Arrow.Kleisli f) instance (Monad f) => Arrow (ProKleisli (->) f)

-- | >>> import Control.Arrow (left)
-- >>> let ProKleisli f = left (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (Left 5)
-- Just (Left 5)
deriving via (Arrow.Kleisli f) instance (Monad f) => ArrowChoice (ProKleisli (->) f)

-- | >>> import Control.Arrow (app)
-- >>> let ProKleisli f = app :: ProKleisli (->) Maybe (ProKleisli (->) Maybe Int Int, Int) Int in f (ProKleisli Just, 5)
-- Just 5
deriving via (Arrow.Kleisli f) instance (Monad f) => ArrowApply (ProKleisli (->) f)

-- | >>> import Control.Arrow (loop)
-- >>> let ProKleisli f = loop (ProKleisli (\(x,_) -> Just (x+1, "hi"))) :: ProKleisli (->) Maybe Int Int in f 5
-- Just 6
deriving via (Arrow.Kleisli f) instance (MonadFix f) => ArrowLoop (ProKleisli (->) f)

-- | >>> import Control.Arrow (zeroArrow)
-- >>> let ProKleisli f = zeroArrow :: ProKleisli (->) Maybe Int Int in f 5
-- Nothing
deriving via (Arrow.Kleisli f) instance (MonadPlus f) => ArrowZero (ProKleisli (->) f)

-- | >>> import Control.Arrow ((<+>))
-- >>> let ProKleisli f = (ProKleisli (\_ -> Nothing) <+> ProKleisli Just) :: ProKleisli (->) Maybe Int Int in f 5
-- Just 5
deriving via (Arrow.Kleisli f) instance (MonadPlus f) => ArrowPlus (ProKleisli (->) f)

-- | >>> import Control.Lens (op, _Wrapped')
-- >>> op ContraKleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) 5
-- Just 5
instance (ContraKleisli p' b' f' a' ~ t) => Rewrapped (ContraKleisli p b f a) t

instance Wrapped (ContraKleisli p b f a) where
  type Unwrapped (ContraKleisli p b f a) = p a (f b)
  _Wrapped' = iso (\(ContraKleisli x) -> x) ContraKleisli
  {-# INLINE _Wrapped' #-}

-- | >>> import Control.DeepSeq (rnf)
-- >>> rnf (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int)
-- ()
instance (NFData (p a (f b))) => NFData (ContraKleisli p b f a) where
  rnf (ContraKleisli x) = rnf x
  {-# INLINE rnf #-}

-- | >>> let ContraKleisli f = ContraKleisli (\_ -> [1,2]) <> ContraKleisli (\_ -> [3,4]) :: ContraKleisli (->) Int [] Int in f 0
-- [1,2,3,4]
deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (ContraKleisli (->) b f a)

-- | >>> let ContraKleisli f = mempty :: ContraKleisli (->) Int [] Int in f 5
-- []
deriving via (a -> f b) instance (Monoid (f b)) => Monoid (ContraKleisli (->) b f a)

-- | >>> import Data.Functor.Contravariant (contramap)
-- >>> let ContraKleisli f = contramap (+1) (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5
-- Just 6
instance Contravariant (ContraKleisli (->) b f) where
  contramap f (ContraKleisli k) = ContraKleisli (k . f)
  {-# INLINE contramap #-}

-- | >>> import Data.Functor.Contravariant.Divisible (divide, conquer)
-- >>> let ContraKleisli f = conquer :: ContraKleisli (->) Int [] Int in f 5
-- []
instance (Monoid (f b)) => Divisible (ContraKleisli (->) b f) where
  divide f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (\a -> let (b, c) = f a in g b <> h c)
  {-# INLINE divide #-}
  conquer = ContraKleisli (const mempty)
  {-# INLINE conquer #-}

-- | >>> import Data.Functor.Contravariant.Divisible (choose)
-- >>> let ContraKleisli f = choose Left (ContraKleisli (\_ -> [1 :: Int])) (ContraKleisli (\_ -> [2])) :: ContraKleisli (->) Int [] Int in f 5
-- [1]
deriving via (Op (f b)) instance (Monoid (f b)) => Decidable (ContraKleisli (->) b f)

-- | >>> import Data.Functor.Contravariant.Divise (divise)
-- >>> let ContraKleisli f = divise (\x -> (x, x)) (ContraKleisli (\x -> [x])) (ContraKleisli (\x -> [x+1])) :: ContraKleisli (->) Int [] Int in f 5
-- [5,6]
instance (Semigroup (f b)) => Divise (ContraKleisli (->) b f) where
  divise f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (\a -> let (x, y) = f a in g x <> h y)
  {-# INLINE divise #-}

-- | >>> import Data.Functor.Contravariant.Decide (decide)
-- >>> let ContraKleisli f = decide Left (ContraKleisli (\_ -> [1 :: Int])) (ContraKleisli (\_ -> [2])) :: ContraKleisli (->) Int [] Int in f 5
-- [1]
instance Decide (ContraKleisli (->) b f) where
  decide f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (either g h . f)
  {-# INLINE decide #-}

-- | >>> import Data.Functor.Contravariant.Conclude (conclude)
-- >>> import Data.Void (Void)
-- >>> let _ = conclude id :: ContraKleisli (->) Int [] Void in "ok"
-- "ok"
deriving via (Op (f b)) instance Conclude (ContraKleisli (->) b f)

-- | >>> import qualified Data.Functor.Contravariant.Rep as CRep (index, tabulate)
-- >>> let k = CRep.tabulate Just :: ContraKleisli (->) Int Maybe Int
-- >>> CRep.index k 5
-- Just 5
instance CRep.Representable (ContraKleisli (->) b f) where
  type Rep (ContraKleisli (->) b f) = f b
  tabulate = ContraKleisli
  {-# INLINE tabulate #-}
  index (ContraKleisli f) = f
  {-# INLINE index #-}