-- |
-- Module      : Data.HFunctor.Interpret
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- This module provides tools for working with unary functor combinators
-- that represent interpretable schemas.
--
-- These are types @t@ that take a functor @f@ and return a new functor @t
-- f@, enhancing @f@ with new structure and abilities.
--
-- For these, we have:
--
-- @
-- 'inject' :: f a -> t f a
-- @
--
-- which lets you "lift" an @f a@ into its transformed version, and also:
--
-- @
-- 'interpret'
--     :: C t g
--     => (forall x. f a -> g a)
--     -> t f a
--     -> g a
-- @
--
-- that lets you "interpret" a @t f a@ into a context @g a@, essentially
-- "running" the computaiton that it encodes.  The context is required to
-- have a typeclass constraints that reflects what is "required" to be able
-- to run a functor combinator.
--
-- Every single instance provides different tools.  Check out the instance
-- list for a nice list of useful combinators, or also the README for
-- a high-level rundown.
--
-- See "Data.Functor.Tensor" for binary functor combinators that mix
-- together two or more different functors.
module Data.HFunctor.Interpret (
    Interpret(..), forI
  -- * Utilities
  , iget
  , icollect
  , icollect1
  , iapply
  , ifanout
  , ifanout1
  , getI, collectI
  , AltConst(..)
  , AndC
  , WrapHF(..)
  ) where

import           Control.Applicative
import           Control.Applicative.Backwards
import           Control.Applicative.Lift
import           Control.Applicative.ListF
import           Control.Applicative.Step
import           Control.Comonad.Trans.Env            (EnvT(..))
import           Control.Monad.Freer.Church
import           Control.Monad.Reader
import           Control.Monad.Trans.Compose
import           Control.Monad.Trans.Identity
import           Control.Natural
import           Data.Coerce
import           Data.Data
import           Data.Functor.Bind
import           Data.Functor.Classes
import           Data.Functor.Contravariant
import           Data.Functor.Contravariant.Conclude
import           Data.Functor.Contravariant.Decide
import           Data.Functor.Contravariant.Divise
import           Data.Functor.Contravariant.Divisible
import           Data.Functor.Coyoneda
import           Data.Functor.Invariant
import           Data.Functor.Plus
import           Data.Functor.Product
import           Data.Functor.Reverse
import           Data.Functor.Sum
import           Data.Functor.These
import           Data.HFunctor
import           Data.HFunctor.Internal
import           Data.List.NonEmpty                   (NonEmpty(..))
import           Data.Maybe
import           Data.Pointed
import           Data.Semigroup                       (Endo(..))
import           Data.Semigroup.Foldable
import           GHC.Generics
import qualified Control.Alternative.Free             as Alt
import qualified Control.Applicative.Free             as Ap
import qualified Control.Applicative.Free.Fast        as FAF
import qualified Control.Applicative.Free.Final       as FA
import qualified Data.Functor.Contravariant.Coyoneda  as CCY
import qualified Data.Map.NonEmpty                    as NEM

-- | An 'Interpret' lets us move in and out of the "enhanced" 'Functor' (@t
-- f@) and the functor it enhances (@f@).  An instance @'Interpret' t f@
-- means we have @t f a -> f a@.
--
-- For example, @'Free' f@ is @f@ enhanced with monadic structure.  We get:
--
-- @
-- 'inject'    :: f a -> 'Free' f a
-- 'interpret' :: 'Monad' m => (forall x. f x -> m x) -> 'Free' f a -> m a
-- @
--
-- 'inject' will let us use our @f@ inside the enhanced @'Free' f@.
-- 'interpret' will let us "extract" the @f@ from a @'Free' f@ if
-- we can give an /interpreting function/ that interprets @f@ into some
-- target 'Monad'.
--
-- We enforce that:
--
-- @
-- 'interpret' id . 'inject' == id
-- -- or
-- 'retract' . 'inject' == id
-- @
--
-- That is, if we lift a value into our structure, then immediately
-- interpret it out as itself, it should lave the value unchanged.
--
-- Note that instances of this class are /intended/ to be written with @t@
-- as a fixed type constructor, and @f@ to be allowed to vary freely:
--
-- @
-- instance Monad f => Interpret Free f
-- @
--
-- Any other sort of instance and it's easy to run into problems with type
-- inference.  If you want to write an instance that's "polymorphic" on
-- tensor choice, use the 'WrapHF' newtype wrapper over a type variable,
-- where the second argument also uses a type constructor:
--
-- @
-- instance Interpret (WrapHF t) (MyFunctor t)
-- @
--
-- This will prevent problems with overloaded instances.
class Inject t => Interpret t f where

    -- | Remove the @f@ out of the enhanced @t f@ structure, provided that
    -- @f@ satisfies the necessary constraints.  If it doesn't, it needs to
    -- be properly 'interpret'ed out.
    retract :: t f ~> f
    retract = (f ~> f) -> t f ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret f ~> f
forall a. a -> a
id

    -- | Given an "interpeting function" from @f@ to @g@, interpret the @f@
    -- out of the @t f@ into a final context @g@.
    interpret :: (g ~> f) -> t g ~> f
    interpret f :: g ~> f
f = t f x -> f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract (t f x -> f x) -> (t g x -> t f x) -> t g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g ~> f) -> t g ~> t f
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap g ~> f
f

    {-# MINIMAL retract | interpret #-}

-- | A convenient flipped version of 'interpret'.
forI
    :: Interpret t f
    => t g a
    -> (g ~> f)
    -> f a
forI :: t g a -> (g ~> f) -> f a
forI x :: t g a
x f :: g ~> f
f = (g ~> f) -> t g a -> f a
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret g ~> f
f t g a
x

-- | Useful wrapper over 'interpret' to allow you to directly extract
-- a value @b@ out of the @t f a@, if you can convert @f x@ into @b@.
--
-- Note that depending on the constraints on @f@ in @'Interpret' t f@, you
-- may have extra constraints on @b@.
--
-- *    If @f@ is unconstrained, there are no constraints on @b@
-- *    If @f@ must be 'Apply', 'Alt', 'Divise', or 'Decide', @b@ needs to be an instance of 'Semigroup'.
-- *    If @f@ is 'Applicative', 'Plus', 'Divisible', or 'Conclude', @b@ needs to be an instance of 'Monoid'
--
-- For some constraints (like 'Monad'), this will not be usable.
--
-- @
-- -- get the length of the @Map String@ in the 'Step'.
-- 'icollect' length
--      :: Step (Map String) Bool
--      -> Int
-- @
--
-- @since 0.3.1.0
iget
    :: Interpret t (AltConst b)
    => (forall x. f x -> b)
    -> t f a
    -> b
iget :: (forall (x :: k). f x -> b) -> t f a -> b
iget f :: forall (x :: k). f x -> b
f = AltConst b a -> b
forall w k (a :: k). AltConst w a -> w
getAltConst (AltConst b a -> b) -> (t f a -> AltConst b a) -> t f a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> AltConst b) -> t f ~> AltConst b
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret (b -> AltConst b x
forall k w (a :: k). w -> AltConst w a
AltConst (b -> AltConst b x) -> (f x -> b) -> f x -> AltConst b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> b
forall (x :: k). f x -> b
f)

-- | (Deprecated) Old name for 'getI'; will be removed in a future
-- version.
getI :: Interpret t (AltConst b) => (forall x. f x -> b) -> t f a -> b
getI :: (forall (x :: k). f x -> b) -> t f a -> b
getI = (forall (x :: k). f x -> b) -> t f a -> b
forall k (t :: (k -> *) -> k -> *) b (f :: k -> *) (a :: k).
Interpret t (AltConst b) =>
(forall (x :: k). f x -> b) -> t f a -> b
iget
{-# DEPRECATED getI "Use iget instead" #-}

-- | Useful wrapper over 'iget' to allow you to collect a @b@ from all
-- instances of @f@ inside a @t f a@.
--
-- Will work if there is an instance of @'Interpret' t ('AltConst' m)@ if @'Monoid'
-- m@, which will be the case if the constraint on the target
-- functor is 'Functor', 'Apply', 'Applicative', 'Alt', 'Plus',
-- 'Data.Functor.Contravariant.Decide.Decide', 'Divisible', 'Decide',
-- 'Conclude', or unconstrained.
--
-- @
-- -- get the lengths of all @Map String@s in the 'Ap.Ap'.
-- 'icollect' length
--      :: Ap (Map String) Bool
--      -> [Int]
-- @
--
-- @since 0.3.1.0
icollect
    :: (forall m. Monoid m => Interpret t (AltConst m))
    => (forall x. f x -> b)
    -> t f a
    -> [b]
icollect :: (forall (x :: k). f x -> b) -> t f a -> [b]
icollect f :: forall (x :: k). f x -> b
f = (Endo [b] -> [b] -> [b]) -> [b] -> Endo [b] -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [b] -> [b] -> [b]
forall a. Endo a -> a -> a
appEndo [] (Endo [b] -> [b]) -> (t f a -> Endo [b]) -> t f a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). f x -> Endo [b]) -> t f a -> Endo [b]
forall k (t :: (k -> *) -> k -> *) b (f :: k -> *) (a :: k).
Interpret t (AltConst b) =>
(forall (x :: k). f x -> b) -> t f a -> b
iget (([b] -> [b]) -> Endo [b]
forall a. (a -> a) -> Endo a
Endo (([b] -> [b]) -> Endo [b])
-> (f x -> [b] -> [b]) -> f x -> Endo [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (b -> [b] -> [b]) -> (f x -> b) -> f x -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> b
forall (x :: k). f x -> b
f)

-- | (Deprecated) Old name for 'icollect'; will be removed in a future
-- version.
collectI :: (forall m. Monoid m => Interpret t (AltConst m)) => (forall x. f x -> b) -> t f a -> [b]
collectI :: (forall (x :: k). f x -> b) -> t f a -> [b]
collectI = (forall (x :: k). f x -> b) -> t f a -> [b]
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) b (a :: k).
(forall m. Monoid m => Interpret t (AltConst m)) =>
(forall (x :: k). f x -> b) -> t f a -> [b]
icollect
{-# DEPRECATED collectI "Use icollect instead" #-}

-- | Useful wrapper over 'iget' to allow you to collect a @b@ from all
-- instances of @f@ inside a @t f a@, into a non-empty collection of @b@s.
--
-- Will work if there is an instance of @'Interpret' t ('AltConst' m)@ if
-- @'Semigroup' m@, which will be the case if the constraint on the target
-- functor is 'Functor', 'Apply', 'Alt', 'Divise', 'Decide', or
-- unconstrained.
--
-- @
-- -- get the lengths of all @Map String@s in the 'Ap.Ap'.
-- 'icollect1' length
--      :: Ap1 (Map String) Bool
--      -> 'NonEmpty' Int
-- @
--
-- @since 0.3.1.0
icollect1
    :: (forall m. Semigroup m => Interpret t (AltConst m))
    => (forall x. f x -> b)
    -> t f a
    -> NonEmpty b
icollect1 :: (forall (x :: k). f x -> b) -> t f a -> NonEmpty b
icollect1 f :: forall (x :: k). f x -> b
f = NDL b -> NonEmpty b
forall a. NDL a -> NonEmpty a
fromNDL (NDL b -> NonEmpty b) -> (t f a -> NDL b) -> t f a -> NonEmpty b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: k). f x -> NDL b) -> t f a -> NDL b
forall k (t :: (k -> *) -> k -> *) b (f :: k -> *) (a :: k).
Interpret t (AltConst b) =>
(forall (x :: k). f x -> b) -> t f a -> b
iget (b -> NDL b
forall a. a -> NDL a
ndlSingleton (b -> NDL b) -> (f x -> b) -> f x -> NDL b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> b
forall (x :: k). f x -> b
f)

