{-# LANGUAGE CPP #-}
{-# 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 (..))
#if MIN_VERSION_transformers(0,5,3)
import Control.Monad.Trans.Accum(AccumT(..), runAccumT)
#endif
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)
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 = forall {i} (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
CanDeriveDistributiveT t f g x =>
f (t g x) -> t (Compose f g) x
gtdistributeDefault
tdistribute' :: (DistributiveT t, Functor f) => f (t Identity x) -> t f x
tdistribute' :: forall {i} (t :: (* -> *) -> i -> *) (f :: * -> *) (x :: i).
(DistributiveT t, Functor f) =>
f (t Identity x) -> t f x
tdistribute' = 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute
tcotraverse :: (DistributiveT t, Functor f) => (forall a . f (g a) -> f a) -> f (t g x) -> t f x
tcotraverse :: forall {i} (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
(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
h = 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 (forall a. f (g a) -> f a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute
tdecompose :: DistributiveT t => (a -> t Identity x) -> t ((->) a) x
tdecompose :: forall {i} (t :: (* -> *) -> i -> *) a (x :: i).
DistributiveT t =>
(a -> t Identity x) -> t ((->) a) x
tdecompose = forall {i} (t :: (* -> *) -> i -> *) (f :: * -> *) (x :: i).
(DistributiveT t, Functor f) =>
f (t Identity x) -> t f x
tdistribute'
trecompose :: FunctorT t => t ((->) a) x -> a -> t Identity x
trecompose :: forall {k'} (t :: (* -> *) -> k' -> *) a (x :: k').
FunctorT t =>
t ((->) a) x -> a -> t Identity x
trecompose t ((->) a) x
bfs = \a
a -> 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 (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ a
a)) t ((->) a) x
bfs
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))
)
gtdistributeDefault
:: CanDeriveDistributiveT t f g x
=> f (t g x)
-> t (Compose f g) x
gtdistributeDefault :: forall {i} (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
CanDeriveDistributiveT t f g x =>
f (t g x) -> t (Compose f g) x
gtdistributeDefault = forall (n :: Nat) a x. GenericP n a => Proxy n -> RepP n a x -> a
toP (forall {k} (t :: k). Proxy t
Proxy @1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (n :: Nat) (f :: * -> *) (repbg :: k -> *)
(repbfg :: k -> *) (x :: k).
GDistributive n f repbg repbfg =>
Proxy n -> f (repbg x) -> repbfg x
gdistribute (forall {k} (t :: k). Proxy t
Proxy @1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (n :: Nat) a x. GenericP n a => Proxy n -> a -> RepP n a x
fromP (forall {k} (t :: k). Proxy t
Proxy @1))
{-# INLINE gtdistributeDefault #-}
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 :: forall (x :: k).
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
_ = forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i c (p :: k). K1 i c p -> c
unK1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} p a (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 :: forall (x :: k).
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
_ = forall {k} p a (x :: k). K1 R a x -> Rec p a x
Rec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i (t :: (* -> *) -> i -> *) (f :: * -> *) (g :: * -> *)
(x :: i).
(DistributiveT t, Functor f) =>
f (t g x) -> t (Compose f g) x
tdistribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i c (p :: k). K1 i c p -> c
unK1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} p a (x :: k). Rec p a x -> K1 R a x
unRec)
{-# INLINE gdistribute #-}
instance Distributive f => DistributiveT (Compose f) where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (Compose f g x) -> Compose f (Compose f g) x
tdistribute = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE tdistribute #-}
#if MIN_VERSION_transformers(0,5,3)
instance DistributiveT (AccumT w) where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (AccumT w g x) -> AccumT w (Compose f g) x
tdistribute f (AccumT w g x)
fh = forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
AccumT forall a b. (a -> b) -> a -> b
$ \w
w -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AccumT w g x
h -> forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT AccumT w g x
h w
w) f (AccumT w g x)
fh
{-# INLINE tdistribute #-}
#endif
instance DistributiveT Backwards where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (Backwards g x) -> Backwards (Compose f g) x
tdistribute = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
{-# INLINE tdistribute #-}
instance DistributiveT Reverse where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (Reverse g x) -> Reverse (Compose f g) x
tdistribute = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). Reverse f a -> f a
getReverse
{-# INLINE tdistribute #-}
instance DistributiveT (ExceptT e) where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (ExceptT e g x) -> ExceptT e (Compose f g) x
tdistribute = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
{-# INLINE tdistribute #-}
instance DistributiveT IdentityT where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (IdentityT g x) -> IdentityT (Compose f g) x
tdistribute = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
{-# INLINE tdistribute #-}
instance DistributiveT MaybeT where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (MaybeT g x) -> MaybeT (Compose f g) x
tdistribute = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
{-# INLINE tdistribute #-}
instance DistributiveT (Lazy.RWST r w s) where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (RWST r w s g x) -> RWST r w s (Compose f g) x
tdistribute f (RWST r w s g x)
fh = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RWST r w s g x
h -> 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 :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (RWST r w s g x) -> RWST r w s (Compose f g) x
tdistribute f (RWST r w s g x)
fh = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\RWST r w s g x
h -> 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 :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (ReaderT r g x) -> ReaderT r (Compose f g) x
tdistribute f (ReaderT r g x)
fh = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ReaderT r g x
h -> 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 :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (StateT s g x) -> StateT s (Compose f g) x
tdistribute f (StateT s g x)
fh = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StateT s g x
h -> 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 :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (StateT s g x) -> StateT s (Compose f g) x
tdistribute f (StateT s g x)
fh = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StateT s g x
h -> 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 :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (WriterT w g x) -> WriterT w (Compose f g) x
tdistribute = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT
{-# INLINE tdistribute #-}
instance DistributiveT (Strict.WriterT w) where
tdistribute :: forall (f :: * -> *) (g :: * -> *) x.
Functor f =>
f (WriterT w g x) -> WriterT w (Compose f g) x
tdistribute = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT
{-# INLINE tdistribute #-}