{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | This module provides (linear) Kleisli and CoKleisli arrows
--
-- This module is meant to be imported qualified, perhaps as below.
--
-- > import qualified Data.Profunctor.Kleisli as Linear
--
-- == What are Kleisli arrows?
--
-- The basic idea is that a Kleisli arrow is like a function arrow
-- and @Kleisli m a b@ is similar to a function from @a@ to @b@. Basically:
--
-- > type Kleisli m a b = a %1-> m b
--
-- == Why make this definition?
--
-- It let's us view @Kleisli m@ for a certain @m@ as a certain kind of
-- function arrow, give it instances, abstract over it an so on.
--
-- For instance, if @m@ is any functor, @Kleisli m@ is a @Profunctor@.
--
-- == CoKleisli
--
-- A CoKleisli arrow is just one that represents a computation from
-- a @m a@ to an @a@ via a linear arrow. (It's a Co-something because it
-- reverses the order of the function arrows in the something.)
module Data.Profunctor.Kleisli.Linear
  ( Kleisli (..),
    CoKleisli (..),
  )
where

import qualified Control.Functor.Linear as Control
import qualified Data.Functor.Linear as Data
import Data.Profunctor.Linear
import Data.Void
import Prelude.Linear (Either (..), either)
import Prelude.Linear.Internal

-- Ideally, there would only be one Kleisli arrow, parametrised by
-- a multiplicity parameter:
-- newtype Kleisli p m a b = Kleisli { runKleisli :: a # p -> m b }
--
-- Some instances would also still work, eg
-- instance Functor p f => Profunctor (Kleisli p f)

-- | Linear Kleisli arrows for the monad `m`. These arrows are still useful
-- in the case where `m` is not a monad however, and some profunctorial
-- properties still hold in this weaker setting.
newtype Kleisli m a b = Kleisli {forall (m :: * -> *) a b. Kleisli m a b -> a %1 -> m b
runKleisli :: a %1 -> m b}

instance (Data.Functor f) => Profunctor (Kleisli f) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Kleisli f a b -> Kleisli f s t
dimap s %1 -> a
f b %1 -> t
g (Kleisli a %1 -> f b
h) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap b %1 -> t
g forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. a %1 -> f b
h forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. s %1 -> a
f)

instance (Control.Functor f) => Strong (,) () (Kleisli f) where
  first :: forall a b c. Kleisli f a b -> Kleisli f (a, c) (b, c)
first (Kleisli a %1 -> f b
f) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (\(a
a, c
b) -> (,c
b) forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.<$> a %1 -> f b
f a
a)
  second :: forall b c a. Kleisli f b c -> Kleisli f (a, b) (a, c)
second (Kleisli b %1 -> f c
g) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (\(a
a, b
b) -> (a
a,) forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.<$> b %1 -> f c
g b
b)

instance (Control.Applicative f) => Strong Either Void (Kleisli f) where
  first :: forall a b c. Kleisli f a b -> Kleisli f (Either a c) (Either b c)
first (Kleisli a %1 -> f b
f) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap forall a b. a -> Either a b
Left forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. a %1 -> f b
f) (forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall a b. b -> Either a b
Right))
  second :: forall b c a. Kleisli f b c -> Kleisli f (Either a b) (Either a c)
second (Kleisli b %1 -> f c
g) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either (forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap forall a b. b -> Either a b
Right forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. b %1 -> f c
g))

instance (Data.Applicative f) => Monoidal (,) () (Kleisli f) where
  Kleisli a %1 -> f b
f *** :: forall a b x y.
Kleisli f a b -> Kleisli f x y -> Kleisli f (a, x) (b, y)
*** Kleisli x %1 -> f y
g = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \(a
x, x
y) -> (,) forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.<$> a %1 -> f b
f a
x forall (f :: * -> *) a b.
Applicative f =>
f (a %1 -> b) %1 -> f a %1 -> f b
Data.<*> x %1 -> f y
g x
y
  unit :: Kleisli f () ()
unit = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \() -> forall (f :: * -> *) a. Applicative f => a -> f a
Data.pure ()

instance (Data.Functor f) => Monoidal Either Void (Kleisli f) where
  Kleisli a %1 -> f b
f *** :: forall a b x y.
Kleisli f a b
-> Kleisli f x y -> Kleisli f (Either a x) (Either b y)
*** Kleisli x %1 -> f y
g = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \case
    Left a
a -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.<$> a %1 -> f b
f a
a
    Right x
b -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.<$> x %1 -> f y
g x
b
  unit :: Kleisli f Void Void
unit = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \case {}

instance (Control.Applicative f) => Wandering (Kleisli f) where
  wander :: forall s t a b.
(forall (f :: * -> *).
 Applicative f =>
 (a %1 -> f b) -> s %1 -> f t)
-> Kleisli f a b -> Kleisli f s t
wander forall (f :: * -> *). Applicative f => (a %1 -> f b) -> s %1 -> f t
traverse (Kleisli a %1 -> f b
f) = forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (forall (f :: * -> *). Applicative f => (a %1 -> f b) -> s %1 -> f t
traverse a %1 -> f b
f)

-- | Linear co-Kleisli arrows for the comonad `w`. These arrows are still
-- useful in the case where `w` is not a comonad however, and some
-- profunctorial properties still hold in this weaker setting.
-- However stronger requirements on `f` are needed for profunctorial
-- strength, so we have fewer instances.
newtype CoKleisli w a b = CoKleisli {forall (w :: * -> *) a b. CoKleisli w a b -> w a %1 -> b
runCoKleisli :: w a %1 -> b}

instance (Data.Functor f) => Profunctor (CoKleisli f) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> CoKleisli f a b -> CoKleisli f s t
dimap s %1 -> a
f b %1 -> t
g (CoKleisli f a %1 -> b
h) = forall (w :: * -> *) a b. (w a %1 -> b) -> CoKleisli w a b
CoKleisli (b %1 -> t
g forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. f a %1 -> b
h forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap s %1 -> a
f)

instance Strong Either Void (CoKleisli (Data.Const x)) where
  first :: forall a b c.
CoKleisli (Const x) a b
-> CoKleisli (Const x) (Either a c) (Either b c)
first (CoKleisli Const x a %1 -> b
f) = forall (w :: * -> *) a b. (w a %1 -> b) -> CoKleisli w a b
CoKleisli (\(Data.Const x
x) -> forall a b. a -> Either a b
Left (Const x a %1 -> b
f (forall {k} a (b :: k). a -> Const a b
Data.Const x
x)))