-- | Useful wrapper over 'interpret' to allow you to directly consume
-- a value of type @a@ with a @t f a@ to create a @b@.  Do this by
-- supplying the method by which each component @f x@ can consume an @x@.
-- This works for contravariant functor combinators, where @t f a@ can be
-- interpreted as a consumer of @a@s.
--
-- Note that depending on the constraints on @f@ in @'Interpret' t f@, you
-- may have extra constraints on @b@.
--
-- *    If @f@ is unconstrained, 'Decide', or 'Conclude', there are no
--      constraints on @b@.  This will be the case for combinators like
--      contravariant 'CCY.Coyoneda', 'Dec', 'Dec1'.
-- *    If @f@ must be 'Divise', @b@ needs to be an instance of
--      'Semigroup'.  This will be the case for combinators like 'Div1'.
-- *    If @f@ is 'Divisible', @b@ needs to be an instance of 'Monoid'.
--      This will be the case for combinators like 'Div'.
--
-- For any 'Functor' or 'Invariant' constraint, this is not usable.
--
-- @since 0.3.2.0
iapply
    :: Interpret t (Op b)
    => (forall x. f x -> x -> b)
    -> t f a
    -> a
    -> b
iapply :: (forall x. f x -> x -> b) -> t f a -> a -> b
iapply f :: forall x. f x -> x -> b
f = Op b a -> a -> b
forall a b. Op a b -> b -> a
getOp (Op b a -> a -> b) -> (t f a -> Op b a) -> t f a -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> Op b) -> t f ~> Op b
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret ((x -> b) -> Op b x
forall a b. (b -> a) -> Op a b
Op ((x -> b) -> Op b x) -> (f x -> x -> b) -> f x -> Op b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> x -> b
forall x. f x -> x -> b
f)

-- | Useful wrapper over 'interpret' to allow you to directly consume
-- a value of type @a@ with a @t f a@ to create a @b@, and create a list of
-- all the @b@s created by all the @f@s.  Do this by supplying the method
-- by which each component @f x@ can consume an @x@. This works for
-- contravariant functor combinators, where @t f a@ can be interpreted as
-- a consumer of @a@s.
--
-- Will work if there is an instance of @'Interpret' t ('Op' m)@ if @'Monoid'
-- m@, which will be the case if the constraint on the target
-- functor is 'Contravariant', 'Decide', 'Conclude', 'Divise', 'Divisible',
-- or unconstrained.
--
-- Note that this is really only useful outside of 'iapply' for 'Div' and
-- 'Div1', where a @'Div' f@ which is a collection of many different @f@s
-- consuming types of different values.  You can use this with 'Dec' and
-- 'Dec1' and the contravarient 'CCY.Coyoneda' as well, but those would
-- always just give you a singleton list, so you might as well use
-- 'iapply'.  This is really only here for completion alongside 'icollect',
-- or if you define your own custom functor combinators.
ifanout
    :: (forall m. Monoid m => Interpret t (Op m))
    => (forall x. f x -> x -> b)
    -> t f a
    -> a
    -> [b]
ifanout :: (forall x. f x -> x -> b) -> t f a -> a -> [b]
ifanout f :: forall x. f x -> x -> b
f t :: t f a
t = (Endo [b] -> [b] -> [b]) -> [b] -> Endo [b] -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Endo [b] -> [b] -> [b]
forall a. Endo a -> a -> a
appEndo [] (Endo [b] -> [b]) -> (a -> Endo [b]) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. f x -> x -> Endo [b]) -> t f a -> a -> Endo [b]
forall (t :: (* -> *) -> * -> *) b (f :: * -> *) a.
Interpret t (Op b) =>
(forall x. f x -> x -> b) -> t f a -> a -> b
iapply (\x :: f x
x y :: x
y -> ([b] -> [b]) -> Endo [b]
forall a. (a -> a) -> Endo a
Endo (f x -> x -> b
forall x. f x -> x -> b
f f x
x x
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
:)) t f a
t

-- | Useful wrapper over 'interpret' to allow you to directly consume
-- a value of type @a@ with a @t f a@ to create a @b@, and create a list of
-- all the @b@s created by all the @f@s.  Do this by supplying the method
-- by which each component @f x@ can consume an @x@. This works for
-- contravariant functor combinators, where @t f a@ can be interpreted as
-- a consumer of @a@s.
--
-- Will work if there is an instance of @'Interpret' t ('Op' m)@ if @'Monoid'
-- m@, which will be the case if the constraint on the target
-- functor is 'Contravariant', 'Decide', 'Divise', or unconstrained.
--
-- Note that this is really only useful outside of 'iapply' and 'ifanout'
-- for 'Div1', where a @'Div1' f@ which is a collection of many different
-- @f@s consuming types of different values.  You can use this with 'Dec'
-- and 'Dec1' and the contravarient 'CCY.Coyoneda' as well, but those would
-- always just give you a singleton list, so you might as well use
-- 'iapply'.  This is really only here for completion alongside
-- 'icollect1', or if you define your own custom functor combinators.
ifanout1
    :: (forall m. Semigroup m => Interpret t (Op m))
    => (forall x. f x -> x -> b)
    -> t f a
    -> a
    -> NonEmpty b
ifanout1 :: (forall x. f x -> x -> b) -> t f a -> a -> NonEmpty b
ifanout1 f :: forall x. f x -> x -> b
f t :: t f a
t = NDL b -> NonEmpty b
forall a. NDL a -> NonEmpty a
fromNDL (NDL b -> NonEmpty b) -> (a -> NDL b) -> a -> NonEmpty b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. f x -> x -> NDL b) -> t f a -> a -> NDL b
forall (t :: (* -> *) -> * -> *) b (f :: * -> *) a.
Interpret t (Op b) =>
(forall x. f x -> x -> b) -> t f a -> a -> b
iapply (\x :: f x
x -> b -> NDL b
forall a. a -> NDL a
ndlSingleton (b -> NDL b) -> (x -> b) -> x -> NDL b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> x -> b
forall x. f x -> x -> b
f f x
x) t f a
t



