{-# LANGUAGE PolyKinds    #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Barbies.Internal.DistributiveT
  ( DistributiveT(..)
  , tdistribute'
  , tcotraverse
  , tdecompose
  , trecompose
  , gtdistributeDefault
  , CanDeriveDistributiveT
  )

where

import Barbies.Generics.Distributive (GDistributive(..))
import Barbies.Internal.FunctorT (FunctorT (..))

import Control.Applicative.Backwards(Backwards (..))

import Control.Monad.Trans.Except(ExceptT(..), runExceptT)
import Control.Monad.Trans.Identity(IdentityT(..))
import Control.Monad.Trans.Maybe(MaybeT(..))
import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..))
import Control.Monad.Trans.RWS.Strict as Strict (RWST(..))
import Control.Monad.Trans.Reader(ReaderT(..))
import Control.Monad.Trans.State.Lazy as Lazy (StateT(..))
import Control.Monad.Trans.State.Strict as Strict (StateT(..))
import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..))
import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..))

import Data.Functor.Compose   (Compose (..))
import Data.Functor.Identity  (Identity (..))
import Data.Functor.Reverse   (Reverse (..))
import Data.Generics.GenericN
import Data.Proxy             (Proxy (..))
import Data.Distributive
import Data.Kind              (Type)

-- | A 'FunctorT' where the effects can be distributed to the fields:
--  `tdistribute` turns an effectful way of building a transformer-type
--  into a pure transformer-type with effectful ways of computing the
--  values of its fields.
--
--  This class is the categorical dual of `Barbies.Internal.TraversableT.TraversableT`,
--  with `tdistribute` the dual of `Barbies.Internal.TraversableT.tsequence`
--  and `tcotraverse` the dual of `Barbies.Internal.TraversableT.ttraverse`. As such,
--  instances need to satisfy these laws:
--
-- @
-- 'tdistribute' . h = 'tmap' ('Compose' . h . 'getCompose') . 'tdistribute'    -- naturality
-- 'tdistribute' . 'Data.Functor.Identity' = 'tmap' ('Compose' . 'Data.Functor.Identity')                 -- identity
-- 'tdistribute' . 'Compose' = 'fmap' ('Compose' . 'Compose' . 'fmap' 'getCompose' . 'getCompose') . 'tdistribute' . 'fmap' 'distribute' -- composition
-- @
--
-- By specializing @f@ to @((->) a)@ and @g@ to 'Identity', we can define a function that
-- decomposes a function on distributive transformers into a collection of simpler functions:
--
-- @
-- 'tdecompose' :: 'DistributiveT' b => (a -> b 'Identity') -> b ((->) a)
-- 'tdecompose' = 'tmap' ('fmap' 'runIdentity' . 'getCompose') . 'tdistribute'
-- @
--
-- Lawful instances of the class can then be characterized as those that satisfy:
--
-- @
-- 'trecompose' . 'tdecompose' = 'id'
-- 'tdecompose' . 'trecompose' = 'id'
-- @
--
-- This means intuitively that instances need to have a fixed shape (i.e. no sum-types can be involved).
-- Typically, this means record types, as long as they don't contain fields where the functor argument is not applied.
--
--
-- There is a default implementation of 'tdistribute' based on
-- 'Generic'.  Intuitively, it works on product types where the shape
-- of a pure value is uniquely defined and every field is covered by
-- the argument @f@.
class FunctorT t => DistributiveT (t :: (Type -> Type) -> i -> Type) where
  tdistribute :: Functor f => f (t g x) -> t (Compose f g) x

  default tdistribute
    :: forall f g x
    .  CanDeriveDistributiveT t f g x
    => f (t g x)
    -> t (Compose f g) x
  tdistribute = f (t g x) -> t (Compose f g) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
CanDeriveDistributiveT t f g x =>
f (t g x) -> t (Compose f g) x
gtdistributeDefault

