{-# 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) = (s %1 -> f t) -> Kleisli f s t
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((b %1 -> t) -> f b %1 -> f t
forall a b. (a %1 -> b) -> f a %1 -> f b
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap b %1 -> t
g (f b %1 -> f t) -> (s %1 -> f b) -> s %1 -> f t
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 (a %1 -> f b) -> (s %1 -> a) -> s %1 -> f b
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) = ((a, c) %1 -> f (b, c)) -> Kleisli f (a, c) (b, c)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (\(a
a, c
b) -> (,c
b) (b %1 -> (b, c)) %1 -> f b %1 -> f (b, c)
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) = ((a, b) %1 -> f (a, c)) -> Kleisli f (a, b) (a, c)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (\(a
a, b
b) -> (a
a,) (c %1 -> (a, c)) %1 -> f c %1 -> f (a, c)
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) = (Either a c %1 -> f (Either b c))
-> Kleisli f (Either a c) (Either b c)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((a %1 -> f (Either b c))
-> (c %1 -> f (Either b c)) -> Either a c %1 -> f (Either b c)
forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either ((b %1 -> Either b c) -> f b %1 -> f (Either b c)
forall a b. (a %1 -> b) -> f a %1 -> f b
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap b -> Either b c
forall a b. a -> Either a b
Left (f b %1 -> f (Either b c))
-> (a %1 -> f b) -> a %1 -> f (Either b c)
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) (Either b c %1 -> f (Either b c)
forall a. a %1 -> f a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure (Either b c %1 -> f (Either b c))
-> (c %1 -> Either b c) -> c %1 -> f (Either b c)
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. c -> Either b 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) = (Either a b %1 -> f (Either a c))
-> Kleisli f (Either a b) (Either a c)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((a %1 -> f (Either a c))
-> (b %1 -> f (Either a c)) -> Either a b %1 -> f (Either a c)
forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either (Either a c %1 -> f (Either a c)
forall a. a %1 -> f a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure (Either a c %1 -> f (Either a c))
-> (a %1 -> Either a c) -> a %1 -> f (Either a c)
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. a -> Either a c
forall a b. a -> Either a b
Left) ((c %1 -> Either a c) -> f c %1 -> f (Either a c)
forall a b. (a %1 -> b) -> f a %1 -> f b
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap c -> Either a c
forall a b. b -> Either a b
Right (f c %1 -> f (Either a c))
-> (b %1 -> f c) -> b %1 -> f (Either a c)
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 = ((a, x) %1 -> f (b, y)) -> Kleisli f (a, x) (b, y)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (((a, x) %1 -> f (b, y)) -> Kleisli f (a, x) (b, y))
-> ((a, x) %1 -> f (b, y)) -> Kleisli f (a, x) (b, y)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \(a
x, x
y) -> (,) (b %1 -> y %1 -> (b, y)) -> f b %1 -> f (y %1 -> (b, y))
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.<$> a %1 -> f b
f a
x f (y %1 -> (b, y)) %1 -> f y %1 -> f (b, y)
forall a b. f (a %1 -> b) %1 -> f a %1 -> f b
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 = (() %1 -> f ()) -> Kleisli f () ()
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((() %1 -> f ()) -> Kleisli f () ())
-> (() %1 -> f ()) -> Kleisli f () ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \() -> () -> f ()
forall a. a -> f a
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 = (Either a x %1 -> f (Either b y))
-> Kleisli f (Either a x) (Either b y)
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((Either a x %1 -> f (Either b y))
 -> Kleisli f (Either a x) (Either b y))
-> (Either a x %1 -> f (Either b y))
-> Kleisli f (Either a x) (Either b y)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \case
    Left a
a -> b -> Either b y
forall a b. a -> Either a b
Left (b %1 -> Either b y) -> f b %1 -> f (Either b y)
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 -> y -> Either b y
forall a b. b -> Either a b
Right (y %1 -> Either b y) -> f y %1 -> f (Either b y)
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 = (Void %1 -> f Void) -> Kleisli f Void Void
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((Void %1 -> f Void) -> Kleisli f Void Void)
-> (Void %1 -> f Void) -> Kleisli f Void Void
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) = (s %1 -> f t) -> Kleisli f s t
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((a %1 -> f b) -> s %1 -> f t
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) = (f s %1 -> t) -> CoKleisli f s t
forall (w :: * -> *) a b. (w a %1 -> b) -> CoKleisli w a b
CoKleisli (b %1 -> t
g (b %1 -> t) -> (f s %1 -> b) -> f s %1 -> t
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 (f a %1 -> b) -> (f s %1 -> f a) -> f s %1 -> b
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 s %1 -> f a
forall a b. (a %1 -> b) -> f a %1 -> f b
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) = (Const x (Either a c) %1 -> Either b c)
-> CoKleisli (Const x) (Either a c) (Either b c)
forall (w :: * -> *) a b. (w a %1 -> b) -> CoKleisli w a b
CoKleisli (\(Data.Const x
x) -> b -> Either b c
forall a b. a -> Either a b
Left (Const x a %1 -> b
f (x -> Const x a
forall {k} a (b :: k). a -> Const a b
Data.Const x
x)))