-- | A version of 'Const' that supports 'Alt', 'Plus', 'Decide', and
-- 'Conclude' instances.  It does this
-- by avoiding having an 'Alternative' or 'Decidable' instance, which
-- causes all sorts of problems with the interactions between
-- 'Alternative'/'Applicative' and
-- 'Decidable'/'Data.Functor.Contravariant.Divisible.Divisible'.
--
-- @since 0.3.1.0
newtype AltConst w a = AltConst { AltConst w a -> w
getAltConst :: w }
  deriving (Int -> AltConst w a -> ShowS
[AltConst w a] -> ShowS
AltConst w a -> String
(Int -> AltConst w a -> ShowS)
-> (AltConst w a -> String)
-> ([AltConst w a] -> ShowS)
-> Show (AltConst w a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w k (a :: k). Show w => Int -> AltConst w a -> ShowS
forall w k (a :: k). Show w => [AltConst w a] -> ShowS
forall w k (a :: k). Show w => AltConst w a -> String
showList :: [AltConst w a] -> ShowS
$cshowList :: forall w k (a :: k). Show w => [AltConst w a] -> ShowS
show :: AltConst w a -> String
$cshow :: forall w k (a :: k). Show w => AltConst w a -> String
showsPrec :: Int -> AltConst w a -> ShowS
$cshowsPrec :: forall w k (a :: k). Show w => Int -> AltConst w a -> ShowS
Show, AltConst w a -> AltConst w a -> Bool
(AltConst w a -> AltConst w a -> Bool)
-> (AltConst w a -> AltConst w a -> Bool) -> Eq (AltConst w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w k (a :: k). Eq w => AltConst w a -> AltConst w a -> Bool
/= :: AltConst w a -> AltConst w a -> Bool
$c/= :: forall w k (a :: k). Eq w => AltConst w a -> AltConst w a -> Bool
== :: AltConst w a -> AltConst w a -> Bool
$c== :: forall w k (a :: k). Eq w => AltConst w a -> AltConst w a -> Bool
Eq, Eq (AltConst w a)
Eq (AltConst w a) =>
(AltConst w a -> AltConst w a -> Ordering)
-> (AltConst w a -> AltConst w a -> Bool)
-> (AltConst w a -> AltConst w a -> Bool)
-> (AltConst w a -> AltConst w a -> Bool)
-> (AltConst w a -> AltConst w a -> Bool)
-> (AltConst w a -> AltConst w a -> AltConst w a)
-> (AltConst w a -> AltConst w a -> AltConst w a)
-> Ord (AltConst w a)
AltConst w a -> AltConst w a -> Bool
AltConst w a -> AltConst w a -> Ordering
AltConst w a -> AltConst w a -> AltConst w a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w k (a :: k). Ord w => Eq (AltConst w a)
forall w k (a :: k). Ord w => AltConst w a -> AltConst w a -> Bool
forall w k (a :: k).
Ord w =>
AltConst w a -> AltConst w a -> Ordering
forall w k (a :: k).
Ord w =>
AltConst w a -> AltConst w a -> AltConst w a
min :: AltConst w a -> AltConst w a -> AltConst w a
$cmin :: forall w k (a :: k).
Ord w =>
AltConst w a -> AltConst w a -> AltConst w a
max :: AltConst w a -> AltConst w a -> AltConst w a
$cmax :: forall w k (a :: k).
Ord w =>
AltConst w a -> AltConst w a -> AltConst w a
>= :: AltConst w a -> AltConst w a -> Bool
$c>= :: forall w k (a :: k). Ord w => AltConst w a -> AltConst w a -> Bool
> :: AltConst w a -> AltConst w a -> Bool
$c> :: forall w k (a :: k). Ord w => AltConst w a -> AltConst w a -> Bool
<= :: AltConst w a -> AltConst w a -> Bool
$c<= :: forall w k (a :: k). Ord w => AltConst w a -> AltConst w a -> Bool
< :: AltConst w a -> AltConst w a -> Bool
$c< :: forall w k (a :: k). Ord w => AltConst w a -> AltConst w a -> Bool
compare :: AltConst w a -> AltConst w a -> Ordering
$ccompare :: forall w k (a :: k).
Ord w =>
AltConst w a -> AltConst w a -> Ordering
$cp1Ord :: forall w k (a :: k). Ord w => Eq (AltConst w a)
Ord, (forall x. AltConst w a -> Rep (AltConst w a) x)
-> (forall x. Rep (AltConst w a) x -> AltConst w a)
-> Generic (AltConst w a)
forall x. Rep (AltConst w a) x -> AltConst w a
forall x. AltConst w a -> Rep (AltConst w a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w k (a :: k) x. Rep (AltConst w a) x -> AltConst w a
forall w k (a :: k) x. AltConst w a -> Rep (AltConst w a) x
$cto :: forall w k (a :: k) x. Rep (AltConst w a) x -> AltConst w a
$cfrom :: forall w k (a :: k) x. AltConst w a -> Rep (AltConst w a) x
Generic, (a -> b) -> AltConst w a -> AltConst w b
(forall a b. (a -> b) -> AltConst w a -> AltConst w b)
-> (forall a b. a -> AltConst w b -> AltConst w a)
-> Functor (AltConst w)
forall a b. a -> AltConst w b -> AltConst w a
forall a b. (a -> b) -> AltConst w a -> AltConst w b
forall w a b. a -> AltConst w b -> AltConst w a
forall w a b. (a -> b) -> AltConst w a -> AltConst w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AltConst w b -> AltConst w a
$c<$ :: forall w a b. a -> AltConst w b -> AltConst w a
fmap :: (a -> b) -> AltConst w a -> AltConst w b
$cfmap :: forall w a b. (a -> b) -> AltConst w a -> AltConst w b
Functor, (a -> m) -> AltConst w a -> m
(forall m. Monoid m => AltConst w m -> m)
-> (forall m a. Monoid m => (a -> m) -> AltConst w a -> m)
-> (forall m a. Monoid m => (a -> m) -> AltConst w a -> m)
-> (forall a b. (a -> b -> b) -> b -> AltConst w a -> b)
-> (forall a b. (a -> b -> b) -> b -> AltConst w a -> b)
-> (forall b a. (b -> a -> b) -> b -> AltConst w a -> b)
-> (forall b a. (b -> a -> b) -> b -> AltConst w a -> b)
-> (forall a. (a -> a -> a) -> AltConst w a -> a)
-> (forall a. (a -> a -> a) -> AltConst w a -> a)
-> (forall a. AltConst w a -> [a])
-> (forall a. AltConst w a -> Bool)
-> (forall a. AltConst w a -> Int)
-> (forall a. Eq a => a -> AltConst w a -> Bool)
-> (forall a. Ord a => AltConst w a -> a)
-> (forall a. Ord a => AltConst w a -> a)
-> (forall a. Num a => AltConst w a -> a)
-> (forall a. Num a => AltConst w a -> a)
-> Foldable (AltConst w)
forall a. Eq a => a -> AltConst w a -> Bool
forall a. Num a => AltConst w a -> a
forall a. Ord a => AltConst w a -> a
forall m. Monoid m => AltConst w m -> m
forall a. AltConst w a -> Bool
forall a. AltConst w a -> Int
forall a. AltConst w a -> [a]
forall a. (a -> a -> a) -> AltConst w a -> a
forall w a. Eq a => a -> AltConst w a -> Bool
forall w a. Num a => AltConst w a -> a
forall w a. Ord a => AltConst w a -> a
forall m a. Monoid m => (a -> m) -> AltConst w a -> m
forall w m. Monoid m => AltConst w m -> m
forall w a. AltConst w a -> Bool
forall w a. AltConst w a -> Int
forall w a. AltConst w a -> [a]
forall b a. (b -> a -> b) -> b -> AltConst w a -> b
forall a b. (a -> b -> b) -> b -> AltConst w a -> b
forall w a. (a -> a -> a) -> AltConst w a -> a
forall w m a. Monoid m => (a -> m) -> AltConst w a -> m
forall w b a. (b -> a -> b) -> b -> AltConst w a -> b
forall w a b. (a -> b -> b) -> b -> AltConst w a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: AltConst w a -> a
$cproduct :: forall w a. Num a => AltConst w a -> a
sum :: AltConst w a -> a
$csum :: forall w a. Num a => AltConst w a -> a
minimum :: AltConst w a -> a
$cminimum :: forall w a. Ord a => AltConst w a -> a
maximum :: AltConst w a -> a
$cmaximum :: forall w a. Ord a => AltConst w a -> a
elem :: a -> AltConst w a -> Bool
$celem :: forall w a. Eq a => a -> AltConst w a -> Bool
length :: AltConst w a -> Int
$clength :: forall w a. AltConst w a -> Int
null :: AltConst w a -> Bool
$cnull :: forall w a. AltConst w a -> Bool
toList :: AltConst w a -> [a]
$ctoList :: forall w a. AltConst w a -> [a]
foldl1 :: (a -> a -> a) -> AltConst w a -> a
$cfoldl1 :: forall w a. (a -> a -> a) -> AltConst w a -> a
foldr1 :: (a -> a -> a) -> AltConst w a -> a
$cfoldr1 :: forall w a. (a -> a -> a) -> AltConst w a -> a
foldl' :: (b -> a -> b) -> b -> AltConst w a -> b
$cfoldl' :: forall w b a. (b -> a -> b) -> b -> AltConst w a -> b
foldl :: (b -> a -> b) -> b -> AltConst w a -> b
$cfoldl :: forall w b a. (b -> a -> b) -> b -> AltConst w a -> b
foldr' :: (a -> b -> b) -> b -> AltConst w a -> b
$cfoldr' :: forall w a b. (a -> b -> b) -> b -> AltConst w a -> b
foldr :: (a -> b -> b) -> b -> AltConst w a -> b
$cfoldr :: forall w a b. (a -> b -> b) -> b -> AltConst w a -> b
foldMap' :: (a -> m) -> AltConst w a -> m
$cfoldMap' :: forall w m a. Monoid m => (a -> m) -> AltConst w a -> m
foldMap :: (a -> m) -> AltConst w a -> m
$cfoldMap :: forall w m a. Monoid m => (a -> m) -> AltConst w a -> m
fold :: AltConst w m -> m
$cfold :: forall w m. Monoid m => AltConst w m -> m
Foldable, Functor (AltConst w)
Foldable (AltConst w)
(Functor (AltConst w), Foldable (AltConst w)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> AltConst w a -> f (AltConst w b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    AltConst w (f a) -> f (AltConst w a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> AltConst w a -> m (AltConst w b))
-> (forall (m :: * -> *) a.
    Monad m =>
    AltConst w (m a) -> m (AltConst w a))
-> Traversable (AltConst w)
(a -> f b) -> AltConst w a -> f (AltConst w b)
forall w. Functor (AltConst w)
forall w. Foldable (AltConst w)
forall w (m :: * -> *) a.
Monad m =>
AltConst w (m a) -> m (AltConst w a)
forall w (f :: * -> *) a.
Applicative f =>
AltConst w (f a) -> f (AltConst w a)
forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AltConst w a -> m (AltConst w b)
forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AltConst w a -> f (AltConst w b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
AltConst w (m a) -> m (AltConst w a)
forall (f :: * -> *) a.
Applicative f =>
AltConst w (f a) -> f (AltConst w a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AltConst w a -> m (AltConst w b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AltConst w a -> f (AltConst w b)
sequence :: AltConst w (m a) -> m (AltConst w a)
$csequence :: forall w (m :: * -> *) a.
Monad m =>
AltConst w (m a) -> m (AltConst w a)
mapM :: (a -> m b) -> AltConst w a -> m (AltConst w b)
$cmapM :: forall w (m :: * -> *) a b.
Monad m =>
(a -> m b) -> AltConst w a -> m (AltConst w b)
sequenceA :: AltConst w (f a) -> f (AltConst w a)
$csequenceA :: forall w (f :: * -> *) a.
Applicative f =>
AltConst w (f a) -> f (AltConst w a)
traverse :: (a -> f b) -> AltConst w a -> f (AltConst w b)
$ctraverse :: forall w (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AltConst w a -> f (AltConst w b)
$cp2Traversable :: forall w. Foldable (AltConst w)
$cp1Traversable :: forall w. Functor (AltConst w)
Traversable, Typeable (AltConst w a)
DataType
Constr
Typeable (AltConst w a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (AltConst w a))
-> (AltConst w a -> Constr)
-> (AltConst w a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (AltConst w a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (AltConst w a)))
-> ((forall b. Data b => b -> b) -> AltConst w a -> AltConst w a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AltConst w a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AltConst w a -> r)
-> (forall u. (forall d. Data d => d -> u) -> AltConst w a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AltConst w a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a))
-> Data (AltConst w a)
AltConst w a -> DataType
AltConst w a -> Constr
(forall b. Data b => b -> b) -> AltConst w a -> AltConst w a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AltConst w a)
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AltConst w a -> u
forall u. (forall d. Data d => d -> u) -> AltConst w a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
Typeable (AltConst w a)
forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
AltConst w a -> DataType
forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
AltConst w a -> Constr
forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
(forall b. Data b => b -> b) -> AltConst w a -> AltConst w a
forall w k (a :: k) u.
(Typeable a, Typeable k, Data w) =>
Int -> (forall d. Data d => d -> u) -> AltConst w a -> u
forall w k (a :: k) u.
(Typeable a, Typeable k, Data w) =>
(forall d. Data d => d -> u) -> AltConst w a -> [u]
forall w k (a :: k) r r'.
(Typeable a, Typeable k, Data w) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
forall w k (a :: k) r r'.
(Typeable a, Typeable k, Data w) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
forall w k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Data w, Monad m) =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
forall w k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Data w, MonadPlus m) =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
forall w k (a :: k) (c :: * -> *).
(Typeable a, Typeable k, Data w) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AltConst w a)
forall w k (a :: k) (c :: * -> *).
(Typeable a, Typeable k, Data w) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a)
forall w k (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable k, Data w, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AltConst w a))
forall w k (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable k, Data w, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AltConst w a))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AltConst w a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (AltConst w a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AltConst w a))
$cAltConst :: Constr
$tAltConst :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
$cgmapMo :: forall w k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Data w, MonadPlus m) =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
gmapMp :: (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
$cgmapMp :: forall w k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Data w, MonadPlus m) =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
gmapM :: (forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
$cgmapM :: forall w k (a :: k) (m :: * -> *).
(Typeable a, Typeable k, Data w, Monad m) =>
(forall d. Data d => d -> m d) -> AltConst w a -> m (AltConst w a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> AltConst w a -> u
$cgmapQi :: forall w k (a :: k) u.
(Typeable a, Typeable k, Data w) =>
Int -> (forall d. Data d => d -> u) -> AltConst w a -> u
gmapQ :: (forall d. Data d => d -> u) -> AltConst w a -> [u]
$cgmapQ :: forall w k (a :: k) u.
(Typeable a, Typeable k, Data w) =>
(forall d. Data d => d -> u) -> AltConst w a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
$cgmapQr :: forall w k (a :: k) r r'.
(Typeable a, Typeable k, Data w) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
$cgmapQl :: forall w k (a :: k) r r'.
(Typeable a, Typeable k, Data w) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AltConst w a -> r
gmapT :: (forall b. Data b => b -> b) -> AltConst w a -> AltConst w a
$cgmapT :: forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
(forall b. Data b => b -> b) -> AltConst w a -> AltConst w a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AltConst w a))
$cdataCast2 :: forall w k (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable k, Data w, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (AltConst w a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (AltConst w a))
$cdataCast1 :: forall w k (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable k, Data w, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (AltConst w a))
dataTypeOf :: AltConst w a -> DataType
$cdataTypeOf :: forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
AltConst w a -> DataType
toConstr :: AltConst w a -> Constr
$ctoConstr :: forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
AltConst w a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AltConst w a)
$cgunfold :: forall w k (a :: k) (c :: * -> *).
(Typeable a, Typeable k, Data w) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (AltConst w a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a)
$cgfoldl :: forall w k (a :: k) (c :: * -> *).
(Typeable a, Typeable k, Data w) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltConst w a -> c (AltConst w a)
$cp1Data :: forall w k (a :: k).
(Typeable a, Typeable k, Data w) =>
Typeable (AltConst w a)
Data)

