{-# LANGUAGE DefaultSignatures         #-}
{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE PolyKinds                 #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE StandaloneDeriving        #-}
{-# LANGUAGE UndecidableInstances      #-}

{-|
Implements higher-ranked equivalents of 'Functor', 'Monad', 'Foldable' and
'Traversable'.
-}
module Language.Expression where

import           Control.Applicative               (Alternative, (<|>))
import           Control.Monad                     ((<=<), (>=>))
import           Data.Monoid                       (Alt (..))
import           Data.Typeable                     (Typeable)

import           Control.Monad.Trans.Reader        (ReaderT (..))
import           Control.Monad.Trans.Except        (ExceptT (..))
import qualified Control.Monad.Trans.State.Lazy    as L
import qualified Control.Monad.Trans.State.Strict  as S
import qualified Control.Monad.Trans.Writer.Lazy   as L
import qualified Control.Monad.Trans.Writer.Strict as S

import           Data.Functor.Compose              (Compose (..))
import           Data.Functor.Const                (Const (..))
import           Data.Functor.Identity             (Identity (..))
import           Data.Functor.Product              (Product (..))
import           Data.Functor.Reverse              (Reverse (..))
import           Data.Functor.Sum                  (Sum (..))

infixr 1 ^>>=

--------------------------------------------------------------------------------
--  Functor / Monad
--------------------------------------------------------------------------------

{-|
Higher-ranked analogue of 'Functor'.
-}
class HFunctor (h :: (u -> *) -> u -> *) where
  {-|
  Higher-ranked analogue of 'fmap'. Has a default implementation in terms of
  'htraverse' for @'HTraversable' h@.
  -}
  hmap :: (forall b. t b -> t' b) -> h t a -> h t' a

  default hmap :: (HTraversable h) => (forall b. t b -> t' b) -> h t a -> h t' a
  hmap forall (b :: u). t b -> t' b
f = Identity (h t' a) -> h t' a
forall a. Identity a -> a
runIdentity (Identity (h t' a) -> h t' a)
-> (h t a -> Identity (h t' a)) -> h t a -> h t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: u). t b -> Identity (t' b))
-> h t a -> Identity (h t' a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse (t' b -> Identity (t' b)
forall a. a -> Identity a
Identity (t' b -> Identity (t' b))
-> (t b -> t' b) -> t b -> Identity (t' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> t' b
forall (b :: u). t b -> t' b
f)

{-|
Half of the higher-ranked analogue of 'Monad'.
-}
class HPointed h where
  {-|
  Higher-ranked analogue of 'pure' or 'return'.
  -}
  hpure :: t a -> h t a

{-|
Half of the higher-ranked analogue of 'Monad'.
-}
class HBind h where
  {-|
  Higher-ranked analogue of '>>='.
  -}
  (^>>=) :: h t a -> (forall b. t b -> h t' b) -> h t' a

{-|

Higher-ranked analogue of 'Monad'.

NB there's no such thing as 'HApplicative' for a reason. Consider @f :: h t a ->
h t' a -> h ('Product' t t') a@, i.e. the higher-ranked analogue of @liftA2 (,)
:: f a -> f b -> f (a, b)@. Unfortunately @f@ can't exist, because @'Product'@
pairs up values /of the same type/, and in our constructions, @h@ potentially
contains values of many types; @a@ just happens to be the one at the top level.
There's no guarantee that the two structures will have the same types inside to
pair together.
-}
class (HFunctor h, HPointed h, HBind h) => HMonad h

{-|
Implements 'hmap' from just an 'HPointed' and 'HBind' instance. Can be used to
implement 'HFunctor' for your 'HMonad's that aren't 'HTraversable'.
-}
hliftM :: (HPointed h, HBind h) => (forall b. t b -> t' b) -> h t a -> h t' a
hliftM :: (forall (b :: k). t b -> t' b) -> h t a -> h t' a
hliftM forall (b :: k). t b -> t' b
f h t a
x = h t a
x h t a -> (forall (b :: k). t b -> h t' b) -> h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k)
       (t' :: k -> *).
HBind h =>
h t a -> (forall (b :: k). t b -> h t' b) -> h t' a
^>>= t' b -> h t' b
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
HPointed h =>
t a -> h t a
hpure (t' b -> h t' b) -> (t b -> t' b) -> t b -> h t' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> t' b
forall (b :: k). t b -> t' b
f

{-|
Higher-ranked analogue of 'Control.Monad.join'.
-}
hjoin :: (HBind h) => h (h t) a -> h t a
hjoin :: h (h t) a -> h t a
hjoin h (h t) a
x = h (h t) a
x h (h t) a -> (forall (b :: k). h t b -> h t b) -> h t a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k)
       (t' :: k -> *).
HBind h =>
h t a -> (forall (b :: k). t b -> h t' b) -> h t' a
^>>= forall (b :: k). h t b -> h t b
forall a. a -> a
id

--------------------------------------------------------------------------------
--  Traversable
--------------------------------------------------------------------------------

{-|
Higher-ranked analogue of 'Traversable'.
-}
class (HFunctor h) => HTraversable h where
  {-# MINIMAL htraverse | hsequence #-}

  {-|
  Higher-ranked analogue of 'traverse'.
  -}
  htraverse
    :: (Applicative f)
    => (forall b. t b -> f (t' b)) -> h t a -> f (h t' a)
  htraverse forall (b :: u). t b -> f (t' b)
f = h (Compose f t') a -> f (h t' a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (a :: u).
(HTraversable h, Applicative f) =>
h (Compose f t) a -> f (h t a)
hsequence (h (Compose f t') a -> f (h t' a))
-> (h t a -> h (Compose f t') a) -> h t a -> f (h t' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: u). t b -> Compose f t' b)
-> h t a -> h (Compose f t') a
forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
hmap (f (t' b) -> Compose f t' b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (t' b) -> Compose f t' b)
-> (t b -> f (t' b)) -> t b -> Compose f t' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> f (t' b)
forall (b :: u). t b -> f (t' b)
f)

  {-|
  Higher-ranked analogue of 'sequenceA'.
  -}
  hsequence
    :: (Applicative f)
    => h (Compose f t) a -> f (h t a)
  hsequence = (forall (b :: u). Compose f t b -> f (t b))
-> h (Compose f t) a -> f (h t a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (b :: u). Compose f t b -> f (t b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

-- | An 'HTraversable' instance lets you do something similar to 'foldMap'. For
-- a more flexible operation, see 'hfoldMap'.
hfoldMapMonoid
  :: (HTraversable h, Monoid m)
  => (forall b. t b -> m) -> h t a -> m
hfoldMapMonoid :: (forall (b :: u). t b -> m) -> h t a -> m
hfoldMapMonoid forall (b :: u). t b -> m
f = Const m (h Any a) -> m
forall a k (b :: k). Const a b -> a
getConst (Const m (h Any a) -> m)
-> (h t a -> Const m (h Any a)) -> h t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: u). t b -> Const m (Any b))
-> h t a -> Const m (h Any a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse (m -> Const m (Any b)
forall k a (b :: k). a -> Const a b
Const (m -> Const m (Any b)) -> (t b -> m) -> t b -> Const m (Any b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> m
forall (b :: u). t b -> m
f)

hbindTraverse
  :: (HTraversable h, HMonad h, Applicative f)
  => (forall b. t b -> f (h t' b))
  -> h t a
  -> f (h t' a)
hbindTraverse :: (forall (b :: k). t b -> f (h t' b)) -> h t a -> f (h t' a)
hbindTraverse forall (b :: k). t b -> f (h t' b)
f = (h (h t') a -> h t' a) -> f (h (h t') a) -> f (h t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap h (h t') a -> h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
HBind h =>
h (h t) a -> h t a
hjoin (f (h (h t') a) -> f (h t' a))
-> (h t a -> f (h (h t') a)) -> h t a -> f (h t' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: k). t b -> f (h t' b)) -> h t a -> f (h (h t') a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (b :: k). t b -> f (h t' b)
f

--------------------------------------------------------------------------------
--  Binary Classes
--------------------------------------------------------------------------------

{-|
Higher-ranked analogue of 'Data.Bifunctor.Bifunctor'.
-}
class HBifunctor (h :: (k -> *) -> (k -> *) -> k -> *) where
  {-|
  Higher-ranked analogue of 'Data.Bifunctor.bimap'.
  -}
  hbimap :: (forall b. s b -> s' b)
         -> (forall b. t b -> t' b)
         -> h s t a
         -> h s' t' a
  hfirst :: (forall b. s b -> s' b) -> h s t a -> h s' t a
  hsecond :: (forall b. t b -> t' b) -> h s t a -> h s t' a

  default hbimap
    :: (HBitraversable h)
    => (forall b. s b -> s' b)
    -> (forall b. t b -> t' b)
    -> h s t a
    -> h s' t' a
  hbimap forall (b :: k). s b -> s' b
f forall (b :: k). t b -> t' b
g = Identity (h s' t' a) -> h s' t' a
forall a. Identity a -> a
runIdentity (Identity (h s' t' a) -> h s' t' a)
-> (h s t a -> Identity (h s' t' a)) -> h s t a -> h s' t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: k). s b -> Identity (s' b))
-> (forall (b :: k). t b -> Identity (t' b))
-> h s t a
-> Identity (h s' t' a)
forall k (h :: (k -> *) -> (k -> *) -> k -> *) (f :: * -> *)
       (s :: k -> *) (s' :: k -> *) (t :: k -> *) (t' :: k -> *) (a :: k).
(HBitraversable h, Applicative f) =>
(forall (b :: k). s b -> f (s' b))
-> (forall (b :: k). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hbitraverse (s' b -> Identity (s' b)
forall a. a -> Identity a
Identity (s' b -> Identity (s' b))
-> (s b -> s' b) -> s b -> Identity (s' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s b -> s' b
forall (b :: k). s b -> s' b
f) (t' b -> Identity (t' b)
forall a. a -> Identity a
Identity (t' b -> Identity (t' b))
-> (t b -> t' b) -> t b -> Identity (t' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> t' b
forall (b :: k). t b -> t' b
g)

  hfirst forall (b :: k). s b -> s' b
f = (forall (b :: k). s b -> s' b)
-> (forall (b :: k). t b -> t b) -> h s t a -> h s' t a
forall k (h :: (k -> *) -> (k -> *) -> k -> *) (s :: k -> *)
       (s' :: k -> *) (t :: k -> *) (t' :: k -> *) (a :: k).
HBifunctor h =>
(forall (b :: k). s b -> s' b)
-> (forall (b :: k). t b -> t' b) -> h s t a -> h s' t' a
hbimap forall (b :: k). s b -> s' b
f forall (b :: k). t b -> t b
forall a. a -> a
id
  hsecond = (forall (b :: k). s b -> s b)
-> (forall (b :: k). t b -> t' b) -> h s t a -> h s t' a
forall k (h :: (k -> *) -> (k -> *) -> k -> *) (s :: k -> *)
       (s' :: k -> *) (t :: k -> *) (t' :: k -> *) (a :: k).
HBifunctor h =>
(forall (b :: k). s b -> s' b)
-> (forall (b :: k). t b -> t' b) -> h s t a -> h s' t' a
hbimap forall (b :: k). s b -> s b
forall a. a -> a
id

class (HBifunctor h) => HBitraversable h where
  hbitraverse
    :: (Applicative f)
    => (forall b. s b -> f (s' b))
    -> (forall b. t b -> f (t' b))
    -> h s t a -> f (h s' t' a)

hbifoldMapMonoid
  :: (Monoid m, HBitraversable h)
  => (forall b. s b -> m) -> (forall b. t b -> m) -> h s t a -> m
hbifoldMapMonoid :: (forall (b :: k). s b -> m)
-> (forall (b :: k). t b -> m) -> h s t a -> m
hbifoldMapMonoid forall (b :: k). s b -> m
f forall (b :: k). t b -> m
g = Const m (h Any Any a) -> m
forall a k (b :: k). Const a b -> a
getConst (Const m (h Any Any a) -> m)
-> (h s t a -> Const m (h Any Any a)) -> h s t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: k). s b -> Const m (Any b))
-> (forall (b :: k). t b -> Const m (Any b))
-> h s t a
-> Const m (h Any Any a)
forall k (h :: (k -> *) -> (k -> *) -> k -> *) (f :: * -> *)
       (s :: k -> *) (s' :: k -> *) (t :: k -> *) (t' :: k -> *) (a :: k).
(HBitraversable h, Applicative f) =>
(forall (b :: k). s b -> f (s' b))
-> (forall (b :: k). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hbitraverse (m -> Const m (Any b)
forall k a (b :: k). a -> Const a b
Const (m -> Const m (Any b)) -> (s b -> m) -> s b -> Const m (Any b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s b -> m
forall (b :: k). s b -> m
f) (m -> Const m (Any b)
forall k a (b :: k). a -> Const a b
Const (m -> Const m (Any b)) -> (t b -> m) -> t b -> Const m (Any b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> m
forall (b :: k). t b -> m
g)

--------------------------------------------------------------------------------
--  (Even) Higher-Ranked Binary Classes
--------------------------------------------------------------------------------

class HDuofunctor (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *) where
  hduomap
    :: (forall g g' b. (forall c. g c -> g' c) -> s g b -> s' g' b)
    -> (forall b. t b -> t' b)
    -> h s t a
    -> h s' t' a

  default hduomap
    :: (HDuotraversable h)
    => (forall g g' b. (forall c. g c -> g' c) -> s g b -> s' g' b)
    -> (forall b. t b -> t' b)
    -> h s t a
    -> h s' t' a
  hduomap forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s' g' b
f forall (b :: u). t b -> t' b
g =
    Identity (h s' t' a) -> h s' t' a
forall a. Identity a -> a
runIdentity (Identity (h s' t' a) -> h s' t' a)
-> (h s t a -> Identity (h s' t' a)) -> h s t a -> h s' t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> Identity (g' c))
 -> s g b -> Identity (s' g' b))
-> (forall (b :: u). t b -> Identity (t' b))
-> h s t a
-> Identity (h s' t' a)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (f :: * -> *) (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *)
       (t :: u -> *) (t' :: u -> *) (a :: u).
(HDuotraversable h, Applicative f) =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hduotraverse (\forall (c :: u). g c -> Identity (g' c)
h -> s' g' b -> Identity (s' g' b)
forall a. a -> Identity a
Identity (s' g' b -> Identity (s' g' b))
-> (s g b -> s' g' b) -> s g b -> Identity (s' g' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (c :: u). g c -> g' c) -> s g b -> s' g' b
forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s' g' b
f (Identity (g' c) -> g' c
forall a. Identity a -> a
runIdentity (Identity (g' c) -> g' c)
-> (g c -> Identity (g' c)) -> g c -> g' c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g c -> Identity (g' c)
forall (c :: u). g c -> Identity (g' c)
h)) (t' b -> Identity (t' b)
forall a. a -> Identity a
Identity (t' b -> Identity (t' b))
-> (t b -> t' b) -> t b -> Identity (t' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> t' b
forall (b :: u). t b -> t' b
g)

hduomapFirst
  :: HDuofunctor h
  => (forall g g' b. (forall c. g c -> g' c) -> s g b -> s' g' b)
  -> h s t a
  -> h s' t a
hduomapFirst :: (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> h s t a -> h s' t a
hduomapFirst forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s' g' b
f = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> (forall (b :: u). t b -> t b) -> h s t a -> h s' t a
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
HDuofunctor h =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> (forall (b :: u). t b -> t' b) -> h s t a -> h s' t' a
hduomap forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s' g' b
f forall (b :: u). t b -> t b
forall a. a -> a
id

hduomapFirst'
  :: (HDuofunctor h, HFunctor s)
  => (forall g b. s g b -> s' g b) -> h s t a -> h s' t a
hduomapFirst' :: (forall (g :: u -> *) (b :: u). s g b -> s' g b)
-> h s t a -> h s' t a
hduomapFirst' forall (g :: u -> *) (b :: u). s g b -> s' g b
f = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> h s t a -> h s' t a
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *) (t :: u -> *)
       (a :: u).
HDuofunctor h =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> h s t a -> h s' t a
hduomapFirst (\forall (c :: u). g c -> g' c
g -> s g' b -> s' g' b
forall (g :: u -> *) (b :: u). s g b -> s' g b
f (s g' b -> s' g' b) -> (s g b -> s g' b) -> s g b -> s' g' b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (c :: u). g c -> g' c) -> s g b -> s g' b
forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
hmap forall (c :: u). g c -> g' c
g)

hduomapSecond
  :: (HDuofunctor h, HFunctor s)
  => (forall b. t b -> t' b) -> h s t a -> h s t' a
hduomapSecond :: (forall (b :: u). t b -> t' b) -> h s t a -> h s t' a
hduomapSecond = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s g' b)
-> (forall (b :: u). t b -> t' b) -> h s t a -> h s t' a
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
HDuofunctor h =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> (forall (b :: u). t b -> t' b) -> h s t a -> h s' t' a
hduomap forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s g' b
hmap

class HDuofunctor h => HDuotraversable h where
  hduotraverse
    :: (Applicative f)
    => (forall g g' b. (forall c. g c -> f (g' c)) -> s g b -> f (s' g' b))
    -> (forall b. t b -> f (t' b))
    -> h s t a
    -> f (h s' t' a)

hduotraverseFirst
  :: (HDuotraversable h, Applicative f)
  => (forall g g' b. (forall c. g c -> f (g' c)) -> s g b -> f (s' g' b))
  -> h s t a
  -> f (h s' t a)
hduotraverseFirst :: (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> h s t a -> f (h s' t a)
hduotraverseFirst forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b)
f = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t b)) -> h s t a -> f (h s' t a)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (f :: * -> *) (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *)
       (t :: u -> *) (t' :: u -> *) (a :: u).
(HDuotraversable h, Applicative f) =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hduotraverse forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b)
f forall (b :: u). t b -> f (t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

hduotraverseFirst'
  :: (HDuotraversable h, HTraversable s, Monad f)
  => (forall g b. s g b -> f (s' g b)) -> h s t a -> f (h s' t a)
hduotraverseFirst' :: (forall (g :: u -> *) (b :: u). s g b -> f (s' g b))
-> h s t a -> f (h s' t a)
hduotraverseFirst' forall (g :: u -> *) (b :: u). s g b -> f (s' g b)
f = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> h s t a -> f (h s' t a)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (f :: * -> *) (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *)
       (t :: u -> *) (a :: u).
(HDuotraversable h, Applicative f) =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> h s t a -> f (h s' t a)
hduotraverseFirst (\forall (c :: u). g c -> f (g' c)
g -> s g' b -> f (s' g' b)
forall (g :: u -> *) (b :: u). s g b -> f (s' g b)
f (s g' b -> f (s' g' b))
-> (s g b -> f (s g' b)) -> s g b -> f (s' g' b)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s g' b)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (c :: u). g c -> f (g' c)
g)

hduotraverseSecond
  :: (HDuotraversable h, HTraversable s, Applicative f)
  => (forall b. t b -> f (t' b)) -> h s t a -> f (h s t' a)
hduotraverseSecond :: (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s t' a)
hduotraverseSecond = (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s g' b))
-> (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s t' a)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (f :: * -> *) (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *)
       (t :: u -> *) (t' :: u -> *) (a :: u).
(HDuotraversable h, Applicative f) =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hduotraverse forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s g' b)
htraverse

--------------------------------------------------------------------------------
--  Folding
--------------------------------------------------------------------------------

{-|
This is a more flexible, higher-ranked version of 'Foldable'. While 'Foldable'
only allows you to fold into a 'Monoid', 'HFoldable' allows you to fold into
some arbitrary type constructor @k@. This means that the instance can take
advantage of additional structure inside @k@ and @h@, to combine internal
results in different ways, rather than just the 'mappend' available to
'foldMap'.

Notice that if you have

@
instance ('Monoid' m) => 'HFoldableAt' ('Const' m) h
@

then 'hfoldMap' behaves very much like regular 'foldMap'.
-}
class HFoldableAt k h where
  hfoldMap :: (forall b. t b -> k b) -> h t a -> k a

{-|
For 'HFunctor's, provides an implementation of 'hfoldMap' in terms of a simple
'hfold'-like function.
-}
implHfoldMap
  :: (HFunctor h)
  => (h k a -> k a)
  -> (forall b. t b -> k b) -> h t a -> k a
implHfoldMap :: (h k a -> k a) -> (forall (b :: u). t b -> k b) -> h t a -> k a
implHfoldMap h k a -> k a
g forall (b :: u). t b -> k b
f = h k a -> k a
g (h k a -> k a) -> (h t a -> h k a) -> h t a -> k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: u). t b -> k b) -> h t a -> h k a
forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
hmap forall (b :: u). t b -> k b
f

-- | A helper function for implementing instances with the general form @'Monad'
-- m => 'HFoldableAt' ('Compose' m t) h@. I.e. folding that requires a monadic
-- context of some kind.
implHfoldMapCompose
  :: (HTraversable h, Monad m)
  => (h k a -> m (k a))
  -> (forall b. t b -> Compose m k b) -> h t a -> Compose m k a
implHfoldMapCompose :: (h k a -> m (k a))
-> (forall (b :: k1). t b -> Compose m k b)
-> h t a
-> Compose m k a
implHfoldMapCompose h k a -> m (k a)
f = (h (Compose m k) a -> Compose m k a)
-> (forall (b :: k1). t b -> Compose m k b)
-> h t a
-> Compose m k a
forall u (h :: (u -> *) -> u -> *) (k :: u -> *) (a :: u)
       (t :: u -> *).
HFunctor h =>
(h k a -> k a) -> (forall (b :: u). t b -> k b) -> h t a -> k a
implHfoldMap (m (k a) -> Compose m k a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (k a) -> Compose m k a)
-> (h (Compose m k) a -> m (k a))
-> h (Compose m k) a
-> Compose m k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall (b :: k1). Compose m k b -> m (k b))
-> h (Compose m k) a -> m (h k a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (b :: k1). Compose m k b -> m (k b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (h (Compose m k) a -> m (h k a))
-> (h k a -> m (k a)) -> h (Compose m k) a -> m (k a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> h k a -> m (k a)
f))


{-|
Higher-ranked equivalent of 'Data.Foldable.fold'.
-}
hfold :: HFoldableAt t h => h t a -> t a
hfold :: h t a -> t a
hfold = (forall (b :: k). t b -> t b) -> h t a -> t a
forall k (k :: k -> *) (h :: (k -> *) -> k -> *) (t :: k -> *)
       (a :: k).
HFoldableAt k h =>
(forall (b :: k). t b -> k b) -> h t a -> k a
hfoldMap forall (b :: k). t b -> t b
forall a. a -> a
id


-- | Fold in an applicative context.
hfoldA :: (HFoldableAt (Compose f t) h, Applicative f) => h t a -> f (t a)
hfoldA :: h t a -> f (t a)
hfoldA = (forall (b :: k). t b -> f (t b)) -> h t a -> f (t a)
forall k (f :: * -> *) (k :: k -> *) (h :: (k -> *) -> k -> *)
       (t :: k -> *) (a :: k).
(HFoldableAt (Compose f k) h, Applicative f) =>
(forall (b :: k). t b -> f (k b)) -> h t a -> f (k a)
hfoldMapA forall (b :: k). t b -> f (t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Fold in an applicative context.
hfoldMapA :: (HFoldableAt (Compose f k) h, Applicative f) => (forall b. t b -> f (k b)) -> h t a -> f (k a)
hfoldMapA :: (forall (b :: k). t b -> f (k b)) -> h t a -> f (k a)
hfoldMapA forall (b :: k). t b -> f (k b)
f = Compose f k a -> f (k a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f k a -> f (k a))
-> (h t a -> Compose f k a) -> h t a -> f (k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: k). t b -> Compose f k b) -> h t a -> Compose f k a
forall k (k :: k -> *) (h :: (k -> *) -> k -> *) (t :: k -> *)
       (a :: k).
HFoldableAt k h =>
(forall (b :: k). t b -> k b) -> h t a -> k a
hfoldMap (f (k b) -> Compose f k b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (k b) -> Compose f k b)
-> (t b -> f (k b)) -> t b -> Compose f k b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t b -> f (k b)
forall (b :: k). t b -> f (k b)
f)


-- | 'hfoldTraverse' is to 'hfoldMap' as 'htraverse' is to 'hmap'.
hfoldTraverse
  :: (HFoldableAt k h, HTraversable h, Applicative f)
  => (forall b. t b -> f (k b))
  -> h t a
  -> f (k a)
hfoldTraverse :: (forall (b :: u). t b -> f (k b)) -> h t a -> f (k a)
hfoldTraverse forall (b :: u). t b -> f (k b)
f = (h k a -> k a) -> f (h k a) -> f (k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap h k a -> k a
forall k (t :: k -> *) (h :: (k -> *) -> k -> *) (a :: k).
HFoldableAt t h =>
h t a -> t a
hfold (f (h k a) -> f (k a)) -> (h t a -> f (h k a)) -> h t a -> f (k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: u). t b -> f (k b)) -> h t a -> f (h k a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (b :: u). t b -> f (k b)
f


class HBifoldableAt k h where
  hbifoldMap :: (forall b. f b -> k b) -> (forall b. g b -> k b) -> h f g a -> k a

hbifold :: (HBifoldableAt k h) => h k k a -> k a
hbifold :: h k k a -> k a
hbifold = (forall (b :: k). k b -> k b)
-> (forall (b :: k). k b -> k b) -> h k k a -> k a
forall k (k :: k -> *) (h :: (k -> *) -> (k -> *) -> k -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
HBifoldableAt k h =>
(forall (b :: k). f b -> k b)
-> (forall (b :: k). g b -> k b) -> h f g a -> k a
hbifoldMap forall (b :: k). k b -> k b
forall a. a -> a
id forall (b :: k). k b -> k b
forall a. a -> a
id


class HDuofoldableAt k h where
  hduofoldMap
    :: (HTraversable s)
    => (forall g b. (forall c. g c -> k c) -> s g b -> k b)
    -> (forall b. t b -> k b)
    -> h s t a
    -> k a


implHduofoldMap
  :: (HDuofunctor h, HFunctor s)
  => ((forall g b. (forall c. g c -> k c) -> s g b -> k b) -> h s k a -> k a)
  -> (forall g b. (forall c. g c -> k c) -> s g b -> k b)
  -> (forall b. t b -> k b)
  -> h s t a
  -> k a
implHduofoldMap :: ((forall (g :: u -> *) (b :: u).
  (forall (c :: u). g c -> k c) -> s g b -> k b)
 -> h s k a -> k a)
-> (forall (g :: u -> *) (b :: u).
    (forall (c :: u). g c -> k c) -> s g b -> k b)
-> (forall (b :: u). t b -> k b)
-> h s t a
-> k a
implHduofoldMap (forall (g :: u -> *) (b :: u).
 (forall (c :: u). g c -> k c) -> s g b -> k b)
-> h s k a -> k a
h forall (g :: u -> *) (b :: u).
(forall (c :: u). g c -> k c) -> s g b -> k b
f forall (b :: u). t b -> k b
g = (forall (g :: u -> *) (b :: u).
 (forall (c :: u). g c -> k c) -> s g b -> k b)
-> h s k a -> k a
h forall (g :: u -> *) (b :: u).
(forall (c :: u). g c -> k c) -> s g b -> k b
f (h s k a -> k a) -> (h s t a -> h s k a) -> h s t a -> k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s g' b)
-> (forall (b :: u). t b -> k b) -> h s t a -> h s k a
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
HDuofunctor h =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> g' c) -> s g b -> s' g' b)
-> (forall (b :: u). t b -> t' b) -> h s t a -> h s' t' a
hduomap forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> g' c) -> s g b -> s g' b
hmap forall (b :: u). t b -> k b
g


implHduofoldMapCompose
  :: (HDuotraversable h, HTraversable s, Monad m)
  => ((forall g b. (forall c. g c -> m (k c)) -> s g b -> m (k b)) -> h s k a -> m (k a))
  -> (forall g b. (forall c. g c -> Compose m k c) -> s g b -> Compose m k b)
  -> (forall b. t b -> Compose m k b)
  -> h s t a
  -> Compose m k a
implHduofoldMapCompose :: ((forall (g :: k1 -> *) (b :: k1).
  (forall (c :: k1). g c -> m (k c)) -> s g b -> m (k b))
 -> h s k a -> m (k a))
-> (forall (g :: k1 -> *) (b :: k1).
    (forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b)
-> (forall (b :: k1). t b -> Compose m k b)
-> h s t a
-> Compose m k a
implHduofoldMapCompose (forall (g :: k1 -> *) (b :: k1).
 (forall (c :: k1). g c -> m (k c)) -> s g b -> m (k b))
-> h s k a -> m (k a)
f =
  ((forall (g :: k1 -> *) (b :: k1).
  (forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b)
 -> h s (Compose m k) a -> Compose m k a)
-> (forall (g :: k1 -> *) (b :: k1).
    (forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b)
-> (forall (b :: k1). t b -> Compose m k b)
-> h s t a
-> Compose m k a
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (k :: u -> *) (a :: u) (t :: u -> *).
(HDuofunctor h, HFunctor s) =>
((forall (g :: u -> *) (b :: u).
  (forall (c :: u). g c -> k c) -> s g b -> k b)
 -> h s k a -> k a)
-> (forall (g :: u -> *) (b :: u).
    (forall (c :: u). g c -> k c) -> s g b -> k b)
-> (forall (b :: u). t b -> k b)
-> h s t a
-> k a
implHduofoldMap
    (\forall (g :: k1 -> *) (b :: k1).
(forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b
g ->
       m (k a) -> Compose m k a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (k a) -> Compose m k a)
-> (h s (Compose m k) a -> m (k a))
-> h s (Compose m k) a
-> Compose m k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       ((forall (b :: k1). Compose m k b -> m (k b))
-> h s (Compose m k) a -> m (h s k a)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (s :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HDuotraversable h, HTraversable s, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s t' a)
hduotraverseSecond forall (b :: k1). Compose m k b -> m (k b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (h s (Compose m k) a -> m (h s k a))
-> (h s k a -> m (k a)) -> h s (Compose m k) a -> m (k a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
        (forall (g :: k1 -> *) (b :: k1).
 (forall (c :: k1). g c -> m (k c)) -> s g b -> m (k b))
-> h s k a -> m (k a)
f (\forall (c :: k1). g c -> m (k c)
h -> Compose m k b -> m (k b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose m k b -> m (k b))
-> (s g b -> Compose m k b) -> s g b -> m (k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b
forall (g :: k1 -> *) (b :: k1).
(forall (c :: k1). g c -> Compose m k c) -> s g b -> Compose m k b
g (m (k c) -> Compose m k c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (k c) -> Compose m k c)
-> (g c -> m (k c)) -> g c -> Compose m k c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g c -> m (k c)
forall (c :: k1). g c -> m (k c)
h))))

--------------------------------------------------------------------------------
--  Free Monads
--------------------------------------------------------------------------------

{-|
@'HFree' h@ is a higher-ranked free monad over the higher-ranked functor @h@.
That means that given @'HFunctor' h@, we get @'HMonad' ('HFree' h)@ for free.
-}
data HFree h t a
  = HPure (t a)
  | HWrap (h (HFree h t) a)
  deriving (Typeable)

instance HFunctor h => HFunctor (HFree h) where
  hmap :: (forall (b :: u). t b -> t' b) -> HFree h t a -> HFree h t' a
hmap = (forall (b :: u). t b -> t' b) -> HFree h t a -> HFree h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (t' :: k -> *)
       (a :: k).
(HPointed h, HBind h) =>
(forall (b :: k). t b -> t' b) -> h t a -> h t' a
hliftM

instance HPointed (HFree h) where
  hpure :: t a -> HFree h t a
hpure = t a -> HFree h t a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
t a -> HFree h t a
HPure

instance HFunctor h => HBind (HFree h) where
  HPure t a
x ^>>= :: HFree h t a
-> (forall (b :: k). t b -> HFree h t' b) -> HFree h t' a
^>>= forall (b :: k). t b -> HFree h t' b
f = t a -> HFree h t' a
forall (b :: k). t b -> HFree h t' b
f t a
x
  HWrap h (HFree h t) a
x ^>>= forall (b :: k). t b -> HFree h t' b
f = h (HFree h t') a -> HFree h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
h (HFree h t) a -> HFree h t a
HWrap ((forall (b :: k). HFree h t b -> HFree h t' b)
-> h (HFree h t) a -> h (HFree h t') a
forall u (h :: (u -> *) -> u -> *) (t :: u -> *) (t' :: u -> *)
       (a :: u).
HFunctor h =>
(forall (b :: u). t b -> t' b) -> h t a -> h t' a
hmap (HFree h t b
-> (forall (b :: k). t b -> HFree h t' b) -> HFree h t' b
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k)
       (t' :: k -> *).
HBind h =>
h t a -> (forall (b :: k). t b -> h t' b) -> h t' a
^>>= forall (b :: k). t b -> HFree h t' b
f) h (HFree h t) a
x)

instance HFunctor h => HMonad (HFree h)


instance (HFoldableAt k h) => HFoldableAt k (HFree h) where
  hfoldMap :: (forall (b :: k). t b -> k b) -> HFree h t a -> k a
hfoldMap forall (b :: k). t b -> k b
f = \case
    HPure t a
x -> t a -> k a
forall (b :: k). t b -> k b
f t a
x
    HWrap h (HFree h t) a
x -> (forall (b :: k). HFree h t b -> k b) -> h (HFree h t) a -> k a
forall k (k :: k -> *) (h :: (k -> *) -> k -> *) (t :: k -> *)
       (a :: k).
HFoldableAt k h =>
(forall (b :: k). t b -> k b) -> h t a -> k a
hfoldMap ((forall (b :: k). t b -> k b) -> HFree h t b -> k b
forall k (k :: k -> *) (h :: (k -> *) -> k -> *) (t :: k -> *)
       (a :: k).
HFoldableAt k h =>
(forall (b :: k). t b -> k b) -> h t a -> k a
hfoldMap forall (b :: k). t b -> k b
f) h (HFree h t) a
x


instance HDuofoldableAt k HFree where
  hduofoldMap :: (forall (g :: k -> *) (b :: k).
 (forall (c :: k). g c -> k c) -> s g b -> k b)
-> (forall (b :: k). t b -> k b) -> HFree s t a -> k a
hduofoldMap forall (g :: k -> *) (b :: k).
(forall (c :: k). g c -> k c) -> s g b -> k b
g forall (b :: k). t b -> k b
f = \case
    HPure t a
x -> t a -> k a
forall (b :: k). t b -> k b
f t a
x
    HWrap s (HFree s t) a
x -> (forall (c :: k). HFree s t c -> k c) -> s (HFree s t) a -> k a
forall (g :: k -> *) (b :: k).
(forall (c :: k). g c -> k c) -> s g b -> k b
g ((forall (g :: k -> *) (b :: k).
 (forall (c :: k). g c -> k c) -> s g b -> k b)
-> (forall (b :: k). t b -> k b) -> HFree s t c -> k c
forall k (k :: k -> *)
       (h :: ((k -> *) -> k -> *) -> (k -> *) -> k -> *)
       (s :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
(HDuofoldableAt k h, HTraversable s) =>
(forall (g :: k -> *) (b :: k).
 (forall (c :: k). g c -> k c) -> s g b -> k b)
-> (forall (b :: k). t b -> k b) -> h s t a -> k a
hduofoldMap forall (g :: k -> *) (b :: k).
(forall (c :: k). g c -> k c) -> s g b -> k b
g forall (b :: k). t b -> k b
f) s (HFree s t) a
x


instance HTraversable h => HTraversable (HFree h) where
  htraverse :: (forall (b :: u). t b -> f (t' b))
-> HFree h t a -> f (HFree h t' a)
htraverse forall (b :: u). t b -> f (t' b)
f = \case
    HPure t a
x -> t' a -> HFree h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
t a -> HFree h t a
HPure (t' a -> HFree h t' a) -> f (t' a) -> f (HFree h t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f t a
x
    HWrap h (HFree h t) a
x -> h (HFree h t') a -> HFree h t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
h (HFree h t) a -> HFree h t a
HWrap (h (HFree h t') a -> HFree h t' a)
-> f (h (HFree h t') a) -> f (HFree h t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (b :: u). HFree h t b -> f (HFree h t' b))
-> h (HFree h t) a -> f (h (HFree h t') a)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse ((forall (b :: u). t b -> f (t' b))
-> HFree h t b -> f (HFree h t' b)
forall u (h :: (u -> *) -> u -> *) (f :: * -> *) (t :: u -> *)
       (t' :: u -> *) (a :: u).
(HTraversable h, Applicative f) =>
(forall (b :: u). t b -> f (t' b)) -> h t a -> f (h t' a)
htraverse forall (b :: u). t b -> f (t' b)
f) h (HFree h t) a
x


instance HDuofunctor HFree
instance HDuotraversable HFree where
  hduotraverse :: (forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b))
-> HFree s t a
-> f (HFree s' t' a)
hduotraverse forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b)
g forall (b :: u). t b -> f (t' b)
f = \case
    HPure t a
x -> t' a -> HFree s' t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
t a -> HFree h t a
HPure (t' a -> HFree s' t' a) -> f (t' a) -> f (HFree s' t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f t a
x
    HWrap s (HFree s t) a
x -> s' (HFree s' t') a -> HFree s' t' a
forall k (h :: (k -> *) -> k -> *) (t :: k -> *) (a :: k).
h (HFree h t) a -> HFree h t a
HWrap (s' (HFree s' t') a -> HFree s' t' a)
-> f (s' (HFree s' t') a) -> f (HFree s' t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (c :: u). HFree s t c -> f (HFree s' t' c))
-> s (HFree s t) a -> f (s' (HFree s' t') a)
forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b)
g ((forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b))
-> HFree s t c
-> f (HFree s' t' c)
forall u (h :: ((u -> *) -> u -> *) -> (u -> *) -> u -> *)
       (f :: * -> *) (s :: (u -> *) -> u -> *) (s' :: (u -> *) -> u -> *)
       (t :: u -> *) (t' :: u -> *) (a :: u).
(HDuotraversable h, Applicative f) =>
(forall (g :: u -> *) (g' :: u -> *) (b :: u).
 (forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b))
-> (forall (b :: u). t b -> f (t' b)) -> h s t a -> f (h s' t' a)
hduotraverse forall (g :: u -> *) (g' :: u -> *) (b :: u).
(forall (c :: u). g c -> f (g' c)) -> s g b -> f (s' g' b)
g forall (b :: u). t b -> f (t' b)
f) s (HFree s t) a
x

--------------------------------------------------------------------------------
--  Higher-ranked instances for standard functors
--------------------------------------------------------------------------------

--  'Compose' lifts a regular 'Functor'/'Monad'/etc into the higher-ranked
--  version

instance (Functor f) => HFunctor (Compose f) where
  hmap :: (forall (b :: u). t b -> t' b) -> Compose f t a -> Compose f t' a
hmap forall (b :: u). t b -> t' b
f = f (t' a) -> Compose f t' a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (t' a) -> Compose f t' a)
-> (Compose f t a -> f (t' a)) -> Compose f t a -> Compose f t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> t' a) -> f (t a) -> f (t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t a -> t' a
forall (b :: u). t b -> t' b
f (f (t a) -> f (t' a))
-> (Compose f t a -> f (t a)) -> Compose f t a -> f (t' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f t a -> f (t a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

instance (Applicative f) => HPointed (Compose f) where
  hpure :: t a -> Compose f t a
hpure = f (t a) -> Compose f t a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (t a) -> Compose f t a)
-> (t a -> f (t a)) -> t a -> Compose f t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> f (t a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance (Monad f) => HBind (Compose f) where
  Compose f (t a)
x ^>>= :: Compose f t a
-> (forall (b :: k). t b -> Compose f t' b) -> Compose f t' a
^>>= forall (b :: k). t b -> Compose f t' b
f = f (t' a) -> Compose f t' a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (t a)
x f (t a) -> (t a -> f (t' a)) -> f (t' a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Compose f t' a -> f (t' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose f t' a -> f (t' a))
-> (t a -> Compose f t' a) -> t a -> f (t' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Compose f t' a
forall (b :: k). t b -> Compose f t' b
f)

instance (Traversable f) => HTraversable (Compose f) where
  htraverse :: (forall (b :: u). t b -> f (t' b))
-> Compose f t a -> f (Compose f t' a)
htraverse forall (b :: u). t b -> f (t' b)
f = (f (t' a) -> Compose f t' a) -> f (f (t' a)) -> f (Compose f t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (t' a) -> Compose f t' a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f (t' a)) -> f (Compose f t' a))
-> (Compose f t a -> f (f (t' a)))
-> Compose f t a
-> f (Compose f t' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> f (t' a)) -> f (t a) -> f (f (t' a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f (f (t a) -> f (f (t' a)))
-> (Compose f t a -> f (t a)) -> Compose f t a -> f (f (t' a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f t a -> f (t a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose

-- | e.g. @('Monoid' m, 'Foldable' f) => 'HFoldableAt' ('Const' m) ('Compose' f)@
instance (Alternative g, Foldable f) => HFoldableAt g (Compose f) where
  hfoldMap :: (forall b. t b -> g b) -> Compose f t a -> g a
hfoldMap forall b. t b -> g b
f = Alt g a -> g a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt g a -> g a)
-> (Compose f t a -> Alt g a) -> Compose f t a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> Alt g a) -> f (t a) -> Alt g a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (g a -> Alt g a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (g a -> Alt g a) -> (t a -> g a) -> t a -> Alt g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> g a
forall b. t b -> g b
f) (f (t a) -> Alt g a)
-> (Compose f t a -> f (t a)) -> Compose f t a -> Alt g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f t a -> f (t a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose


--------------------------------------------------------------------------------
-- 'Product'

instance HFunctor (Product f)
instance HTraversable (Product f) where
  htraverse :: (forall (b :: u). t b -> f (t' b))
-> Product f t a -> f (Product f t' a)
htraverse forall (b :: u). t b -> f (t' b)
f (Pair f a
x t a
y) = f a -> t' a -> Product f t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
x (t' a -> Product f t' a) -> f (t' a) -> f (Product f t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f t a
y

instance HBifunctor Product
instance HBitraversable Product where
  hbitraverse :: (forall (b :: k). s b -> f (s' b))
-> (forall (b :: k). t b -> f (t' b))
-> Product s t a
-> f (Product s' t' a)
hbitraverse forall (b :: k). s b -> f (s' b)
f forall (b :: k). t b -> f (t' b)
g (Pair s a
x t a
y) = s' a -> t' a -> Product s' t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (s' a -> t' a -> Product s' t' a)
-> f (s' a) -> f (t' a -> Product s' t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s a -> f (s' a)
forall (b :: k). s b -> f (s' b)
f s a
x f (t' a -> Product s' t' a) -> f (t' a) -> f (Product s' t' a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> t a -> f (t' a)
forall (b :: k). t b -> f (t' b)
g t a
y

instance (Alternative k) => HBifoldableAt k Product where
  hbifoldMap :: (forall b. f b -> k b)
-> (forall b. g b -> k b) -> Product f g a -> k a
hbifoldMap forall b. f b -> k b
f forall b. g b -> k b
g (Pair f a
x g a
y) = f a -> k a
forall b. f b -> k b
f f a
x k a -> k a -> k a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> g a -> k a
forall b. g b -> k b
g g a
y

instance (Alternative k) => HFoldableAt k (Product k) where
  hfoldMap :: (forall b. t b -> k b) -> Product k t a -> k a
hfoldMap = (forall b. k b -> k b)
-> (forall b. t b -> k b) -> Product k t a -> k a
forall k (k :: k -> *) (h :: (k -> *) -> (k -> *) -> k -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
HBifoldableAt k h =>
(forall (b :: k). f b -> k b)
-> (forall (b :: k). g b -> k b) -> h f g a -> k a
hbifoldMap forall a. a -> a
forall b. k b -> k b
id

--------------------------------------------------------------------------------
-- 'Reverse' (note there's nothing for the instances to reverse)

instance HFunctor Reverse
instance HTraversable Reverse where
  htraverse :: (forall (b :: u). t b -> f (t' b))
-> Reverse t a -> f (Reverse t' a)
htraverse forall (b :: u). t b -> f (t' b)
f (Reverse t a
x) = t' a -> Reverse t' a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse (t' a -> Reverse t' a) -> f (t' a) -> f (Reverse t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f t a
x

instance HPointed Reverse where
  hpure :: t a -> Reverse t a
hpure = t a -> Reverse t a
forall k (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse

instance HBind Reverse where
  Reverse t a
x ^>>= :: Reverse t a
-> (forall (b :: k). t b -> Reverse t' b) -> Reverse t' a
^>>= forall (b :: k). t b -> Reverse t' b
f = t a -> Reverse t' a
forall (b :: k). t b -> Reverse t' b
f t a
x

instance HMonad Reverse

instance HFoldableAt k Reverse where
  hfoldMap :: (forall (b :: k). t b -> k b) -> Reverse t a -> k a
hfoldMap forall (b :: k). t b -> k b
f (Reverse t a
x) = t a -> k a
forall (b :: k). t b -> k b
f t a
x

--------------------------------------------------------------------------------
-- 'Sum'

instance HFunctor (Sum f)
instance HTraversable (Sum f) where
  htraverse :: (forall (b :: u). t b -> f (t' b)) -> Sum f t a -> f (Sum f t' a)
htraverse forall (b :: u). t b -> f (t' b)
_ (InL f a
x) = Sum f t' a -> f (Sum f t' a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> Sum f t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f a
x)
  htraverse forall (b :: u). t b -> f (t' b)
f (InR t a
y) = t' a -> Sum f t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (t' a -> Sum f t' a) -> f (t' a) -> f (Sum f t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: u). t b -> f (t' b)
f t a
y

instance HBifunctor Sum
instance HBitraversable Sum where
  hbitraverse :: (forall (b :: k). s b -> f (s' b))
-> (forall (b :: k). t b -> f (t' b))
-> Sum s t a
-> f (Sum s' t' a)
hbitraverse forall (b :: k). s b -> f (s' b)
f forall (b :: k). t b -> f (t' b)
_ (InL s a
x) = s' a -> Sum s' t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (s' a -> Sum s' t' a) -> f (s' a) -> f (Sum s' t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s a -> f (s' a)
forall (b :: k). s b -> f (s' b)
f s a
x
  hbitraverse forall (b :: k). s b -> f (s' b)
_ forall (b :: k). t b -> f (t' b)
g (InR t a
y) = t' a -> Sum s' t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (t' a -> Sum s' t' a) -> f (t' a) -> f (Sum s' t' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> f (t' a)
forall (b :: k). t b -> f (t' b)
g t a
y

instance HPointed (Sum f) where
  hpure :: t a -> Sum f t a
hpure = t a -> Sum f t a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR

instance HBind (Sum f) where
  InL f a
x ^>>= :: Sum f t a -> (forall (b :: k). t b -> Sum f t' b) -> Sum f t' a
^>>= forall (b :: k). t b -> Sum f t' b
_ = f a -> Sum f t' a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL f a
x
  InR t a
y ^>>= forall (b :: k). t b -> Sum f t' b
f = t a -> Sum f t' a
forall (b :: k). t b -> Sum f t' b
f t a
y

instance HMonad (Sum f)

instance HBifoldableAt k Sum where
  hbifoldMap :: (forall (b :: k). f b -> k b)
-> (forall (b :: k). g b -> k b) -> Sum f g a -> k a
hbifoldMap forall (b :: k). f b -> k b
f forall (b :: k). g b -> k b
_ (InL f a
x) = f a -> k a
forall (b :: k). f b -> k b
f f a
x
  hbifoldMap forall (b :: k). f b -> k b
_ forall (b :: k). g b -> k b
g (InR g a
y) = g a -> k a
forall (b :: k). g b -> k b
g g a
y

instance HFoldableAt k (Sum k) where
  hfoldMap :: (forall (b :: k). t b -> k b) -> Sum k t a -> k a
hfoldMap = (forall (b :: k). k b -> k b)
-> (forall (b :: k). t b -> k b) -> Sum k t a -> k a
forall k (k :: k -> *) (h :: (k -> *) -> (k -> *) -> k -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
HBifoldableAt k h =>
(forall (b :: k). f b -> k b)
-> (forall (b :: k). g b -> k b) -> h f g a -> k a
hbifoldMap forall (b :: k). k b -> k b
forall a. a -> a
id

--------------------------------------------------------------------------------
-- 'StateT'

instance HFunctor (S.StateT s) where
  hmap :: (forall b. t b -> t' b) -> StateT s t a -> StateT s t' a
hmap forall b. t b -> t' b
f (S.StateT s -> t (a, s)
k) = (s -> t' (a, s)) -> StateT s t' a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT (t (a, s) -> t' (a, s)
forall b. t b -> t' b
f (t (a, s) -> t' (a, s)) -> (s -> t (a, s)) -> s -> t' (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> t (a, s)
k)

instance HFunctor (L.StateT s) where
  hmap :: (forall b. t b -> t' b) -> StateT s t a -> StateT s t' a
hmap forall b. t b -> t' b
f (L.StateT s -> t (a, s)
k) = (s -> t' (a, s)) -> StateT s t' a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT (t (a, s) -> t' (a, s)
forall b. t b -> t' b
f (t (a, s) -> t' (a, s)) -> (s -> t (a, s)) -> s -> t' (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> t (a, s)
k)

--------------------------------------------------------------------------------
-- 'WriterT'

instance HFunctor (S.WriterT w) where
  hmap :: (forall b. t b -> t' b) -> WriterT w t a -> WriterT w t' a
hmap forall b. t b -> t' b
f (S.WriterT t (a, w)
x) = t' (a, w) -> WriterT w t' a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
S.WriterT (t (a, w) -> t' (a, w)
forall b. t b -> t' b
f t (a, w)
x)

instance HFunctor (L.WriterT w) where
  hmap :: (forall b. t b -> t' b) -> WriterT w t a -> WriterT w t' a
hmap forall b. t b -> t' b
f (L.WriterT t (a, w)
x) = t' (a, w) -> WriterT w t' a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
L.WriterT (t (a, w) -> t' (a, w)
forall b. t b -> t' b
f t (a, w)
x)

--------------------------------------------------------------------------------
-- 'ReaderT'

instance HFunctor (ReaderT r) where
  hmap :: (forall b. t b -> t' b) -> ReaderT r t a -> ReaderT r t' a
hmap forall b. t b -> t' b
f (ReaderT r -> t a
k) = (r -> t' a) -> ReaderT r t' a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (t a -> t' a
forall b. t b -> t' b
f (t a -> t' a) -> (r -> t a) -> r -> t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> t a
k)

instance HPointed (ReaderT r) where
  hpure :: t a -> ReaderT r t a
hpure = (r -> t a) -> ReaderT r t a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> t a) -> ReaderT r t a)
-> (t a -> r -> t a) -> t a -> ReaderT r t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> r -> t a
forall a b. a -> b -> a
const

instance HBind (ReaderT r) where
  ReaderT r -> t a
k ^>>= :: ReaderT r t a
-> (forall b. t b -> ReaderT r t' b) -> ReaderT r t' a
^>>= forall b. t b -> ReaderT r t' b
f = (r -> t' a) -> ReaderT r t' a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\r
r -> ReaderT r t' a -> r -> t' a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (t a -> ReaderT r t' a
forall b. t b -> ReaderT r t' b
f (r -> t a
k r
r)) r
r)

instance HMonad (ReaderT r)

--------------------------------------------------------------------------------
-- ExceptT

instance HFunctor (ExceptT e) where
  hmap :: (forall b. t b -> t' b) -> ExceptT e t a -> ExceptT e t' a
hmap forall b. t b -> t' b
f (ExceptT t (Either e a)
x) = t' (Either e a) -> ExceptT e t' a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (t (Either e a) -> t' (Either e a)
forall b. t b -> t' b
f t (Either e a)
x)