-- | A version of `tdistribute` with @g@ specialized to `Identity`.
tdistribute' :: (DistributiveT t, Functor f) => f (t Identity x) -> t f x
tdistribute' :: f (t Identity x) -> t f x
tdistribute' = (forall a. Compose f Identity a -> f a)
-> t (Compose f Identity) x -> t f x
forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap ((Identity a -> a) -> f (Identity a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity (f (Identity a) -> f a)
-> (Compose f Identity a -> f (Identity a))
-> Compose f Identity a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f Identity a -> f (Identity a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (t (Compose f Identity) x -> t f x)
-> (f (t Identity x) -> t (Compose f Identity) x)
-> f (t Identity x)
-> t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (t Identity x) -> t (Compose f Identity) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute

-- | Dual of `Barbies.Internal.TraversableT.ttraverse`
tcotraverse :: (DistributiveT t, Functor f) => (forall a . f (g a) -> f a) -> f (t g x) -> t f x
tcotraverse :: (forall a. f (g a) -> f a) -> f (t g x) -> t f x
tcotraverse forall a. f (g a) -> f a
h = (forall a. Compose f g a -> f a) -> t (Compose f g) x -> t f x
forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap (f (g a) -> f a
forall a. f (g a) -> f a
h (f (g a) -> f a)
-> (Compose f g a -> f (g a)) -> Compose f g a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f g a -> f (g a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (t (Compose f g) x -> t f x)
-> (f (t g x) -> t (Compose f g) x) -> f (t g x) -> t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (t g x) -> t (Compose f g) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute

-- | Decompose a function returning a distributive transformer, into
--   a collection of simpler functions.
tdecompose :: DistributiveT t => (a -> t Identity x) -> t ((->) a) x
tdecompose :: (a -> t Identity x) -> t ((->) a) x
tdecompose = (a -> t Identity x) -> t ((->) a) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (x :: i).
(DistributiveT t, Functor f) =>
f (t Identity x) -> t f x
tdistribute'

-- | Recompose a decomposed function.
trecompose :: FunctorT t => t ((->) a) x -> a -> t Identity x
trecompose :: t ((->) a) x -> a -> t Identity x
trecompose t ((->) a) x
bfs = \a
a -> (forall a. (a -> a) -> Identity a) -> t ((->) a) x -> t Identity x
forall k k' (t :: (k -> *) -> k' -> *) (f :: k -> *) (g :: k -> *)
       (x :: k').
FunctorT t =>
(forall (a :: k). f a -> g a) -> t f x -> t g x
tmap (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> ((a -> a) -> a) -> (a -> a) -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
a)) t ((->) a) x
bfs

-- | @'CanDeriveDistributiveT' T f g x@ is in practice a predicate about @T@ only.
--   Intuitively, it says the the following holds  for any arbitrary @f@:
--
--     * There is an instance of @'Generic' (B f x)@.
--
--     * @(B f x)@ has only one constructor, and doesn't contain "naked" fields
--       (that is, not covered by `f`). In particular, @x@ needs to occur under @f@.
--
--     * @B f x@ can contain fields of type @b f y@ as long as there exists a
--       @'DistributiveT' b@ instance. In particular, recursive usages of @B f x@
--       are allowed.
--
--     * @B f x@ can also contain usages of @b f y@ under a @'Distributive' h@.
--       For example, one could use @a -> (B f x)@ as a field of @B f x@.
type CanDeriveDistributiveT (t :: (Type -> Type) -> i -> Type) f g x
  = ( GenericP 1 (t g x)
    , GenericP 1 (t (Compose f g) x)
    , GDistributive 1 f (RepP 1 (t g x)) (RepP 1 (t (Compose f g) x))
    )

-- | Default implementation of 'tdistribute' based on 'Generic'.
gtdistributeDefault
  :: CanDeriveDistributiveT t f g x
  => f (t g x)
  -> t (Compose f g) x
gtdistributeDefault :: f (t g x) -> t (Compose f g) x
gtdistributeDefault = Proxy 1 -> RepP 1 (t (Compose f g) x) Any -> t (Compose f g) x
forall (n :: Nat) a x. GenericP n a => Proxy n -> RepP n a x -> a
toP (Proxy 1
forall k (t :: k). Proxy t
Proxy @1) (Zip
   (Rep (FilterIndex 1 (Indexed t 2) (Param 1 (Compose f g)) x))
   (Rep (t (Compose f g) x))
   Any
 -> t (Compose f g) x)
-> (f (t g x)
    -> Zip
         (Rep (FilterIndex 1 (Indexed t 2) (Param 1 (Compose f g)) x))
         (Rep (t (Compose f g) x))
         Any)
-> f (t g x)
-> t (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy 1
-> f (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
        (Rep (t g x))
        Any)
-> Zip
     (Rep (FilterIndex 1 (Indexed t 2) (Param 1 (Compose f g)) x))
     (Rep (t (Compose f g) x))
     Any
forall k (n :: Nat) (f :: * -> *) (repbg :: k -> *)
       (repbfg :: k -> *) (x :: k).
GDistributive n f repbg repbfg =>
Proxy n -> f (repbg x) -> repbfg x
gdistribute (Proxy 1
forall k (t :: k). Proxy t
Proxy @1) (f (Zip
      (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
      (Rep (t g x))
      Any)
 -> Zip
      (Rep (FilterIndex 1 (Indexed t 2) (Param 1 (Compose f g)) x))
      (Rep (t (Compose f g) x))
      Any)
-> (f (t g x)
    -> f (Zip
            (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
            (Rep (t g x))
            Any))
-> f (t g x)
-> Zip
     (Rep (FilterIndex 1 (Indexed t 2) (Param 1 (Compose f g)) x))
     (Rep (t (Compose f g) x))
     Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t g x
 -> Zip
      (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
      (Rep (t g x))
      Any)
-> f (t g x)
-> f (Zip
        (Rep (FilterIndex 1 (Indexed t 2) (Param 1 g) x))
        (Rep (t g x))
        Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proxy 1 -> t g x -> RepP 1 (t g x) Any
forall (n :: Nat) a x. GenericP n a => Proxy n -> a -> RepP n a x
fromP (Proxy 1
forall k (t :: k). Proxy t
Proxy @1))
{-# INLINE gtdistributeDefault #-}

------------------------------------------------------------
-- Generic derivation: Special cases for FunctorT
-- -----------------------------------------------------------

type P = Param

instance
  ( Functor f
  , DistributiveT t
  ) => GDistributive 1 f (Rec (t (P 1 g) x) (t g x)) (Rec (t (P 1 (Compose f g)) x) (t (Compose f g) x))
  where
  gdistribute :: Proxy 1
-> f (Rec (t (P 1 g) x) (t g x) x)
-> Rec (t (P 1 (Compose f g)) x) (t (Compose f g) x) x
gdistribute Proxy 1
_ = K1 R (t (Compose f g) x) x
-> Rec (t (P 1 (Compose f g)) x) (t (Compose f g) x) x
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (t (Compose f g) x) x
 -> Rec (t (P 1 (Compose f g)) x) (t (Compose f g) x) x)
-> (f (Rec (t (P 1 g) x) (t g x) x) -> K1 R (t (Compose f g) x) x)
-> f (Rec (t (P 1 g) x) (t g x) x)
-> Rec (t (P 1 (Compose f g)) x) (t (Compose f g) x) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Compose f g) x -> K1 R (t (Compose f g) x) x
forall k i c (p :: k). c -> K1 i c p
K1 (t (Compose f g) x -> K1 R (t (Compose f g) x) x)
-> (f (Rec (t (P 1 g) x) (t g x) x) -> t (Compose f g) x)
-> f (Rec (t (P 1 g) x) (t g x) x)
-> K1 R (t (Compose f g) x) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (t g x) -> t (Compose f g) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute (f (t g x) -> t (Compose f g) x)
-> (f (Rec (t (P 1 g) x) (t g x) x) -> f (t g x))
-> f (Rec (t (P 1 g) x) (t g x) x)
-> t (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec (t (P 1 g) x) (t g x) x -> t g x)
-> f (Rec (t (P 1 g) x) (t g x) x) -> f (t g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (t g x) x -> t g x
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R (t g x) x -> t g x)
-> (Rec (t (P 1 g) x) (t g x) x -> K1 R (t g x) x)
-> Rec (t (P 1 g) x) (t g x) x
-> t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (t (P 1 g) x) (t g x) x -> K1 R (t g x) x
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec)
  {-# INLINE gdistribute #-}


instance
  ( Functor f
  , Distributive h
  , DistributiveT t
  ) =>
  GDistributive 1 f (Rec (h (t (P 1 g) x)) (h (t g x))) (Rec (h (t (P 1 (Compose f g)) x)) (h (t (Compose f g) x)))
  where
  gdistribute :: Proxy 1
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
-> Rec (h (t (P 1 (Compose f g)) x)) (h (t (Compose f g) x)) x
gdistribute Proxy 1
_ = K1 R (h (t (Compose f g) x)) x
-> Rec (h (t (P 1 (Compose f g)) x)) (h (t (Compose f g) x)) x
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R (h (t (Compose f g) x)) x
 -> Rec (h (t (P 1 (Compose f g)) x)) (h (t (Compose f g) x)) x)
-> (f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
    -> K1 R (h (t (Compose f g) x)) x)
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
-> Rec (h (t (P 1 (Compose f g)) x)) (h (t (Compose f g) x)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (t (Compose f g) x) -> K1 R (h (t (Compose f g) x)) x
forall k i c (p :: k). c -> K1 i c p
K1 (h (t (Compose f g) x) -> K1 R (h (t (Compose f g) x)) x)
-> (f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
    -> h (t (Compose f g) x))
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
-> K1 R (h (t (Compose f g) x)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (t g x) -> t (Compose f g) x)
-> h (f (t g x)) -> h (t (Compose f g) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (t g x) -> t (Compose f g) x
forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
       (x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute (h (f (t g x)) -> h (t (Compose f g) x))
-> (f (Rec (h (t (P 1 g) x)) (h (t g x)) x) -> h (f (t g x)))
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
-> h (t (Compose f g) x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (h (t g x)) -> h (f (t g x))
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute (f (h (t g x)) -> h (f (t g x)))
-> (f (Rec (h (t (P 1 g) x)) (h (t g x)) x) -> f (h (t g x)))
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x)
-> h (f (t g x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec (h (t (P 1 g) x)) (h (t g x)) x -> h (t g x))
-> f (Rec (h (t (P 1 g) x)) (h (t g x)) x) -> f (h (t g x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 R (h (t g x)) x -> h (t g x)
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R (h (t g x)) x -> h (t g x))
-> (Rec (h (t (P 1 g) x)) (h (t g x)) x -> K1 R (h (t g x)) x)
-> Rec (h (t (P 1 g) x)) (h (t g x)) x
-> h (t g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (h (t (P 1 g) x)) (h (t g x)) x -> K1 R (h (t g x)) x
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec)
  {-# INLINE gdistribute #-}

-- --------------------------------
-- Instances for base types
-- --------------------------------

instance Distributive f => DistributiveT (Compose f) where
  tdistribute :: f (Compose f g x) -> Compose f (Compose f g) x
tdistribute = f (Compose f g x) -> Compose f (Compose f g) x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (Compose f g x) -> Compose f (Compose f g) x)
-> (f (Compose f g x) -> f (Compose f g x))
-> f (Compose f g x)
-> Compose f (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (g x) -> Compose f g x) -> f (f (g x)) -> f (Compose f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f (g x)) -> f (Compose f g x))
-> (f (Compose f g x) -> f (f (g x)))
-> f (Compose f g x)
-> f (Compose f g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (g x)) -> f (f (g x))
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute (f (f (g x)) -> f (f (g x)))
-> (f (Compose f g x) -> f (f (g x)))
-> f (Compose f g x)
-> f (f (g x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Compose f g x -> f (g x)) -> f (Compose f g x) -> f (f (g x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Compose f g x -> f (g x)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  {-# INLINE tdistribute #-}

-- -- --------------------------------
-- -- Instances for transformers types
-- -- --------------------------------

instance DistributiveT Backwards where
  tdistribute :: f (Backwards g x) -> Backwards (Compose f g) x
tdistribute = Compose f g x -> Backwards (Compose f g) x
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Compose f g x -> Backwards (Compose f g) x)
-> (f (Backwards g x) -> Compose f g x)
-> f (Backwards g x)
-> Backwards (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> Compose f g x)
-> (f (Backwards g x) -> f (g x))
-> f (Backwards g x)
-> Compose f g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Backwards g x -> g x) -> f (Backwards g x) -> f (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Backwards g x -> g x
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE tdistribute #-}

instance DistributiveT Reverse where
  tdistribute :: f (Reverse g x) -> Reverse (Compose f g) x
tdistribute = Compose f g x -> Reverse (Compose f g) x
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (Compose f g x -> Reverse (Compose f g) x)
-> (f (Reverse g x) -> Compose f g x)
-> f (Reverse g x)
-> Reverse (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> Compose f g x)
-> (f (Reverse g x) -> f (g x)) -> f (Reverse g x) -> Compose f g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reverse g x -> g x) -> f (Reverse g x) -> f (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reverse g x -> g x
forall k (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
  {-# INLINE tdistribute #-}

instance DistributiveT (ExceptT e) where
  tdistribute :: f (ExceptT e g x) -> ExceptT e (Compose f g) x
tdistribute = Compose f g (Either e x) -> ExceptT e (Compose f g) x
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Compose f g (Either e x) -> ExceptT e (Compose f g) x)
-> (f (ExceptT e g x) -> Compose f g (Either e x))
-> f (ExceptT e g x)
-> ExceptT e (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g (Either e x)) -> Compose f g (Either e x)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (Either e x)) -> Compose f g (Either e x))
-> (f (ExceptT e g x) -> f (g (Either e x)))
-> f (ExceptT e g x)
-> Compose f g (Either e x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT e g x -> g (Either e x))
-> f (ExceptT e g x) -> f (g (Either e x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExceptT e g x -> g (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  {-# INLINE tdistribute #-}

instance DistributiveT IdentityT where
  tdistribute :: f (IdentityT g x) -> IdentityT (Compose f g) x
tdistribute = Compose f g x -> IdentityT (Compose f g) x
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (Compose f g x -> IdentityT (Compose f g) x)
-> (f (IdentityT g x) -> Compose f g x)
-> f (IdentityT g x)
-> IdentityT (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> Compose f g x)
-> (f (IdentityT g x) -> f (g x))
-> f (IdentityT g x)
-> Compose f g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdentityT g x -> g x) -> f (IdentityT g x) -> f (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IdentityT g x -> g x
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  {-# INLINE tdistribute #-}

instance DistributiveT MaybeT where
  tdistribute :: f (MaybeT g x) -> MaybeT (Compose f g) x
tdistribute = Compose f g (Maybe x) -> MaybeT (Compose f g) x
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Compose f g (Maybe x) -> MaybeT (Compose f g) x)
-> (f (MaybeT g x) -> Compose f g (Maybe x))
-> f (MaybeT g x)
-> MaybeT (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g (Maybe x)) -> Compose f g (Maybe x)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (Maybe x)) -> Compose f g (Maybe x))
-> (f (MaybeT g x) -> f (g (Maybe x)))
-> f (MaybeT g x)
-> Compose f g (Maybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeT g x -> g (Maybe x)) -> f (MaybeT g x) -> f (g (Maybe x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeT g x -> g (Maybe x)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
  {-# INLINE tdistribute #-}

instance DistributiveT (Lazy.RWST r w s) where
  tdistribute :: f (RWST r w s g x) -> RWST r w s (Compose f g) x
tdistribute f (RWST r w s g x)
fh = (r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x)
-> (r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> f (g (x, s, w)) -> Compose f g (x, s, w)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, s, w)) -> Compose f g (x, s, w))
-> f (g (x, s, w)) -> Compose f g (x, s, w)
forall a b. (a -> b) -> a -> b
$ (RWST r w s g x -> g (x, s, w))
-> f (RWST r w s g x) -> f (g (x, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RWST r w s g x
h -> RWST r w s g x -> r -> s -> g (x, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s g x
h r
r s
s) f (RWST r w s g x)
fh
  {-# INLINE tdistribute #-}

instance DistributiveT (Strict.RWST r w s) where
  tdistribute :: f (RWST r w s g x) -> RWST r w s (Compose f g) x
tdistribute f (RWST r w s g x)
fh = (r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x)
-> (r -> s -> Compose f g (x, s, w)) -> RWST r w s (Compose f g) x
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> f (g (x, s, w)) -> Compose f g (x, s, w)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, s, w)) -> Compose f g (x, s, w))
-> f (g (x, s, w)) -> Compose f g (x, s, w)
forall a b. (a -> b) -> a -> b
$ (RWST r w s g x -> g (x, s, w))
-> f (RWST r w s g x) -> f (g (x, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RWST r w s g x
h -> RWST r w s g x -> r -> s -> g (x, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s g x
h r
r s
s) f (RWST r w s g x)
fh
  {-# INLINE tdistribute #-}

instance DistributiveT (ReaderT r) where
  tdistribute :: f (ReaderT r g x) -> ReaderT r (Compose f g) x
tdistribute f (ReaderT r g x)
fh = (r -> Compose f g x) -> ReaderT r (Compose f g) x
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> Compose f g x) -> ReaderT r (Compose f g) x)
-> (r -> Compose f g x) -> ReaderT r (Compose f g) x
forall a b. (a -> b) -> a -> b
$ \r
r -> f (g x) -> Compose f g x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g x) -> Compose f g x) -> f (g x) -> Compose f g x
forall a b. (a -> b) -> a -> b
$ (ReaderT r g x -> g x) -> f (ReaderT r g x) -> f (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReaderT r g x
h -> ReaderT r g x -> r -> g x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r g x
h r
r) f (ReaderT r g x)
fh
  {-# INLINE tdistribute #-}

instance DistributiveT (Lazy.StateT s) where
  tdistribute :: f (StateT s g x) -> StateT s (Compose f g) x
tdistribute f (StateT s g x)
fh = (s -> Compose f g (x, s)) -> StateT s (Compose f g) x
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> Compose f g (x, s)) -> StateT s (Compose f g) x)
-> (s -> Compose f g (x, s)) -> StateT s (Compose f g) x
forall a b. (a -> b) -> a -> b
$ \s
s -> f (g (x, s)) -> Compose f g (x, s)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, s)) -> Compose f g (x, s))
-> f (g (x, s)) -> Compose f g (x, s)
forall a b. (a -> b) -> a -> b
$ (StateT s g x -> g (x, s)) -> f (StateT s g x) -> f (g (x, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StateT s g x
h -> StateT s g x -> s -> g (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s g x
h s
s) f (StateT s g x)
fh
  {-# INLINE tdistribute #-}

instance DistributiveT (Strict.StateT s) where
  tdistribute :: f (StateT s g x) -> StateT s (Compose f g) x
tdistribute f (StateT s g x)
fh = (s -> Compose f g (x, s)) -> StateT s (Compose f g) x
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> Compose f g (x, s)) -> StateT s (Compose f g) x)
-> (s -> Compose f g (x, s)) -> StateT s (Compose f g) x
forall a b. (a -> b) -> a -> b
$ \s
s -> f (g (x, s)) -> Compose f g (x, s)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, s)) -> Compose f g (x, s))
-> f (g (x, s)) -> Compose f g (x, s)
forall a b. (a -> b) -> a -> b
$ (StateT s g x -> g (x, s)) -> f (StateT s g x) -> f (g (x, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StateT s g x
h -> StateT s g x -> s -> g (x, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s g x
h s
s) f (StateT s g x)
fh
  {-# INLINE tdistribute #-}

instance DistributiveT (Lazy.WriterT w) where
  tdistribute :: f (WriterT w g x) -> WriterT w (Compose f g) x
tdistribute = Compose f g (x, w) -> WriterT w (Compose f g) x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (Compose f g (x, w) -> WriterT w (Compose f g) x)
-> (f (WriterT w g x) -> Compose f g (x, w))
-> f (WriterT w g x)
-> WriterT w (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g (x, w)) -> Compose f g (x, w)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, w)) -> Compose f g (x, w))
-> (f (WriterT w g x) -> f (g (x, w)))
-> f (WriterT w g x)
-> Compose f g (x, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WriterT w g x -> g (x, w)) -> f (WriterT w g x) -> f (g (x, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WriterT w g x -> g (x, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT
  {-# INLINE tdistribute #-}

instance DistributiveT (Strict.WriterT w) where
  tdistribute :: f (WriterT w g x) -> WriterT w (Compose f g) x
tdistribute = Compose f g (x, w) -> WriterT w (Compose f g) x
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (Compose f g (x, w) -> WriterT w (Compose f g) x)
-> (f (WriterT w g x) -> Compose f g (x, w))
-> f (WriterT w g x)
-> WriterT w (Compose f g) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (g (x, w)) -> Compose f g (x, w)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g (x, w)) -> Compose f g (x, w))
-> (f (WriterT w g x) -> f (g (x, w)))
-> f (WriterT w g x)
-> Compose f g (x, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WriterT w g x -> g (x, w)) -> f (WriterT w g x) -> f (g (x, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WriterT w g x -> g (x, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT
  {-# INLINE tdistribute #-}