instance Show w => Show1 (AltConst w) where
    liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> AltConst w a -> ShowS
liftShowsPrec _ _ d :: Int
d (AltConst x :: w
x) = (Int -> w -> ShowS) -> String -> Int -> w -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> w -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec "AltConst" Int
d w
x
instance Eq w => Eq1 (AltConst w) where
    liftEq :: (a -> b -> Bool) -> AltConst w a -> AltConst w b -> Bool
liftEq _ (AltConst x :: w
x) (AltConst y :: w
y) = w
x w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
y
instance Ord w => Ord1 (AltConst w) where
    liftCompare :: (a -> b -> Ordering) -> AltConst w a -> AltConst w b -> Ordering
liftCompare _ (AltConst x :: w
x) (AltConst y :: w
y) = w -> w -> Ordering
forall a. Ord a => a -> a -> Ordering
compare w
x w
y

instance Contravariant (AltConst w) where
    contramap :: (a -> b) -> AltConst w b -> AltConst w a
contramap _ = AltConst w b -> AltConst w a
forall a b. Coercible a b => a -> b
coerce
instance Invariant (AltConst w) where
    invmap :: (a -> b) -> (b -> a) -> AltConst w a -> AltConst w b
invmap _ _ = AltConst w a -> AltConst w b
forall a b. Coercible a b => a -> b
coerce

instance Semigroup w => Apply (AltConst w) where
    AltConst x :: w
x <.> :: AltConst w (a -> b) -> AltConst w a -> AltConst w b
<.> AltConst y :: w
y = w -> AltConst w b
forall k w (a :: k). w -> AltConst w a
AltConst (w
x w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
y)
instance Monoid w => Applicative (AltConst w) where
    <*> :: AltConst w (a -> b) -> AltConst w a -> AltConst w b
(<*>) = AltConst w (a -> b) -> AltConst w a -> AltConst w b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
    pure :: a -> AltConst w a
pure _ = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst w
forall a. Monoid a => a
mempty
-- | Unlike for 'Const', this is possible because there is no 'Alternative'
-- instance to complicate things.
instance Semigroup w => Alt (AltConst w) where
    AltConst x :: w
x <!> :: AltConst w a -> AltConst w a -> AltConst w a
<!> AltConst y :: w
y = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst (w
x w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
y)
-- | Unlike for 'Const', this is possible because there is no 'Alternative'
-- instance to complicate things.
instance Monoid w => Plus (AltConst w) where
    zero :: AltConst w a
zero = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst w
forall a. Monoid a => a
mempty

instance Semigroup w => Divise (AltConst w) where
    divise :: (a -> (b, c)) -> AltConst w b -> AltConst w c -> AltConst w a
divise _ (AltConst x :: w
x) (AltConst y :: w
y) = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst (w
x w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
y)
instance Monoid w => Divisible (AltConst w) where
    divide :: (a -> (b, c)) -> AltConst w b -> AltConst w c -> AltConst w a
divide  = (a -> (b, c)) -> AltConst w b -> AltConst w c -> AltConst w a
forall (f :: * -> *) a b c.
Divise f =>
(a -> (b, c)) -> f b -> f c -> f a
divise
    conquer :: AltConst w a
conquer = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst w
forall a. Monoid a => a
mempty
-- | Unlike for 'Const', this is possible because there is no 'Decidable'
-- instance to complicate things.
instance Semigroup w => Decide (AltConst w) where
    decide :: (a -> Either b c) -> AltConst w b -> AltConst w c -> AltConst w a
decide _ (AltConst x :: w
x) (AltConst y :: w
y) = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst (w
x w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
y)
-- | Unlike for 'Const', this is possible because there is no 'Decidable'
-- instance to complicate things.
instance Monoid w => Conclude (AltConst w) where
    conclude :: (a -> Void) -> AltConst w a
conclude _ = w -> AltConst w a
forall k w (a :: k). w -> AltConst w a
AltConst w
forall a. Monoid a => a
mempty

-- | A free 'Functor'
instance Functor f => Interpret Coyoneda f where
    retract :: Coyoneda f x -> f x
retract                    = Coyoneda f x -> f x
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
    interpret :: (g ~> f) -> Coyoneda g ~> f
interpret f :: g ~> f
f (Coyoneda g :: b -> x
g x :: g b
x) = b -> x
g (b -> x) -> f b -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g b -> f b
g ~> f
f g b
x

-- | A free 'Contravariant'
--
-- @since 0.3.0.0
instance Contravariant f => Interpret CCY.Coyoneda f where
    retract :: Coyoneda f x -> f x
retract                        = Coyoneda f x -> f x
forall (f :: * -> *) a. Contravariant f => Coyoneda f a -> f a
CCY.lowerCoyoneda
    interpret :: (g ~> f) -> Coyoneda g ~> f
interpret f :: g ~> f
f (CCY.Coyoneda g :: x -> b
g x :: g b
x) = (x -> b) -> f b -> f x
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap x -> b
g (g b -> f b
g ~> f
f g b
x)

-- | A free 'Applicative'
instance Applicative f => Interpret Ap.Ap f where
    retract :: Ap f x -> f x
retract   = \case
      Ap.Pure x :: x
x  -> x -> f x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
      Ap.Ap x :: f a1
x xs :: Ap f (a1 -> x)
xs -> f a1
x f a1 -> f (a1 -> x) -> f x
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Ap f (a1 -> x) -> f (a1 -> x)
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract Ap f (a1 -> x)
xs
    interpret :: (g ~> f) -> Ap g ~> f
interpret = (g ~> f) -> Ap g x -> f x
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
Ap.runAp

-- | A free 'Plus'
instance Plus f => Interpret ListF f where
    retract :: ListF f x -> f x
retract     = (f x -> f x -> f x) -> f x -> [f x] -> f x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f x -> f x -> f x
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) f x
forall (f :: * -> *) a. Plus f => f a
zero ([f x] -> f x) -> (ListF f x -> [f x]) -> ListF f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListF f x -> [f x]
forall k (f :: k -> *) (a :: k). ListF f a -> [f a]
runListF
    interpret :: (g ~> f) -> ListF g ~> f
interpret f :: g ~> f
f = (g x -> f x -> f x) -> f x -> [g x] -> f x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (f x -> f x -> f x
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) (f x -> f x -> f x) -> (g x -> f x) -> g x -> f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> f x
g ~> f
f) f x
forall (f :: * -> *) a. Plus f => f a
zero ([g x] -> f x) -> (ListF g x -> [g x]) -> ListF g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListF g x -> [g x]
forall k (f :: k -> *) (a :: k). ListF f a -> [f a]
runListF

-- | A free 'Alt'
instance Alt f => Interpret NonEmptyF f where
    retract :: NonEmptyF f x -> f x
retract     = NonEmpty (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NonEmpty (f x) -> f x)
-> (NonEmptyF f x -> NonEmpty (f x)) -> NonEmptyF f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF f x -> NonEmpty (f x)
forall k (f :: k -> *) (a :: k). NonEmptyF f a -> NonEmpty (f a)
runNonEmptyF
    interpret :: (g ~> f) -> NonEmptyF g ~> f
interpret f :: g ~> f
f = NonEmpty (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NonEmpty (f x) -> f x)
-> (NonEmptyF g x -> NonEmpty (f x)) -> NonEmptyF g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g x -> f x) -> NonEmpty (g x) -> NonEmpty (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> f x
g ~> f
f (NonEmpty (g x) -> NonEmpty (f x))
-> (NonEmptyF g x -> NonEmpty (g x))
-> NonEmptyF g x
-> NonEmpty (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyF g x -> NonEmpty (g x)
forall k (f :: k -> *) (a :: k). NonEmptyF f a -> NonEmpty (f a)
runNonEmptyF

-- | Technically, @f@ is over-constrained: we only need @'zero' :: f a@,
-- but we don't really have that typeclass in any standard hierarchies.  We
-- use 'Plus' here instead, but we never use '<!>'.  This would only go
-- wrong in situations where your type supports 'zero' but not '<!>', like
-- instances of 'Control.Monad.Fail.MonadFail' without
-- 'Control.Monad.MonadPlus'.
instance Plus f => Interpret MaybeF f where
    retract :: MaybeF f x -> f x
retract     = f x -> Maybe (f x) -> f x
forall a. a -> Maybe a -> a
fromMaybe f x
forall (f :: * -> *) a. Plus f => f a
zero (Maybe (f x) -> f x)
-> (MaybeF f x -> Maybe (f x)) -> MaybeF f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeF f x -> Maybe (f x)
forall k (f :: k -> *) (a :: k). MaybeF f a -> Maybe (f a)
runMaybeF
    interpret :: (g ~> f) -> MaybeF g ~> f
interpret f :: g ~> f
f = f x -> (g x -> f x) -> Maybe (g x) -> f x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f x
forall (f :: * -> *) a. Plus f => f a
zero g x -> f x
g ~> f
f (Maybe (g x) -> f x)
-> (MaybeF g x -> Maybe (g x)) -> MaybeF g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeF g x -> Maybe (g x)
forall k (f :: k -> *) (a :: k). MaybeF f a -> Maybe (f a)
runMaybeF

instance (Monoid k, Plus f) => Interpret (MapF k) f where
    retract :: MapF k f x -> f x
retract = (f x -> f x -> f x) -> f x -> Map k (f x) -> f x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f x -> f x -> f x
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) f x
forall (f :: * -> *) a. Plus f => f a
zero (Map k (f x) -> f x)
-> (MapF k f x -> Map k (f x)) -> MapF k f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapF k f x -> Map k (f x)
forall k1 k2 (f :: k2 -> *) (a :: k2). MapF k1 f a -> Map k1 (f a)
runMapF
    interpret :: (g ~> f) -> MapF k g ~> f
interpret f :: g ~> f
f = (g x -> f x -> f x) -> f x -> Map k (g x) -> f x
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (f x -> f x -> f x
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) (f x -> f x -> f x) -> (g x -> f x) -> g x -> f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> f x
g ~> f
f) f x
forall (f :: * -> *) a. Plus f => f a
zero (Map k (g x) -> f x)
-> (MapF k g x -> Map k (g x)) -> MapF k g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapF k g x -> Map k (g x)
forall k1 k2 (f :: k2 -> *) (a :: k2). MapF k1 f a -> Map k1 (f a)
runMapF

instance (Monoid k, Alt f) => Interpret (NEMapF k) f where
    retract :: NEMapF k f x -> f x
retract = NEMap k (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NEMap k (f x) -> f x)
-> (NEMapF k f x -> NEMap k (f x)) -> NEMapF k f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMapF k f x -> NEMap k (f x)
forall k1 k2 (f :: k2 -> *) (a :: k2).
NEMapF k1 f a -> NEMap k1 (f a)
runNEMapF
    interpret :: (g ~> f) -> NEMapF k g ~> f
interpret f :: g ~> f
f = NEMap k (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NEMap k (f x) -> f x)
-> (NEMapF k g x -> NEMap k (f x)) -> NEMapF k g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g x -> f x) -> NEMap k (g x) -> NEMap k (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> f x
g ~> f
f (NEMap k (g x) -> NEMap k (f x))
-> (NEMapF k g x -> NEMap k (g x)) -> NEMapF k g x -> NEMap k (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMapF k g x -> NEMap k (g x)
forall k1 k2 (f :: k2 -> *) (a :: k2).
NEMapF k1 f a -> NEMap k1 (f a)
runNEMapF

-- | Equivalent to instance for @'EnvT' ('Data.Semigroup.Sum'
-- 'Numeric.Natural.Natural')@.
instance Interpret Step f where
    retract :: Step f x -> f x
retract = Step f x -> f x
forall k (f :: k -> *). Step f ~> f
stepVal
    interpret :: (g ~> f) -> Step g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x) -> (Step g x -> g x) -> Step g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step g x -> g x
forall k (f :: k -> *). Step f ~> f
stepVal

instance Alt f => Interpret Steps f where
    retract :: Steps f x -> f x
retract     = NEMap Natural (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NEMap Natural (f x) -> f x)
-> (Steps f x -> NEMap Natural (f x)) -> Steps f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Steps f x -> NEMap Natural (f x)
forall k (f :: k -> *) (a :: k). Steps f a -> NEMap Natural (f a)
getSteps
    interpret :: (g ~> f) -> Steps g ~> f
interpret f :: g ~> f
f = NEMap Natural (f x) -> f x
forall (t :: * -> *) (m :: * -> *) a.
(Foldable1 t, Alt m) =>
t (m a) -> m a
asum1 (NEMap Natural (f x) -> f x)
-> (Steps g x -> NEMap Natural (f x)) -> Steps g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g x -> f x) -> NEMap Natural (g x) -> NEMap Natural (f x)
forall a b k. (a -> b) -> NEMap k a -> NEMap k b
NEM.map g x -> f x
g ~> f
f (NEMap Natural (g x) -> NEMap Natural (f x))
-> (Steps g x -> NEMap Natural (g x))
-> Steps g x
-> NEMap Natural (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Steps g x -> NEMap Natural (g x)
forall k (f :: k -> *) (a :: k). Steps f a -> NEMap Natural (f a)
getSteps

-- | Equivalent to instance for @'EnvT' 'Data.Semigroup.Any'@ and @'HLift'
-- 'IdentityT'@.
instance Interpret Flagged f where
    retract :: Flagged f x -> f x
retract = Flagged f x -> f x
forall k (f :: k -> *). Flagged f ~> f
flaggedVal
    interpret :: (g ~> f) -> Flagged g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x) -> (Flagged g x -> g x) -> Flagged g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flagged g x -> g x
forall k (f :: k -> *). Flagged f ~> f
flaggedVal

-- | Technically, @f@ is over-constrained: we only need @'zero' :: f a@,
-- but we don't really have that typeclass in any standard hierarchies.  We
-- use 'Plus' here instead, but we never use '<!>'.  This would only go
-- wrong in situations where your type supports 'zero' but not '<!>', like
-- instances of 'Control.Monad.Fail.MonadFail' without
-- 'Control.Monad.MonadPlus'.
instance Plus f => Interpret (These1 g) f where
    retract :: These1 g f x -> f x
retract = \case
      This1  _   -> f x
forall (f :: * -> *) a. Plus f => f a
zero
      That1    y :: f x
y -> f x
y
      These1 _ y :: f x
y -> f x
y
    interpret :: (g ~> f) -> These1 g g ~> f
interpret f :: g ~> f
f = \case
      This1  _   -> f x
forall (f :: * -> *) a. Plus f => f a
zero
      That1    y :: g x
y -> g x -> f x
g ~> f
f g x
y
      These1 _ y :: g x
y -> g x -> f x
g ~> f
f g x
y

-- | A free 'Alternative'
instance Alternative f => Interpret Alt.Alt f where
    interpret :: (g ~> f) -> Alt g ~> f
interpret = (g ~> f) -> Alt g x -> f x
forall (f :: * -> *) (g :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
Alt.runAlt

instance Plus g => Interpret ((:*:) g) f where
    retract :: (:*:) g f x -> f x
retract (_ :*: y :: f x
y) = f x
y

instance Plus g => Interpret (Product g) f where
    retract :: Product g f x -> f x
retract (Pair _ y :: f x
y) = f x
y

-- | Technically, @f@ is over-constrained: we only need @'zero' :: f a@,
-- but we don't really have that typeclass in any standard hierarchies.  We
-- use 'Plus' here instead, but we never use '<!>'.  This would only go
-- wrong in situations where your type supports 'zero' but not '<!>', like
-- instances of 'Control.Monad.Fail.MonadFail' without
-- 'Control.Monad.MonadPlus'.
instance Plus f => Interpret ((:+:) g) f where
    retract :: (:+:) g f x -> f x
retract = \case
      L1 _ -> f x
forall (f :: * -> *) a. Plus f => f a
zero
      R1 y :: f x
y -> f x
y

-- | Technically, @f@ is over-constrained: we only need @'zero' :: f a@,
-- but we don't really have that typeclass in any standard hierarchies.  We
-- use 'Plus' here instead, but we never use '<!>'.  This would only go
-- wrong in situations where your type supports 'zero' but not '<!>', like
-- instances of 'Control.Monad.Fail.MonadFail' without
-- 'Control.Monad.MonadPlus'.
instance Plus f => Interpret (Sum g) f where
    retract :: Sum g f x -> f x
retract = \case
      InL _ -> f x
forall (f :: * -> *) a. Plus f => f a
zero
      InR y :: f x
y -> f x
y

instance Interpret (M1 i c) f where
    retract :: M1 i c f x -> f x
retract (M1 x :: f x
x) = f x
x
    interpret :: (g ~> f) -> M1 i c g ~> f
interpret f :: g ~> f
f (M1 x :: g x
x) = g x -> f x
g ~> f
f g x
x

-- | A free 'Monad'
instance Monad f => Interpret Free f where
    retract :: Free f x -> f x
retract   = Free f x -> f x
forall (f :: * -> *). Monad f => Free f ~> f
retractFree
    interpret :: (g ~> f) -> Free g ~> f
interpret = (g ~> f) -> Free g x -> f x
forall (g :: * -> *) (f :: * -> *).
Monad g =>
(f ~> g) -> Free f ~> g
interpretFree

-- | A free 'Bind'
instance Bind f => Interpret Free1 f where
    retract :: Free1 f x -> f x
retract   = Free1 f x -> f x
forall (f :: * -> *). Bind f => Free1 f ~> f
retractFree1
    interpret :: (g ~> f) -> Free1 g ~> f
interpret = (g ~> f) -> Free1 g x -> f x
forall (g :: * -> *) (f :: * -> *).
Bind g =>
(f ~> g) -> Free1 f ~> g
interpretFree1

-- | A free 'Applicative'
instance Applicative f => Interpret FA.Ap f where
    retract :: Ap f x -> f x
retract   = Ap f x -> f x
forall (f :: * -> *) a. Applicative f => Ap f a -> f a
FA.retractAp
    interpret :: (g ~> f) -> Ap g ~> f
interpret = (g ~> f) -> Ap g x -> f x
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
FA.runAp

-- | A free 'Applicative'
instance Applicative f => Interpret FAF.Ap f where
    retract :: Ap f x -> f x
retract   = Ap f x -> f x
forall (f :: * -> *) a. Applicative f => Ap f a -> f a
FAF.retractAp
    interpret :: (g ~> f) -> Ap g ~> f
interpret = (g ~> f) -> Ap g x -> f x
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
FAF.runAp

instance Interpret IdentityT f where
    retract :: IdentityT f x -> f x
retract = IdentityT f x -> f x
forall a b. Coercible a b => a -> b
coerce
    interpret :: (g ~> f) -> IdentityT g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x) -> (IdentityT g x -> g x) -> IdentityT g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT g x -> g x
forall k (f :: k -> *). IdentityT f ~> f
runIdentityT

-- | A free 'Pointed'
instance Pointed f => Interpret Lift f where
    retract :: Lift f x -> f x
retract   = (x -> f x) -> (f x -> f x) -> Lift f x -> f x
forall a r (f :: * -> *). (a -> r) -> (f a -> r) -> Lift f a -> r
elimLift x -> f x
forall (p :: * -> *) a. Pointed p => a -> p a
point f x -> f x
forall a. a -> a
id
    interpret :: (g ~> f) -> Lift g ~> f
interpret = (x -> f x) -> (g x -> f x) -> Lift g x -> f x
forall a r (f :: * -> *). (a -> r) -> (f a -> r) -> Lift f a -> r
elimLift x -> f x
forall (p :: * -> *) a. Pointed p => a -> p a
point

-- | A free 'Pointed'
instance Pointed f => Interpret MaybeApply f where
    retract :: MaybeApply f x -> f x
retract     = (f x -> f x) -> (x -> f x) -> Either (f x) x -> f x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either f x -> f x
forall a. a -> a
id x -> f x
forall (p :: * -> *) a. Pointed p => a -> p a
point (Either (f x) x -> f x)
-> (MaybeApply f x -> Either (f x) x) -> MaybeApply f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeApply f x -> Either (f x) x
forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply
    interpret :: (g ~> f) -> MaybeApply g ~> f
interpret f :: g ~> f
f = (g x -> f x) -> (x -> f x) -> Either (g x) x -> f x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either g x -> f x
g ~> f
f x -> f x
forall (p :: * -> *) a. Pointed p => a -> p a
point (Either (g x) x -> f x)
-> (MaybeApply g x -> Either (g x) x) -> MaybeApply g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeApply g x -> Either (g x) x
forall (f :: * -> *) a. MaybeApply f a -> Either (f a) a
runMaybeApply

instance Interpret Backwards f where
    retract :: Backwards f x -> f x
retract     = Backwards f x -> f x
forall k (f :: k -> *). Backwards f ~> f
forwards
    interpret :: (g ~> f) -> Backwards g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x) -> (Backwards g x -> g x) -> Backwards g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards g x -> g x
forall k (f :: k -> *). Backwards f ~> f
forwards

instance Interpret WrappedApplicative f where
    retract :: WrappedApplicative f x -> f x
retract     = WrappedApplicative f x -> f x
forall (f :: * -> *). WrappedApplicative f ~> f
unwrapApplicative
    interpret :: (g ~> f) -> WrappedApplicative g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x)
-> (WrappedApplicative g x -> g x) -> WrappedApplicative g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedApplicative g x -> g x
forall (f :: * -> *). WrappedApplicative f ~> f
unwrapApplicative

-- | A free 'MonadReader', but only when applied to a 'Monad'.
instance MonadReader r f => Interpret (ReaderT r) f where
    retract :: ReaderT r f x -> f x
retract     x :: ReaderT r f x
x = ReaderT r f x -> r -> f x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r f x
x (r -> f x) -> f r -> f x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< f r
forall r (m :: * -> *). MonadReader r m => m r
ask
    interpret :: (g ~> f) -> ReaderT r g ~> f
interpret f :: g ~> f
f x :: ReaderT r g x
x = g x -> f x
g ~> f
f (g x -> f x) -> (r -> g x) -> r -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r g x -> r -> g x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r g x
x (r -> f x) -> f r -> f x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< f r
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | This ignores the environment, so @'interpret' /= 'hbind'@
instance Monoid e => Interpret (EnvT e) f where
    retract :: EnvT e f x -> f x
retract     (EnvT _ x :: f x
x) = f x
x
    interpret :: (g ~> f) -> EnvT e g ~> f
interpret f :: g ~> f
f (EnvT _ x :: g x
x) = g x -> f x
g ~> f
f g x
x

instance Interpret Reverse f where
    retract :: Reverse f x -> f x
retract     = Reverse f x -> f x
forall k (f :: k -> *). Reverse f ~> f
getReverse
    interpret :: (g ~> f) -> Reverse g ~> f
interpret f :: g ~> f
f = g x -> f x
g ~> f
f (g x -> f x) -> (Reverse g x -> g x) -> Reverse g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reverse g x -> g x
forall k (f :: k -> *). Reverse f ~> f
getReverse

-- -- | The only way for this to obey @'retract' . 'inject' == 'id'@ is to
-- -- have it impossible to retract out of.
-- instance Impossible f => Interpret ProxyF f where
--     retract = nope . reProxy

-- reProxy :: p f a -> Proxy f
-- reProxy _ = Proxy

-- -- | The only way for this to obey @'retract' . 'inject' == 'id'@ is to
-- -- have it impossible to retract out of.
-- instance (Monoid e, Impossible f) => Interpret (ConstF e) f where
--     retract = nope . reProxy

-- | A constraint on @a@ for both @c a@ and @d a@.  Requiring @'AndC'
-- 'Show' 'Eq' a@ is the same as requiring @('Show' a, 'Eq' a)@.
class (c a, d a) => AndC c d a
instance (c a, d a) => AndC c d a

instance (Interpret s f, Interpret t f) => Interpret (ComposeT s t) f where
    retract :: ComposeT s t f x -> f x
retract     = (t f ~> f) -> s (t f) ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret t f ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract (s (t f) x -> f x)
-> (ComposeT s t f x -> s (t f) x) -> ComposeT s t f x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeT s t f x -> s (t f) x
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
ComposeT f g m a -> f (g m) a
getComposeT
    interpret :: (g ~> f) -> ComposeT s t g ~> f
interpret f :: g ~> f
f = (t g ~> f) -> s (t g) ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret ((g ~> f) -> t g ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret g ~> f
f) (s (t g) x -> f x)
-> (ComposeT s t g x -> s (t g) x) -> ComposeT s t g x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeT s t g x -> s (t g) x
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) a.
ComposeT f g m a -> f (g m) a
getComposeT

-- | Never uses 'inject'
instance Interpret t f => Interpret (HLift t) f where
    retract :: HLift t f x -> f x
retract = \case
      HPure  x :: f x
x -> f x
x
      HOther x :: t f x
x -> t f x -> f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract t f x
x
    interpret :: (g ~> f) -> HLift t g ~> f
interpret f :: g ~> f
f = \case
      HPure  x :: g x
x -> g x -> f x
g ~> f
f g x
x
      HOther x :: t g x
x -> (g ~> f) -> t g x -> f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret g ~> f
f t g x
x

-- | Never uses 'inject'
instance Interpret t f => Interpret (HFree t) f where
    retract :: HFree t f x -> f x
retract = \case
      HReturn x :: f x
x -> f x
x
      HJoin   x :: t (HFree t f) x
x -> (HFree t f ~> f) -> t (HFree t f) x -> f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
Interpret t f =>
(g ~> f) -> t g ~> f
interpret HFree t f ~> f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract t (HFree t f) x
x

-- | A newtype wrapper meant to be used to define polymorphic 'Interpret'
-- instances.  See documentation for 'Interpret' for more information.
--
-- Please do not ever define an instance of 'Interpret' "naked" on the
-- second parameter:
--
-- @
-- instance Interpret (WrapHF t) f
-- @
--
-- As that would globally ruin everything using 'WrapHF'.
newtype WrapHF t f a = WrapHF { WrapHF t f a -> t f a
unwrapHF :: t f a }
  deriving (Int -> WrapHF t f a -> ShowS
[WrapHF t f a] -> ShowS
WrapHF t f a -> String
(Int -> WrapHF t f a -> ShowS)
-> (WrapHF t f a -> String)
-> ([WrapHF t f a] -> ShowS)
-> Show (WrapHF t f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
Int -> WrapHF t f a -> ShowS
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
[WrapHF t f a] -> ShowS
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
WrapHF t f a -> String
showList :: [WrapHF t f a] -> ShowS
$cshowList :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
[WrapHF t f a] -> ShowS
show :: WrapHF t f a -> String
$cshow :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
WrapHF t f a -> String
showsPrec :: Int -> WrapHF t f a -> ShowS
$cshowsPrec :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Show (t f a) =>
Int -> WrapHF t f a -> ShowS
Show, ReadPrec [WrapHF t f a]
ReadPrec (WrapHF t f a)
Int -> ReadS (WrapHF t f a)
ReadS [WrapHF t f a]
(Int -> ReadS (WrapHF t f a))
-> ReadS [WrapHF t f a]
-> ReadPrec (WrapHF t f a)
-> ReadPrec [WrapHF t f a]
-> Read (WrapHF t f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadPrec [WrapHF t f a]
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadPrec (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
Int -> ReadS (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadS [WrapHF t f a]
readListPrec :: ReadPrec [WrapHF t f a]
$creadListPrec :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadPrec [WrapHF t f a]
readPrec :: ReadPrec (WrapHF t f a)
$creadPrec :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadPrec (WrapHF t f a)
readList :: ReadS [WrapHF t f a]
$creadList :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
ReadS [WrapHF t f a]
readsPrec :: Int -> ReadS (WrapHF t f a)
$creadsPrec :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Read (t f a) =>
Int -> ReadS (WrapHF t f a)
Read, WrapHF t f a -> WrapHF t f a -> Bool
(WrapHF t f a -> WrapHF t f a -> Bool)
-> (WrapHF t f a -> WrapHF t f a -> Bool) -> Eq (WrapHF t f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Eq (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
/= :: WrapHF t f a -> WrapHF t f a -> Bool
$c/= :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Eq (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
== :: WrapHF t f a -> WrapHF t f a -> Bool
$c== :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Eq (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
Eq, Eq (WrapHF t f a)
Eq (WrapHF t f a) =>
(WrapHF t f a -> WrapHF t f a -> Ordering)
-> (WrapHF t f a -> WrapHF t f a -> Bool)
-> (WrapHF t f a -> WrapHF t f a -> Bool)
-> (WrapHF t f a -> WrapHF t f a -> Bool)
-> (WrapHF t f a -> WrapHF t f a -> Bool)
-> (WrapHF t f a -> WrapHF t f a -> WrapHF t f a)
-> (WrapHF t f a -> WrapHF t f a -> WrapHF t f a)
-> Ord (WrapHF t f a)
WrapHF t f a -> WrapHF t f a -> Bool
WrapHF t f a -> WrapHF t f a -> Ordering
WrapHF t f a -> WrapHF t f a -> WrapHF t f a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
Eq (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Ordering
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> WrapHF t f a
min :: WrapHF t f a -> WrapHF t f a -> WrapHF t f a
$cmin :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> WrapHF t f a
max :: WrapHF t f a -> WrapHF t f a -> WrapHF t f a
$cmax :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> WrapHF t f a
>= :: WrapHF t f a -> WrapHF t f a -> Bool
$c>= :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
> :: WrapHF t f a -> WrapHF t f a -> Bool
$c> :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
<= :: WrapHF t f a -> WrapHF t f a -> Bool
$c<= :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
< :: WrapHF t f a -> WrapHF t f a -> Bool
$c< :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Bool
compare :: WrapHF t f a -> WrapHF t f a -> Ordering
$ccompare :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
WrapHF t f a -> WrapHF t f a -> Ordering
$cp1Ord :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
Ord (t f a) =>
Eq (WrapHF t f a)
Ord, a -> WrapHF t f b -> WrapHF t f a
(a -> b) -> WrapHF t f a -> WrapHF t f b
(forall a b. (a -> b) -> WrapHF t f a -> WrapHF t f b)
-> (forall a b. a -> WrapHF t f b -> WrapHF t f a)
-> Functor (WrapHF t f)
forall a b. a -> WrapHF t f b -> WrapHF t f a
forall a b. (a -> b) -> WrapHF t f a -> WrapHF t f b
forall k (t :: k -> * -> *) (f :: k) a b.
Functor (t f) =>
a -> WrapHF t f b -> WrapHF t f a
forall k (t :: k -> * -> *) (f :: k) a b.
Functor (t f) =>
(a -> b) -> WrapHF t f a -> WrapHF t f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WrapHF t f b -> WrapHF t f a
$c<$ :: forall k (t :: k -> * -> *) (f :: k) a b.
Functor (t f) =>
a -> WrapHF t f b -> WrapHF t f a
fmap :: (a -> b) -> WrapHF t f a -> WrapHF t f b
$cfmap :: forall k (t :: k -> * -> *) (f :: k) a b.
Functor (t f) =>
(a -> b) -> WrapHF t f a -> WrapHF t f b
Functor, a -> WrapHF t f a -> Bool
WrapHF t f m -> m
WrapHF t f a -> [a]
WrapHF t f a -> Bool
WrapHF t f a -> Int
WrapHF t f a -> a
WrapHF t f a -> a
WrapHF t f a -> a
WrapHF t f a -> a
(a -> m) -> WrapHF t f a -> m
(a -> m) -> WrapHF t f a -> m
(a -> b -> b) -> b -> WrapHF t f a -> b
(a -> b -> b) -> b -> WrapHF t f a -> b
(b -> a -> b) -> b -> WrapHF t f a -> b
(b -> a -> b) -> b -> WrapHF t f a -> b
(a -> a -> a) -> WrapHF t f a -> a
(a -> a -> a) -> WrapHF t f a -> a
(forall m. Monoid m => WrapHF t f m -> m)
-> (forall m a. Monoid m => (a -> m) -> WrapHF t f a -> m)
-> (forall m a. Monoid m => (a -> m) -> WrapHF t f a -> m)
-> (forall a b. (a -> b -> b) -> b -> WrapHF t f a -> b)
-> (forall a b. (a -> b -> b) -> b -> WrapHF t f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WrapHF t f a -> b)
-> (forall b a. (b -> a -> b) -> b -> WrapHF t f a -> b)
-> (forall a. (a -> a -> a) -> WrapHF t f a -> a)
-> (forall a. (a -> a -> a) -> WrapHF t f a -> a)
-> (forall a. WrapHF t f a -> [a])
-> (forall a. WrapHF t f a -> Bool)
-> (forall a. WrapHF t f a -> Int)
-> (forall a. Eq a => a -> WrapHF t f a -> Bool)
-> (forall a. Ord a => WrapHF t f a -> a)
-> (forall a. Ord a => WrapHF t f a -> a)
-> (forall a. Num a => WrapHF t f a -> a)
-> (forall a. Num a => WrapHF t f a -> a)
-> Foldable (WrapHF t f)
forall a. Eq a => a -> WrapHF t f a -> Bool
forall a. Num a => WrapHF t f a -> a
forall a. Ord a => WrapHF t f a -> a
forall m. Monoid m => WrapHF t f m -> m
forall a. WrapHF t f a -> Bool
forall a. WrapHF t f a -> Int
forall a. WrapHF t f a -> [a]
forall a. (a -> a -> a) -> WrapHF t f a -> a
forall m a. Monoid m => (a -> m) -> WrapHF t f a -> m
forall b a. (b -> a -> b) -> b -> WrapHF t f a -> b
forall a b. (a -> b -> b) -> b -> WrapHF t f a -> b
forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Eq a) =>
a -> WrapHF t f a -> Bool
forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Num a) =>
WrapHF t f a -> a
forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Ord a) =>
WrapHF t f a -> a
forall k (t :: k -> * -> *) (f :: k) m.
(Foldable (t f), Monoid m) =>
WrapHF t f m -> m
forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> Bool
forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> Int
forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> [a]
forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
(a -> a -> a) -> WrapHF t f a -> a
forall k (t :: k -> * -> *) (f :: k) m a.
(Foldable (t f), Monoid m) =>
(a -> m) -> WrapHF t f a -> m
forall k (t :: k -> * -> *) (f :: k) b a.
Foldable (t f) =>
(b -> a -> b) -> b -> WrapHF t f a -> b
forall k (t :: k -> * -> *) (f :: k) a b.
Foldable (t f) =>
(a -> b -> b) -> b -> WrapHF t f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: WrapHF t f a -> a
$cproduct :: forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Num a) =>
WrapHF t f a -> a
sum :: WrapHF t f a -> a
$csum :: forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Num a) =>
WrapHF t f a -> a
minimum :: WrapHF t f a -> a
$cminimum :: forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Ord a) =>
WrapHF t f a -> a
maximum :: WrapHF t f a -> a
$cmaximum :: forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Ord a) =>
WrapHF t f a -> a
elem :: a -> WrapHF t f a -> Bool
$celem :: forall k (t :: k -> * -> *) (f :: k) a.
(Foldable (t f), Eq a) =>
a -> WrapHF t f a -> Bool
length :: WrapHF t f a -> Int
$clength :: forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> Int
null :: WrapHF t f a -> Bool
$cnull :: forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> Bool
toList :: WrapHF t f a -> [a]
$ctoList :: forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
WrapHF t f a -> [a]
foldl1 :: (a -> a -> a) -> WrapHF t f a -> a
$cfoldl1 :: forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
(a -> a -> a) -> WrapHF t f a -> a
foldr1 :: (a -> a -> a) -> WrapHF t f a -> a
$cfoldr1 :: forall k (t :: k -> * -> *) (f :: k) a.
Foldable (t f) =>
(a -> a -> a) -> WrapHF t f a -> a
foldl' :: (b -> a -> b) -> b -> WrapHF t f a -> b
$cfoldl' :: forall k (t :: k -> * -> *) (f :: k) b a.
Foldable (t f) =>
(b -> a -> b) -> b -> WrapHF t f a -> b
foldl :: (b -> a -> b) -> b -> WrapHF t f a -> b
$cfoldl :: forall k (t :: k -> * -> *) (f :: k) b a.
Foldable (t f) =>
(b -> a -> b) -> b -> WrapHF t f a -> b
foldr' :: (a -> b -> b) -> b -> WrapHF t f a -> b
$cfoldr' :: forall k (t :: k -> * -> *) (f :: k) a b.
Foldable (t f) =>
(a -> b -> b) -> b -> WrapHF t f a -> b
foldr :: (a -> b -> b) -> b -> WrapHF t f a -> b
$cfoldr :: forall k (t :: k -> * -> *) (f :: k) a b.
Foldable (t f) =>
(a -> b -> b) -> b -> WrapHF t f a -> b
foldMap' :: (a -> m) -> WrapHF t f a -> m
$cfoldMap' :: forall k (t :: k -> * -> *) (f :: k) m a.
(Foldable (t f), Monoid m) =>
(a -> m) -> WrapHF t f a -> m
foldMap :: (a -> m) -> WrapHF t f a -> m
$cfoldMap :: forall k (t :: k -> * -> *) (f :: k) m a.
(Foldable (t f), Monoid m) =>
(a -> m) -> WrapHF t f a -> m
fold :: WrapHF t f m -> m
$cfold :: forall k (t :: k -> * -> *) (f :: k) m.
(Foldable (t f), Monoid m) =>
WrapHF t f m -> m
Foldable, Functor (WrapHF t f)
Foldable (WrapHF t f)
(Functor (WrapHF t f), Foldable (WrapHF t f)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WrapHF t f a -> f (WrapHF t f b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WrapHF t f (f a) -> f (WrapHF t f a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WrapHF t f a -> m (WrapHF t f b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WrapHF t f (m a) -> m (WrapHF t f a))
-> Traversable (WrapHF t f)
(a -> f b) -> WrapHF t f a -> f (WrapHF t f b)
forall k (t :: k -> * -> *) (f :: k).
Traversable (t f) =>
Functor (WrapHF t f)
forall k (t :: k -> * -> *) (f :: k).
Traversable (t f) =>
Foldable (WrapHF t f)
forall k (t :: k -> * -> *) (f :: k) (m :: * -> *) a.
(Traversable (t f), Monad m) =>
WrapHF t f (m a) -> m (WrapHF t f a)
forall k (t :: k -> * -> *) (f :: k) (f :: * -> *) a.
(Traversable (t f), Applicative f) =>
WrapHF t f (f a) -> f (WrapHF t f a)
forall k (t :: k -> * -> *) (f :: k) (m :: * -> *) a b.
(Traversable (t f), Monad m) =>
(a -> m b) -> WrapHF t f a -> m (WrapHF t f b)
forall k (t :: k -> * -> *) (f :: k) (f :: * -> *) a b.
(Traversable (t f), Applicative f) =>
(a -> f b) -> WrapHF t f a -> f (WrapHF t f b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WrapHF t f (m a) -> m (WrapHF t f a)
forall (f :: * -> *) a.
Applicative f =>
WrapHF t f (f a) -> f (WrapHF t f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WrapHF t f a -> m (WrapHF t f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WrapHF t f a -> f (WrapHF t f b)
sequence :: WrapHF t f (m a) -> m (WrapHF t f a)
$csequence :: forall k (t :: k -> * -> *) (f :: k) (m :: * -> *) a.
(Traversable (t f), Monad m) =>
WrapHF t f (m a) -> m (WrapHF t f a)
mapM :: (a -> m b) -> WrapHF t f a -> m (WrapHF t f b)
$cmapM :: forall k (t :: k -> * -> *) (f :: k) (m :: * -> *) a b.
(Traversable (t f), Monad m) =>
(a -> m b) -> WrapHF t f a -> m (WrapHF t f b)
sequenceA :: WrapHF t f (f a) -> f (WrapHF t f a)
$csequenceA :: forall k (t :: k -> * -> *) (f :: k) (f :: * -> *) a.
(Traversable (t f), Applicative f) =>
WrapHF t f (f a) -> f (WrapHF t f a)
traverse :: (a -> f b) -> WrapHF t f a -> f (WrapHF t f b)
$ctraverse :: forall k (t :: k -> * -> *) (f :: k) (f :: * -> *) a b.
(Traversable (t f), Applicative f) =>
(a -> f b) -> WrapHF t f a -> f (WrapHF t f b)
$cp2Traversable :: forall k (t :: k -> * -> *) (f :: k).
Traversable (t f) =>
Foldable (WrapHF t f)
$cp1Traversable :: forall k (t :: k -> * -> *) (f :: k).
Traversable (t f) =>
Functor (WrapHF t f)
Traversable, Typeable, (forall x. WrapHF t f a -> Rep (WrapHF t f a) x)
-> (forall x. Rep (WrapHF t f a) x -> WrapHF t f a)
-> Generic (WrapHF t f a)
forall x. Rep (WrapHF t f a) x -> WrapHF t f a
forall x. WrapHF t f a -> Rep (WrapHF t f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (t :: k -> k -> *) (f :: k) (a :: k) x.
Rep (WrapHF t f a) x -> WrapHF t f a
forall k k (t :: k -> k -> *) (f :: k) (a :: k) x.
WrapHF t f a -> Rep (WrapHF t f a) x
$cto :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) x.
Rep (WrapHF t f a) x -> WrapHF t f a
$cfrom :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) x.
WrapHF t f a -> Rep (WrapHF t f a) x
Generic, Typeable (WrapHF t f a)
DataType
Constr
Typeable (WrapHF t f a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (WrapHF t f a))
-> (WrapHF t f a -> Constr)
-> (WrapHF t f a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (WrapHF t f a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (WrapHF t f a)))
-> ((forall b. Data b => b -> b) -> WrapHF t f a -> WrapHF t f a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r)
-> (forall u. (forall d. Data d => d -> u) -> WrapHF t f a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WrapHF t f a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a))
-> Data (WrapHF t f a)
WrapHF t f a -> DataType
WrapHF t f a -> Constr
(forall b. Data b => b -> b) -> WrapHF t f a -> WrapHF t f a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (WrapHF t f a)
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WrapHF t f a -> u
forall u. (forall d. Data d => d -> u) -> WrapHF t f a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
Typeable (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
WrapHF t f a -> DataType
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
WrapHF t f a -> Constr
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall b. Data b => b -> b) -> WrapHF t f a -> WrapHF t f a
forall k k (t :: k -> k -> *) (f :: k) (a :: k) u.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
Int -> (forall d. Data d => d -> u) -> WrapHF t f a -> u
forall k k (t :: k -> k -> *) (f :: k) (a :: k) u.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall d. Data d => d -> u) -> WrapHF t f a -> [u]
forall k k (t :: k -> k -> *) (f :: k) (a :: k) r r'.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
forall k k (t :: k -> k -> *) (f :: k) (a :: k) r r'.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (m :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Monad m) =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (m :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a)
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (WrapHF t f a))
forall k k (t :: k -> k -> *) (f :: k) (a :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (WrapHF t f a))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (WrapHF t f a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (WrapHF t f a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (WrapHF t f a))
$cWrapHF :: Constr
$tWrapHF :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
$cgmapMo :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (m :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
gmapMp :: (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
$cgmapMp :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (m :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
gmapM :: (forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
$cgmapM :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (m :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Monad m) =>
(forall d. Data d => d -> m d) -> WrapHF t f a -> m (WrapHF t f a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> WrapHF t f a -> u
$cgmapQi :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) u.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
Int -> (forall d. Data d => d -> u) -> WrapHF t f a -> u
gmapQ :: (forall d. Data d => d -> u) -> WrapHF t f a -> [u]
$cgmapQ :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) u.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall d. Data d => d -> u) -> WrapHF t f a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
$cgmapQr :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) r r'.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
$cgmapQl :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) r r'.
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WrapHF t f a -> r
gmapT :: (forall b. Data b => b -> b) -> WrapHF t f a -> WrapHF t f a
$cgmapT :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall b. Data b => b -> b) -> WrapHF t f a -> WrapHF t f a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (WrapHF t f a))
$cdataCast2 :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (WrapHF t f a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (WrapHF t f a))
$cdataCast1 :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (WrapHF t f a))
dataTypeOf :: WrapHF t f a -> DataType
$cdataTypeOf :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
WrapHF t f a -> DataType
toConstr :: WrapHF t f a -> Constr
$ctoConstr :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
WrapHF t f a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (WrapHF t f a)
$cgunfold :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (WrapHF t f a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a)
$cgfoldl :: forall k k (t :: k -> k -> *) (f :: k) (a :: k) (c :: * -> *).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WrapHF t f a -> c (WrapHF t f a)
$cp1Data :: forall k k (t :: k -> k -> *) (f :: k) (a :: k).
(Typeable f, Typeable a, Typeable t, Typeable k, Typeable k,
 Data (t f a)) =>
Typeable (WrapHF t f a)
Data)

instance Show1 (t f) => Show1 (WrapHF t f) where
    liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> WrapHF t f a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d (WrapHF x :: t f a
x) = (Int -> t f a -> ShowS) -> String -> Int -> t f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> t f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "WrapHF" Int
d t f a
x

instance Eq1 (t f) => Eq1 (WrapHF t f) where
    liftEq :: (a -> b -> Bool) -> WrapHF t f a -> WrapHF t f b -> Bool
liftEq eq :: a -> b -> Bool
eq (WrapHF x :: t f a
x) (WrapHF y :: t f b
y) = (a -> b -> Bool) -> t f a -> t f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq t f a
x t f b
y

instance Ord1 (t f) => Ord1 (WrapHF t f) where
    liftCompare :: (a -> b -> Ordering) -> WrapHF t f a -> WrapHF t f b -> Ordering
liftCompare c :: a -> b -> Ordering
c (WrapHF x :: t f a
x) (WrapHF y :: t f b
y) = (a -> b -> Ordering) -> t f a -> t f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
c t f a
x t f b
y

instance HFunctor t => HFunctor (WrapHF t) where
    hmap :: (f ~> g) -> WrapHF t f ~> WrapHF t g
hmap f :: f ~> g
f (WrapHF x :: t f x
x) = t g x -> WrapHF t g x
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
t f a -> WrapHF t f a
WrapHF ((f ~> g) -> t f x -> t g x
forall k k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HFunctor t =>
(f ~> g) -> t f ~> t g
hmap f ~> g
f t f x
x)

instance Inject t => Inject (WrapHF t) where
    inject :: f x -> WrapHF t f x
inject = t f x -> WrapHF t f x
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
t f a -> WrapHF t f a
WrapHF (t f x -> WrapHF t f x) -> (f x -> t f x) -> f x -> WrapHF t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> t f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

instance HBind t => HBind (WrapHF t) where
    hbind :: (f ~> WrapHF t g) -> WrapHF t f ~> WrapHF t g
hbind f :: f ~> WrapHF t g
f (WrapHF x :: t f x
x) = t g x -> WrapHF t g x
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
t f a -> WrapHF t f a
WrapHF ((f ~> t g) -> t f x -> t g x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HBind t =>
(f ~> t g) -> t f ~> t g
hbind (WrapHF t g x -> t g x
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
WrapHF t f a -> t f a
unwrapHF (WrapHF t g x -> t g x) -> (f x -> WrapHF t g x) -> f x -> t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> WrapHF t g x
f ~> WrapHF t g
f) t f x
x)
    hjoin :: WrapHF t (WrapHF t f) x -> WrapHF t f x
hjoin (WrapHF x :: t (WrapHF t f) x
x) = t f x -> WrapHF t f x
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
t f a -> WrapHF t f a
WrapHF ((WrapHF t f ~> t f) -> t (WrapHF t f) x -> t f x
forall k (t :: (k -> *) -> k -> *) (f :: k -> *) (g :: k -> *).
HBind t =>
(f ~> t g) -> t f ~> t g
hbind WrapHF t f ~> t f
forall k k (t :: k -> k -> *) (f :: k) (a :: k).
WrapHF t f a -> t f a
unwrapHF t (WrapHF t f) x
x)