{-# OPTIONS_HADDOCK hide, not-home #-}

module Data.HFunctor.Chain.Internal (
    Chain1(..)
  , foldChain1, unfoldChain1
  , foldChain1A
  , toChain1, injectChain1
  , matchChain1
  , Chain(..)
  , foldChain, unfoldChain
  , foldChainA
  , splittingChain, unconsChain
  , DivAp1(..)
  , DivAp(..)
  , DecAlt(..)
  , DecAlt1(..)
  ) where

import           Control.Monad.Freer.Church
import           Control.Natural
import           Control.Natural.IsoF
import           Data.Functor.Apply
import           Data.Functor.Classes
import           Data.Functor.Contravariant
import           Data.Functor.Identity
import           Data.Functor.Invariant
import           Data.Functor.Invariant.Internative
import           Data.HBifunctor
import           Data.HFunctor
import           Data.HFunctor.Interpret
import           Data.HFunctor.HTraversable
import           Data.Kind
import           Data.Typeable
import           Data.Void
import           GHC.Generics
import qualified Data.Functor.Invariant.Day   as ID
import qualified Data.Functor.Invariant.Night as IN


-- | A useful construction that works like a "non-empty linked list" of @t
-- f@ applied to itself multiple times.  That is, it contains @t f f@, @t
-- f (t f f)@, @t f (t f (t f f))@, etc, with @f@ occuring /one or more/
-- times.  It is meant to be the same as @'NonEmptyBy' t@.
--
-- A @'Chain1' t f a@ is explicitly one of:
--
-- *  @f a@
-- *  @t f f a@
-- *  @t f (t f f) a@
-- *  @t f (t f (t f f)) a@
-- *  .. etc
--
-- Note that this is exactly the description of @'NonEmptyBy' t@.  And that's "the
-- point": for all instances of 'Associative', @'Chain1' t@ is
-- isomorphic to @'NonEmptyBy' t@ (witnessed by 'unrollingNE').  That's big picture
-- of 'NonEmptyBy': it's supposed to be a type that consists of all possible
-- self-applications of @f@ to @t@.
--
-- 'Chain1' gives you a way to work with all @'NonEmptyBy' t@ in a uniform way.
-- Unlike for @'NonEmptyBy' t f@ in general, you can always explicitly /pattern
-- match/ on a 'Chain1' (with its two constructors) and do what you please
-- with it.  You can also /construct/ 'Chain1' using normal constructors
-- and functions.
--
-- You can convert in between @'NonEmptyBy' t f@ and @'Chain1' t f@ with 'unrollNE'
-- and 'rerollNE'.  You can fully "collapse" a @'Chain1' t f@ into an @f@
-- with 'retract', if you have @'SemigroupIn' t f@; this could be considered
-- a fundamental property of semigroup-ness.
--
-- See 'Chain' for a version that has an "empty" value.
--
-- Another way of thinking of this is that @'Chain1' t@ is the "free
-- @'SemigroupIn' t@".  Given any functor @f@, @'Chain1' t f@ is
-- a semigroup in the semigroupoidal category of endofunctors enriched by
-- @t@.  So, @'Chain1' 'Control.Monad.Freer.Church.Comp'@ is the "free
-- 'Data.Functor.Bind.Bind'", @'Chain1' 'Day'@ is the "free
-- 'Data.Functor.Apply.Apply'", etc. You "lift" from @f a@ to @'Chain1'
-- t f a@ using 'inject'.
--
-- Note: this instance doesn't exist directly because of restrictions in
-- typeclasses, but is implemented as
--
-- @
-- 'Associative' t => 'SemigroupIn' ('WrapHBF' t) ('Chain1' t f)
-- @
--
-- where 'biretract' is 'appendChain1'.
--
-- You can fully "collapse" a @'Chain' t i f@ into an @f@ with
-- 'retract', if you have @'MonoidIn' t i f@; this could be considered
-- a fundamental property of monoid-ness.
--
--
-- This construction is inspired by iteratees and machines.
data Chain1 t f a = Done1 (f a)
                  | More1 (t f (Chain1 t f) a)
  deriving (Typeable, (forall x. Chain1 t f a -> Rep (Chain1 t f a) x)
-> (forall x. Rep (Chain1 t f a) x -> Chain1 t f a)
-> Generic (Chain1 t f a)
forall x. Rep (Chain1 t f a) x -> Chain1 t f a
forall x. Chain1 t f a -> Rep (Chain1 t f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k) x.
Rep (Chain1 t f a) x -> Chain1 t f a
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k) x.
Chain1 t f a -> Rep (Chain1 t f a) x
$cfrom :: forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k) x.
Chain1 t f a -> Rep (Chain1 t f a) x
from :: forall x. Chain1 t f a -> Rep (Chain1 t f a) x
$cto :: forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k) x.
Rep (Chain1 t f a) x -> Chain1 t f a
to :: forall x. Rep (Chain1 t f a) x -> Chain1 t f a
Generic)

deriving instance (Eq (f a), Eq (t f (Chain1 t f) a)) => Eq (Chain1 t f a)
deriving instance (Ord (f a), Ord (t f (Chain1 t f) a)) => Ord (Chain1 t f a)
deriving instance (Show (f a), Show (t f (Chain1 t f) a)) => Show (Chain1 t f a)
deriving instance (Read (f a), Read (t f (Chain1 t f) a)) => Read (Chain1 t f a)
deriving instance (Functor f, Functor (t f (Chain1 t f))) => Functor (Chain1 t f)
deriving instance (Foldable f, Foldable (t f (Chain1 t f))) => Foldable (Chain1 t f)
deriving instance (Traversable f, Traversable (t f (Chain1 t f))) => Traversable (Chain1 t f)

instance (Eq1 f, Eq1 (t f (Chain1 t f))) => Eq1 (Chain1 t f) where
    liftEq :: forall a b.
(a -> b -> Bool) -> Chain1 t f a -> Chain1 t f b -> Bool
liftEq a -> b -> Bool
eq = \case
      Done1 f a
x -> \case
        Done1 f b
y -> (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
x f b
y
        More1 t f (Chain1 t f) b
_ -> Bool
False
      More1 t f (Chain1 t f) a
x -> \case
        Done1 f b
_ -> Bool
False
        More1 t f (Chain1 t f) b
y -> (a -> b -> Bool)
-> t f (Chain1 t f) a -> t f (Chain1 t f) b -> Bool
forall a b.
(a -> b -> Bool)
-> t f (Chain1 t f) a -> t f (Chain1 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 (Chain1 t f) a
x t f (Chain1 t f) b
y

instance (Ord1 f, Ord1 (t f (Chain1 t f))) => Ord1 (Chain1 t f) where
    liftCompare :: forall a b.
(a -> b -> Ordering) -> Chain1 t f a -> Chain1 t f b -> Ordering
liftCompare a -> b -> Ordering
c = \case
      Done1 f a
x -> \case
        Done1 f b
y -> (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
c f a
x f b
y
        More1 t f (Chain1 t f) b
_ -> Ordering
LT
      More1 t f (Chain1 t f) a
x -> \case
        Done1 f b
_ -> Ordering
GT
        More1 t f (Chain1 t f) b
y -> (a -> b -> Ordering)
-> t f (Chain1 t f) a -> t f (Chain1 t f) b -> Ordering
forall a b.
(a -> b -> Ordering)
-> t f (Chain1 t f) a -> t f (Chain1 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 (Chain1 t f) a
x t f (Chain1 t f) b
y

instance (Show1 (t f (Chain1 t f)), Show1 f) => Show1 (Chain1 t f) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Chain1 t f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \case
        Done1 f a
x  -> (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> 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) String
"Done1" Int
d f a
x
        More1 t f (Chain1 t f) a
xs -> (Int -> t f (Chain1 t f) a -> ShowS)
-> String -> Int -> t f (Chain1 t f) a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> t f (Chain1 t f) a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> t f (Chain1 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) String
"More1" Int
d t f (Chain1 t f) a
xs

instance (Functor f, Read1 (t f (Chain1 t f)), Read1 f) => Read1 (Chain1 t f) where
    liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Chain1 t f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (Chain1 t f a)) -> Int -> ReadS (Chain1 t f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Chain1 t f a)) -> Int -> ReadS (Chain1 t f a))
-> (String -> ReadS (Chain1 t f a)) -> Int -> ReadS (Chain1 t f a)
forall a b. (a -> b) -> a -> b
$
            (Int -> ReadS (f a))
-> String
-> (f a -> Chain1 t f a)
-> String
-> ReadS (Chain1 t f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"Done1" f a -> Chain1 t f a
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1
         (String -> ReadS (Chain1 t f a))
-> (String -> ReadS (Chain1 t f a))
-> String
-> ReadS (Chain1 t f a)
forall a. Semigroup a => a -> a -> a
<> (Int -> ReadS (t f (Chain1 t f) a))
-> String
-> (t f (Chain1 t f) a -> Chain1 t f a)
-> String
-> ReadS (Chain1 t f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (t f (Chain1 t f) a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (t f (Chain1 t f) a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"More1" t f (Chain1 t f) a -> Chain1 t f a
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1

-- | @since 0.3.0.0
instance (Contravariant f, Contravariant (t f (Chain1 t f))) => Contravariant (Chain1 t f) where
    contramap :: forall a' a. (a' -> a) -> Chain1 t f a -> Chain1 t f a'
contramap a' -> a
f = \case
      Done1 f a
x  -> f a' -> Chain1 t f a'
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1 ((a' -> a) -> f a -> f a'
forall a' a. (a' -> a) -> f a -> f a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f f a
x )
      More1 t f (Chain1 t f) a
xs -> t f (Chain1 t f) a' -> Chain1 t f a'
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 ((a' -> a) -> t f (Chain1 t f) a -> t f (Chain1 t f) a'
forall a' a. (a' -> a) -> t f (Chain1 t f) a -> t f (Chain1 t f) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f t f (Chain1 t f) a
xs)

-- | @since 0.3.0.0
instance (Invariant f, Invariant (t f (Chain1 t f))) => Invariant (Chain1 t f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Chain1 t f a -> Chain1 t f b
invmap a -> b
f b -> a
g = \case
      Done1 f a
x  -> f b -> Chain1 t f b
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1 ((a -> b) -> (b -> a) -> f a -> f b
forall a b. (a -> b) -> (b -> a) -> f a -> f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g f a
x )
      More1 t f (Chain1 t f) a
xs -> t f (Chain1 t f) b -> Chain1 t f b
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 ((a -> b) -> (b -> a) -> t f (Chain1 t f) a -> t f (Chain1 t f) b
forall a b.
(a -> b) -> (b -> a) -> t f (Chain1 t f) a -> t f (Chain1 t f) b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g t f (Chain1 t f) a
xs)

instance HBifunctor t => HFunctor (Chain1 t) where
    hmap :: forall (f :: k1 -> *) (g :: k1 -> *).
(f ~> g) -> Chain1 t f ~> Chain1 t g
hmap f ~> g
f = (f ~> Chain1 t g)
-> (t f (Chain1 t g) ~> Chain1 t g) -> Chain1 t f ~> Chain1 t g
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 (g x -> Chain1 t g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1 (g x -> Chain1 t g x) -> (f x -> g x) -> f x -> Chain1 t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> g x
f ~> g
f) (t g (Chain1 t g) x -> Chain1 t g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (t g (Chain1 t g) x -> Chain1 t g x)
-> (t f (Chain1 t g) x -> t g (Chain1 t g) x)
-> t f (Chain1 t g) x
-> Chain1 t g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> g) -> t f (Chain1 t g) ~> t g (Chain1 t g)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *).
HBifunctor t =>
(f ~> j) -> t f g ~> t j g
forall (f :: k1 -> *) (j :: k1 -> *) (g :: k1 -> *).
(f ~> j) -> t f g ~> t j g
hleft f x -> g x
f ~> g
f)

instance HBifunctor t => Inject (Chain1 t) where
    inject :: forall (f :: k -> *). f ~> Chain1 t f
inject  = f x -> Chain1 t f x
forall {k} (f :: k -> *) (t :: (k -> *) -> (k -> *) -> k -> *)
       (x :: k).
f x -> Chain1 t f x
injectChain1

-- | Recursively fold down a 'Chain1'.  Provide a function on how to handle
-- the "single @f@ case" ('inject'), and how to handle the "combined @t
-- f g@ case", and this will fold the entire @'Chain1' t f@ into a single
-- @g@.
--
-- This is a catamorphism.
foldChain1
    :: forall t f g. HBifunctor t
    => f ~> g                   -- ^ handle 'Done1'
    -> t f g ~> g               -- ^ handle 'More1'
    -> Chain1 t f ~> g
foldChain1 :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 f ~> g
f t f g ~> g
g = Chain1 t f x -> g x
Chain1 t f ~> g
go
  where
    go :: Chain1 t f ~> g
    go :: Chain1 t f ~> g
go = \case
      Done1 f x
x  -> f x -> g x
f ~> g
f f x
x
      More1 t f (Chain1 t f) x
xs -> t f g x -> g x
t f g ~> g
g ((Chain1 t f ~> g) -> t f (Chain1 t f) ~> t f g
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> t f g ~> t f l
hright Chain1 t f x -> g x
Chain1 t f ~> g
go t f (Chain1 t f) x
xs)

-- | An "effectful" version of 'foldChain1', weaving Applicative effects.
--
-- @since 0.3.6.0
foldChain1A
    :: (HBifunctor t, Functor h)
    => (forall x. f x -> h (g x))                -- ^ handle 'Done1'
    -> (forall x. t f (Comp h g) x -> h (g x))   -- ^ handle 'More1'
    -> Chain1 t f a
    -> h (g a)
foldChain1A :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). f x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain1 t f a
-> h (g a)
foldChain1A forall (x :: k). f x -> h (g x)
f forall (x :: k). t f (Comp h g) x -> h (g x)
g = Comp h g a -> h (g a)
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
Comp f g a -> f (g a)
unComp (Comp h g a -> h (g a))
-> (Chain1 t f a -> Comp h g a) -> Chain1 t f a -> h (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> Comp h g)
-> (t f (Comp h g) ~> Comp h g) -> Chain1 t f ~> Comp h g
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 (h (g x) -> Comp h g x
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp (h (g x) -> Comp h g x) -> (f x -> h (g x)) -> f x -> Comp h g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> h (g x)
forall (x :: k). f x -> h (g x)
f) (h (g x) -> Comp h g x
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp (h (g x) -> Comp h g x)
-> (t f (Comp h g) x -> h (g x)) -> t f (Comp h g) x -> Comp h g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t f (Comp h g) x -> h (g x)
forall (x :: k). t f (Comp h g) x -> h (g x)
g)

-- | Recursively build up a 'Chain1'.  Provide a function that takes some
-- starting seed @g@ and returns either "done" (@f@) or "continue further"
-- (@t f g@), and it will create a @'Chain1' t f@ from a @g@.
--
-- This is an anamorphism.
unfoldChain1
    :: forall t f (g :: Type -> Type). HBifunctor t
    => (g ~> f :+: t f g)
    -> g ~> Chain1 t f
unfoldChain1 :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *).
HBifunctor t =>
(g ~> (f :+: t f g)) -> g ~> Chain1 t f
unfoldChain1 g ~> (f :+: t f g)
f = g x -> Chain1 t f x
g ~> Chain1 t f
go
  where
    go :: g ~> Chain1 t f
    go :: g ~> Chain1 t f
go = (\case L1 f x
x -> f x -> Chain1 t f x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1 f x
x; R1 t f g x
y -> t f (Chain1 t f) x -> Chain1 t f x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 ((g ~> Chain1 t f) -> t f g ~> t f (Chain1 t f)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> t f g ~> t f l
hright g x -> Chain1 t f x
g ~> Chain1 t f
go t f g x
y)) ((:+:) f (t f g) x -> Chain1 t f x)
-> (g x -> (:+:) f (t f g) x) -> g x -> Chain1 t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> (:+:) f (t f g) x
g ~> (f :+: t f g)
f

-- | Convert a tensor value pairing two @f@s into a two-item 'Chain1'.  An
-- analogue of 'toNonEmptyBy'.
--
-- @since 0.3.1.0
toChain1 :: HBifunctor t => t f f ~> Chain1 t f
toChain1 :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *).
HBifunctor t =>
t f f ~> Chain1 t f
toChain1 = t f (Chain1 t f) x -> Chain1 t f x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (t f (Chain1 t f) x -> Chain1 t f x)
-> (t f f x -> t f (Chain1 t f) x) -> t f f x -> Chain1 t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> Chain1 t f) -> t f f ~> t f (Chain1 t f)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> t f g ~> t f l
hright f x -> Chain1 t f x
f ~> Chain1 t f
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1

-- | Create a singleton 'Chain1'.
--
-- @since 0.3.0.0
injectChain1 :: f ~> Chain1 t f
injectChain1 :: forall {k} (f :: k -> *) (t :: (k -> *) -> (k -> *) -> k -> *)
       (x :: k).
f x -> Chain1 t f x
injectChain1 = f x -> Chain1 t f x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1

-- | For completeness, an isomorphism between 'Chain1' and its two
-- constructors, to match 'matchNE'.
--
-- @since 0.3.0.0
matchChain1 :: Chain1 t f ~> (f :+: t f (Chain1 t f))
matchChain1 :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (x :: k).
Chain1 t f x -> (:+:) f (t f (Chain1 t f)) x
matchChain1 = \case
    Done1 f x
x  -> f x -> (:+:) f (t f (Chain1 t f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f x
x
    More1 t f (Chain1 t f) x
xs -> t f (Chain1 t f) x -> (:+:) f (t f (Chain1 t f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 t f (Chain1 t f) x
xs

-- | A useful construction that works like a "linked list" of @t f@ applied
-- to itself multiple times.  That is, it contains @t f f@, @t f (t f f)@,
-- @t f (t f (t f f))@, etc, with @f@ occuring /zero or more/ times.  It is
-- meant to be the same as @'ListBy' t@.
--
-- If @t@ is 'Tensor', then it means we can "collapse" this linked list
-- into some final type @'ListBy' t@ ('reroll'), and also extract it back
-- into a linked list ('unroll').
--
-- So, a value of type @'Chain' t i f a@ is one of either:
--
-- *  @i a@
-- *  @f a@
-- *  @t f f a@
-- *  @t f (t f f) a@
-- *  @t f (t f (t f f)) a@
-- *  .. etc.
--
-- Note that this is /exactly/ what an @'ListBy' t@ is supposed to be.  Using
-- 'Chain' allows us to work with all @'ListBy' t@s in a uniform way, with
-- normal pattern matching and normal constructors.
--
-- You can fully "collapse" a @'Chain' t i f@ into an @f@ with
-- 'retract', if you have @'MonoidIn' t i f@; this could be considered
-- a fundamental property of monoid-ness.
--
-- Another way of thinking of this is that @'Chain' t i@ is the "free
-- @'MonoidIn' t i@".  Given any functor @f@, @'Chain' t i f@ is a monoid
-- in the monoidal category of endofunctors enriched by @t@.  So, @'Chain'
-- 'Control.Monad.Freer.Church.Comp' 'Data.Functor.Identity.Identity'@ is
-- the "free 'Monad'", @'Chain' 'Data.Functor.Day.Day'
-- 'Data.Functor.Identity.Identity'@ is the "free 'Applicative'", etc.  You
-- "lift" from @f a@ to @'Chain' t i f a@ using 'inject'.
--
-- Note: this instance doesn't exist directly because of restrictions in
-- typeclasses, but is implemented as
--
-- @
-- 'Tensor' t i => 'MonoidIn' ('WrapHBF' t) ('WrapF' i) ('Chain' t i f)
-- @
--
-- where 'pureT' is 'Done' and 'biretract' is 'appendChain'.
--
-- This construction is inspired by
-- <http://oleg.fi/gists/posts/2018-02-21-single-free.html>
data Chain t i f a = Done (i a)
                   | More (t f (Chain t i f) a)

deriving instance (Eq (i a), Eq (t f (Chain t i f) a)) => Eq (Chain t i f a)
deriving instance (Ord (i a), Ord (t f (Chain t i f) a)) => Ord (Chain t i f a)
deriving instance (Show (i a), Show (t f (Chain t i f) a)) => Show (Chain t i f a)
deriving instance (Read (i a), Read (t f (Chain t i f) a)) => Read (Chain t i f a)
deriving instance (Functor i, Functor (t f (Chain t i f))) => Functor (Chain t i f)
deriving instance (Foldable i, Foldable (t f (Chain t i f))) => Foldable (Chain t i f)
deriving instance (Traversable i, Traversable (t f (Chain t i f))) => Traversable (Chain t i f)

instance (Eq1 i, Eq1 (t f (Chain t i f))) => Eq1 (Chain t i f) where
    liftEq :: forall a b.
(a -> b -> Bool) -> Chain t i f a -> Chain t i f b -> Bool
liftEq a -> b -> Bool
eq = \case
      Done i a
x -> \case
        Done i b
y -> (a -> b -> Bool) -> i a -> i b -> Bool
forall a b. (a -> b -> Bool) -> i a -> i b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq i a
x i b
y
        More t f (Chain t i f) b
_ -> Bool
False
      More t f (Chain t i f) a
x -> \case
        Done i b
_ -> Bool
False
        More t f (Chain t i f) b
y -> (a -> b -> Bool)
-> t f (Chain t i f) a -> t f (Chain t i f) b -> Bool
forall a b.
(a -> b -> Bool)
-> t f (Chain t i f) a -> t f (Chain t i f) b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq t f (Chain t i f) a
x t f (Chain t i f) b
y

instance (Ord1 i, Ord1 (t f (Chain t i f))) => Ord1 (Chain t i f) where
    liftCompare :: forall a b.
(a -> b -> Ordering) -> Chain t i f a -> Chain t i f b -> Ordering
liftCompare a -> b -> Ordering
c = \case
      Done i a
x -> \case
        Done i b
y -> (a -> b -> Ordering) -> i a -> i b -> Ordering
forall a b. (a -> b -> Ordering) -> i a -> i b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
c i a
x i b
y
        More t f (Chain t i f) b
_ -> Ordering
LT
      More t f (Chain t i f) a
x -> \case
        Done i b
_ -> Ordering
GT
        More t f (Chain t i f) b
y -> (a -> b -> Ordering)
-> t f (Chain t i f) a -> t f (Chain t i f) b -> Ordering
forall a b.
(a -> b -> Ordering)
-> t f (Chain t i f) a -> t f (Chain t i f) b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
c t f (Chain t i f) a
x t f (Chain t i f) b
y

instance (Show1 (t f (Chain t i f)), Show1 i) => Show1 (Chain t i f) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Chain t i f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d = \case
        Done i a
x  -> (Int -> i a -> ShowS) -> String -> Int -> i a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> i a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> i a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"Done" Int
d i a
x
        More t f (Chain t i f) a
xs -> (Int -> t f (Chain t i f) a -> ShowS)
-> String -> Int -> t f (Chain t i f) a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> t f (Chain t i f) a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> t f (Chain t i 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) String
"More" Int
d t f (Chain t i f) a
xs

instance (Functor i, Read1 (t f (Chain t i f)), Read1 i) => Read1 (Chain t i f) where
    liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Chain t i f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (String -> ReadS (Chain t i f a)) -> Int -> ReadS (Chain t i f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Chain t i f a)) -> Int -> ReadS (Chain t i f a))
-> (String -> ReadS (Chain t i f a))
-> Int
-> ReadS (Chain t i f a)
forall a b. (a -> b) -> a -> b
$
            (Int -> ReadS (i a))
-> String
-> (i a -> Chain t i f a)
-> String
-> ReadS (Chain t i f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (i a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (i a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"Done" i a -> Chain t i f a
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done
         (String -> ReadS (Chain t i f a))
-> (String -> ReadS (Chain t i f a))
-> String
-> ReadS (Chain t i f a)
forall a. Semigroup a => a -> a -> a
<> (Int -> ReadS (t f (Chain t i f) a))
-> String
-> (t f (Chain t i f) a -> Chain t i f a)
-> String
-> ReadS (Chain t i f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (t f (Chain t i f) a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (t f (Chain t i f) a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"More" t f (Chain t i f) a -> Chain t i f a
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More

instance (Contravariant i, Contravariant (t f (Chain t i f))) => Contravariant (Chain t i f) where
    contramap :: forall a' a. (a' -> a) -> Chain t i f a -> Chain t i f a'
contramap a' -> a
f = \case
      Done i a
x  -> i a' -> Chain t i f a'
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done ((a' -> a) -> i a -> i a'
forall a' a. (a' -> a) -> i a -> i a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f i a
x )
      More t f (Chain t i f) a
xs -> t f (Chain t i f) a' -> Chain t i f a'
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More ((a' -> a) -> t f (Chain t i f) a -> t f (Chain t i f) a'
forall a' a.
(a' -> a) -> t f (Chain t i f) a -> t f (Chain t i f) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f t f (Chain t i f) a
xs)

instance (Invariant i, Invariant (t f (Chain t i f))) => Invariant (Chain t i f) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Chain t i f a -> Chain t i f b
invmap a -> b
f b -> a
g = \case
      Done i a
x  -> i b -> Chain t i f b
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done ((a -> b) -> (b -> a) -> i a -> i b
forall a b. (a -> b) -> (b -> a) -> i a -> i b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g i a
x )
      More t f (Chain t i f) a
xs -> t f (Chain t i f) b -> Chain t i f b
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More ((a -> b) -> (b -> a) -> t f (Chain t i f) a -> t f (Chain t i f) b
forall a b.
(a -> b) -> (b -> a) -> t f (Chain t i f) a -> t f (Chain t i f) b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g t f (Chain t i f) a
xs)

instance HBifunctor t => HFunctor (Chain t i) where
    hmap :: forall (f :: k1 -> *) (g :: k1 -> *).
(f ~> g) -> Chain t i f ~> Chain t i g
hmap f ~> g
f = (i ~> Chain t i g)
-> (t f (Chain t i g) ~> Chain t i g) -> Chain t i f ~> Chain t i g
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k -> *) (g :: k -> *).
HBifunctor t =>
(i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain i x -> Chain t i g x
i ~> Chain t i g
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done (t g (Chain t i g) x -> Chain t i g x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More (t g (Chain t i g) x -> Chain t i g x)
-> (t f (Chain t i g) x -> t g (Chain t i g) x)
-> t f (Chain t i g) x
-> Chain t i g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> g) -> t f (Chain t i g) ~> t g (Chain t i g)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *).
HBifunctor t =>
(f ~> j) -> t f g ~> t j g
forall (f :: k1 -> *) (j :: k1 -> *) (g :: k1 -> *).
(f ~> j) -> t f g ~> t j g
hleft f x -> g x
f ~> g
f)

-- | Recursively fold down a 'Chain'.  Provide a function on how to handle
-- the "single @f@ case" ('nilLB'), and how to handle the "combined @t f g@
-- case", and this will fold the entire @'Chain' t i) f@ into a single @g@.
--
-- This is a catamorphism.
foldChain
    :: forall t i f g. HBifunctor t
    => (i ~> g)             -- ^ Handle 'Done'
    -> (t f g ~> g)         -- ^ Handle 'More'
    -> Chain t i f ~> g
foldChain :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k -> *) (g :: k -> *).
HBifunctor t =>
(i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain i ~> g
f t f g ~> g
g = Chain t i f x -> g x
Chain t i f ~> g
go
  where
    go :: Chain t i f ~> g
    go :: Chain t i f ~> g
go = \case
      Done i x
x  -> i x -> g x
i ~> g
f i x
x
      More t f (Chain t i f) x
xs -> t f g x -> g x
t f g ~> g
g ((Chain t i f ~> g) -> t f (Chain t i f) ~> t f g
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
forall (g :: k -> *) (l :: k -> *) (f :: k -> *).
(g ~> l) -> t f g ~> t f l
hright Chain t i f x -> g x
Chain t i f ~> g
go t f (Chain t i f) x
xs)

-- | An "effectful" version of 'foldChain', weaving Applicative effects.
--
-- @since 0.3.6.0
foldChainA
    :: (HBifunctor t, Functor h)
    => (forall x. i x -> h (g x))         -- ^ Handle 'Done'
    -> (forall x. t f (Comp h g) x -> h (g x))     -- ^ Handle 'More'
    -> Chain t i f a
    -> h (g a)
foldChainA :: forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (i :: k -> *) (g :: k -> *) (f :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). i x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain t i f a
-> h (g a)
foldChainA forall (x :: k). i x -> h (g x)
f forall (x :: k). t f (Comp h g) x -> h (g x)
g = Comp h g a -> h (g a)
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
Comp f g a -> f (g a)
unComp (Comp h g a -> h (g a))
-> (Chain t i f a -> Comp h g a) -> Chain t i f a -> h (g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i ~> Comp h g)
-> (t f (Comp h g) ~> Comp h g) -> Chain t i f ~> Comp h g
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k -> *) (g :: k -> *).
HBifunctor t =>
(i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain (h (g x) -> Comp h g x
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp (h (g x) -> Comp h g x) -> (i x -> h (g x)) -> i x -> Comp h g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i x -> h (g x)
forall (x :: k). i x -> h (g x)
f) (h (g x) -> Comp h g x
forall {k} (f :: * -> *) (g :: k -> *) (a :: k).
Functor f =>
f (g a) -> Comp f g a
Comp (h (g x) -> Comp h g x)
-> (t f (Comp h g) x -> h (g x)) -> t f (Comp h g) x -> Comp h g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t f (Comp h g) x -> h (g x)
forall (x :: k). t f (Comp h g) x -> h (g x)
g)

-- | Recursively build up a 'Chain'.  Provide a function that takes some
-- starting seed @g@ and returns either "done" (@i@) or "continue further"
-- (@t f g@), and it will create a @'Chain' t i f@ from a @g@.
--
-- This is an anamorphism.
unfoldChain
    :: forall t f (g :: Type -> Type) i. HBifunctor t
    => (g ~> i :+: t f g)
    -> g ~> Chain t i f
unfoldChain :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) (i :: * -> *).
HBifunctor t =>
(g ~> (i :+: t f g)) -> g ~> Chain t i f
unfoldChain g ~> (i :+: t f g)
f = g x -> Chain t i f x
forall a. g a -> Chain t i f a
go
  where
    go :: g a -> Chain t i f a
    go :: forall a. g a -> Chain t i f a
go = (\case L1 i a
x -> i a -> Chain t i f a
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done i a
x; R1 t f g a
y ->  t f (Chain t i f) a -> Chain t i f a
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More ((forall a. g a -> Chain t i f a) -> t f g ~> t f (Chain t i f)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
forall (g :: * -> *) (l :: * -> *) (f :: * -> *).
(g ~> l) -> t f g ~> t f l
hright g x -> Chain t i f x
forall a. g a -> Chain t i f a
go t f g a
y)) ((:+:) i (t f g) a -> Chain t i f a)
-> (g a -> (:+:) i (t f g) a) -> g a -> Chain t i f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> (:+:) i (t f g) a
g ~> (i :+: t f g)
f

-- | For completeness, an isomorphism between 'Chain' and its two
-- constructors, to match 'splittingLB'.
--
-- @since 0.3.0.0
splittingChain :: Chain t i f <~> (i :+: t f (Chain t i f))
splittingChain :: forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (p :: * -> * -> *) (a :: k).
Profunctor p =>
p ((:+:) i (t f (Chain t i f)) a) ((:+:) i (t f (Chain t i f)) a)
-> p (Chain t i f a) (Chain t i f a)
splittingChain = (Chain t i f ~> (i :+: t f (Chain t i f)))
-> (forall {x :: k}.
    (:+:) i (t f (Chain t i f)) x -> Chain t i f x)
-> forall {p :: * -> * -> *} {a :: k}.
   Profunctor p =>
   p ((:+:) i (t f (Chain t i f)) a) ((:+:) i (t f (Chain t i f)) a)
   -> p (Chain t i f a) (Chain t i f a)
forall {k} (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF Chain t i f x -> (:+:) i (t f (Chain t i f)) x
Chain t i f ~> (i :+: t f (Chain t i f))
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (x :: k).
Chain t i f x -> (:+:) i (t f (Chain t i f)) x
unconsChain ((forall {x :: k}. (:+:) i (t f (Chain t i f)) x -> Chain t i f x)
 -> forall {p :: * -> * -> *} {a :: k}.
    Profunctor p =>
    p ((:+:) i (t f (Chain t i f)) a) ((:+:) i (t f (Chain t i f)) a)
    -> p (Chain t i f a) (Chain t i f a))
-> (forall {x :: k}.
    (:+:) i (t f (Chain t i f)) x -> Chain t i f x)
-> forall {p :: * -> * -> *} {a :: k}.
   Profunctor p =>
   p ((:+:) i (t f (Chain t i f)) a) ((:+:) i (t f (Chain t i f)) a)
   -> p (Chain t i f a) (Chain t i f a)
forall a b. (a -> b) -> a -> b
$ \case
      L1 i x
x  -> i x -> Chain t i f x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done i x
x
      R1 t f (Chain t i f) x
xs -> t f (Chain t i f) x -> Chain t i f x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More t f (Chain t i f) x
xs

-- | An analogue of 'unconsLB': match one of the two constructors of
-- a 'Chain'.
--
-- @since 0.3.0.0
unconsChain :: Chain t i f ~> i :+: t f (Chain t i f)
unconsChain :: forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (x :: k).
Chain t i f x -> (:+:) i (t f (Chain t i f)) x
unconsChain = \case
    Done i x
x  -> i x -> (:+:) i (t f (Chain t i f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 i x
x
    More t f (Chain t i f) x
xs -> t f (Chain t i f) x -> (:+:) i (t f (Chain t i f)) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 t f (Chain t i f) x
xs

-- | The invariant version of 'Ap1' and 'Div1': combines the capabilities
-- of both 'Ap1' and 'Div1' together.
--
-- Conceptually you can think of @'DivAp1' f a@ as a way of consuming and
-- producing @a@s that contains a (non-empty) collection of @f x@s of
-- different @x@s. When interpreting this, each @a@ is distributed across
-- all @f x@s to each interpret, and then re-combined again to produce the
-- resulting @a@.
--
-- To do this, the main tools to combine 'DivAp1's are its 'Inply'
-- instance, using 'gather' to combine two 'DivAp1's in
-- a parallel-fork-like manner (with the splitting and re-combining
-- function).
--
-- This does have an 'Interpret' function, but the target typeclass
-- ('Inply') doesn't have too many useful instances.  Instead, you are
-- probably going to run it into either 'Apply' instance (to "produce" an
-- @a@ from a @'DivAp1' f a@) with 'runCoDivAp1', or a 'Divise' instance
-- (to "consume" an @a@ from a @'DivAp1' f a@) with 'runContraDivAp1'.
--
-- If you think of this type as a combination of 'Ap1' and 'Div1', then
-- you can also extract the 'Ap1' part out using 'divApAp1', and
-- extract the 'Div1' part out using 'divApDiv1'.
--
-- Note that this type's utility is similar to that of @'PreT' 'Ap1'@,
-- except @'PreT' 'Ap1'@ lets you use 'Apply' typeclass methods to assemble
-- it.
--
-- @since 0.3.5.0
newtype DivAp1 f a = DivAp1_ { forall (f :: * -> *) a. DivAp1 f a -> Chain1 Day f a
unDivAp1 :: Chain1 ID.Day f a }
  deriving ((forall a b. (a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b)
-> Invariant (DivAp1 f)
forall a b. (a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
invmap :: forall a b. (a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
Invariant, (forall (f :: * -> *) (g :: * -> *).
 (f ~> g) -> DivAp1 f ~> DivAp1 g)
-> HFunctor DivAp1
forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g
hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g
HFunctor, HFunctor DivAp1
HFunctor DivAp1 =>
(forall (f :: * -> *). f ~> DivAp1 f) -> Inject DivAp1
forall {k} (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> DivAp1 f
$cinject :: forall (f :: * -> *). f ~> DivAp1 f
inject :: forall (f :: * -> *). f ~> DivAp1 f
Inject)

instance HTraversable DivAp1 where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> DivAp1 f a -> h (DivAp1 g a)
htraverse forall x. f x -> h (g x)
f =
        (forall x. f x -> h (DivAp1 g x))
-> (forall x. Day f (Comp h (DivAp1 g)) x -> h (DivAp1 g x))
-> Chain1 Day f a
-> h (DivAp1 g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). f x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain1 t f a
-> h (g a)
foldChain1A
          ((g x -> DivAp1 g x) -> h (g x) -> h (DivAp1 g x)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chain1 Day g x -> DivAp1 g x
forall (f :: * -> *) a. Chain1 Day f a -> DivAp1 f a
DivAp1_ (Chain1 Day g x -> DivAp1 g x)
-> (g x -> Chain1 Day g x) -> g x -> DivAp1 g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> Chain1 Day g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1) (h (g x) -> h (DivAp1 g x))
-> (f x -> h (g x)) -> f x -> h (DivAp1 g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> h (g x)
forall x. f x -> h (g x)
f)
          (\case ID.Day f b
x (Comp h (DivAp1 g c)
y) b -> c -> x
g x -> (b, c)
h ->
                     (\g b
x' Chain1 Day g c
y' -> Chain1 Day g x -> DivAp1 g x
forall (f :: * -> *) a. Chain1 Day f a -> DivAp1 f a
DivAp1_ (Day g (Chain1 Day g) x -> Chain1 Day g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (g b
-> Chain1 Day g c
-> (b -> c -> x)
-> (x -> (b, c))
-> Day g (Chain1 Day g) x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day g b
x' Chain1 Day g c
y' b -> c -> x
g x -> (b, c)
h)))
                   (g b -> Chain1 Day g c -> DivAp1 g x)
-> h (g b) -> h (Chain1 Day g c -> DivAp1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> h (g b)
forall x. f x -> h (g x)
f f b
x h (Chain1 Day g c -> DivAp1 g x)
-> h (Chain1 Day g c) -> h (DivAp1 g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DivAp1 g c -> Chain1 Day g c
forall (f :: * -> *) a. DivAp1 f a -> Chain1 Day f a
unDivAp1 (DivAp1 g c -> Chain1 Day g c)
-> h (DivAp1 g c) -> h (Chain1 Day g c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DivAp1 g c)
y)
          )
      (Chain1 Day f a -> h (DivAp1 g a))
-> (DivAp1 f a -> Chain1 Day f a) -> DivAp1 f a -> h (DivAp1 g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DivAp1 f a -> Chain1 Day f a
forall (f :: * -> *) a. DivAp1 f a -> Chain1 Day f a
unDivAp1

instance HTraversable1 DivAp1 where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> DivAp1 f a -> h (DivAp1 g a)
htraverse1 forall x. f x -> h (g x)
f =
        (forall x. f x -> h (DivAp1 g x))
-> (forall x. Day f (Comp h (DivAp1 g)) x -> h (DivAp1 g x))
-> Chain1 Day f a
-> h (DivAp1 g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). f x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain1 t f a
-> h (g a)
foldChain1A
          ((g x -> DivAp1 g x) -> h (g x) -> h (DivAp1 g x)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chain1 Day g x -> DivAp1 g x
forall (f :: * -> *) a. Chain1 Day f a -> DivAp1 f a
DivAp1_ (Chain1 Day g x -> DivAp1 g x)
-> (g x -> Chain1 Day g x) -> g x -> DivAp1 g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> Chain1 Day g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1) (h (g x) -> h (DivAp1 g x))
-> (f x -> h (g x)) -> f x -> h (DivAp1 g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> h (g x)
forall x. f x -> h (g x)
f)
          (\case ID.Day f b
x (Comp h (DivAp1 g c)
y) b -> c -> x
g x -> (b, c)
h ->
                     (\g b
x' Chain1 Day g c
y' -> Chain1 Day g x -> DivAp1 g x
forall (f :: * -> *) a. Chain1 Day f a -> DivAp1 f a
DivAp1_ (Day g (Chain1 Day g) x -> Chain1 Day g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (g b
-> Chain1 Day g c
-> (b -> c -> x)
-> (x -> (b, c))
-> Day g (Chain1 Day g) x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day g b
x' Chain1 Day g c
y' b -> c -> x
g x -> (b, c)
h)))
                   (g b -> Chain1 Day g c -> DivAp1 g x)
-> h (g b) -> h (Chain1 Day g c -> DivAp1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> h (g b)
forall x. f x -> h (g x)
f f b
x h (Chain1 Day g c -> DivAp1 g x)
-> h (Chain1 Day g c) -> h (DivAp1 g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (DivAp1 g c -> Chain1 Day g c
forall (f :: * -> *) a. DivAp1 f a -> Chain1 Day f a
unDivAp1 (DivAp1 g c -> Chain1 Day g c)
-> h (DivAp1 g c) -> h (Chain1 Day g c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DivAp1 g c)
y)
          )
      (Chain1 Day f a -> h (DivAp1 g a))
-> (DivAp1 f a -> Chain1 Day f a) -> DivAp1 f a -> h (DivAp1 g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DivAp1 f a -> Chain1 Day f a
forall (f :: * -> *) a. DivAp1 f a -> Chain1 Day f a
unDivAp1

-- | The invariant version of 'Ap' and 'Div': combines the capabilities of
-- both 'Ap' and 'Div' together.
--
-- Conceptually you can think of @'DivAp' f a@ as a way of consuming and
-- producing @a@s that contains a collection of @f x@s of different @x@s.
-- When interpreting this, each @a@ is distributed across all @f x@s to
-- each interpret, and then re-combined again to produce the resulting @a@.
--
-- To do this, the main tools to combine 'DivAp's are its 'Inply'
-- instance, using 'gather' to combine two 'DivAp's in a choice-like
-- manner (with the splitting and re-combining function), and its
-- 'Inplicative' instance, using 'knot' to create an "empty" branch that
-- does not contribute to the structure.
--
-- This does have an 'Interpret' function, but the target typeclass
-- ('Inplicative') doesn't have too many useful instances.  Instead, you
-- are probably going to run it into either 'Applicative' instance (to
-- "produce" an @a@ from a @'DivAp' f a@) with 'runCoDivAp', or
-- a 'Divisible' instance (to "consume" an @a@ from a @'DivAp' f a@) with
-- 'runContraDivAp'.
--
-- If you think of this type as a combination of 'Ap' and 'Div', then
-- you can also extract the 'Ap' part out using 'divApAp', and
-- extract the 'Div' part out using 'divApDiv'.
--
-- Note that this type's utility is similar to that of @'PreT' 'Ap'@,
-- except @'PreT' 'Ap'@ lets you use 'Applicative' typeclass methods to
-- assemble it.
--
-- @since 0.3.5.0
newtype DivAp f a = DivAp { forall (f :: * -> *) a. DivAp f a -> Chain Day Identity f a
unDivAp :: Chain ID.Day Identity f a }
  deriving ((forall a b. (a -> b) -> (b -> a) -> DivAp f a -> DivAp f b)
-> Invariant (DivAp f)
forall a b. (a -> b) -> (b -> a) -> DivAp f a -> DivAp f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> DivAp f a -> DivAp f b
$cinvmap :: forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> DivAp f a -> DivAp f b
invmap :: forall a b. (a -> b) -> (b -> a) -> DivAp f a -> DivAp f b
Invariant, (forall (f :: * -> *) (g :: * -> *).
 (f ~> g) -> DivAp f ~> DivAp g)
-> HFunctor DivAp
forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> DivAp f ~> DivAp g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> DivAp f ~> DivAp g
hmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> DivAp f ~> DivAp g
HFunctor)

instance Inject DivAp where
    inject :: forall (f :: * -> *). f ~> DivAp f
inject f x
x = Chain Day Identity f x -> DivAp f x
forall (f :: * -> *) a. Chain Day Identity f a -> DivAp f a
DivAp (Chain Day Identity f x -> DivAp f x)
-> Chain Day Identity f x -> DivAp f x
forall a b. (a -> b) -> a -> b
$ Day f (Chain Day Identity f) x -> Chain Day Identity f x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More (f x
-> Chain Day Identity f ()
-> (x -> () -> x)
-> (x -> (x, ()))
-> Day f (Chain Day Identity f) x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day f x
x (Identity () -> Chain Day Identity f ()
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done (() -> Identity ()
forall a. a -> Identity a
Identity ())) x -> () -> x
forall a b. a -> b -> a
const (,()))

instance HTraversable DivAp where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> DivAp f a -> h (DivAp g a)
htraverse forall x. f x -> h (g x)
f =
        (forall x. Identity x -> h (DivAp g x))
-> (forall x. Day f (Comp h (DivAp g)) x -> h (DivAp g x))
-> Chain Day Identity f a
-> h (DivAp g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (i :: k -> *) (g :: k -> *) (f :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). i x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain t i f a
-> h (g a)
foldChainA
          (DivAp g x -> h (DivAp g x)
forall a. a -> h a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DivAp g x -> h (DivAp g x))
-> (Identity x -> DivAp g x) -> Identity x -> h (DivAp g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain Day Identity g x -> DivAp g x
forall (f :: * -> *) a. Chain Day Identity f a -> DivAp f a
DivAp (Chain Day Identity g x -> DivAp g x)
-> (Identity x -> Chain Day Identity g x)
-> Identity x
-> DivAp g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> Chain Day Identity g x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done)
          (\case ID.Day f b
x (Comp h (DivAp g c)
y) b -> c -> x
g x -> (b, c)
h ->
                      (\g b
x' Chain Day Identity g c
y' -> Chain Day Identity g x -> DivAp g x
forall (f :: * -> *) a. Chain Day Identity f a -> DivAp f a
DivAp (Day g (Chain Day Identity g) x -> Chain Day Identity g x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More (g b
-> Chain Day Identity g c
-> (b -> c -> x)
-> (x -> (b, c))
-> Day g (Chain Day Identity g) x
forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day g b
x'  Chain Day Identity g c
y' b -> c -> x
g x -> (b, c)
h)))
                  (g b -> Chain Day Identity g c -> DivAp g x)
-> h (g b) -> h (Chain Day Identity g c -> DivAp g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> h (g b)
forall x. f x -> h (g x)
f f b
x h (Chain Day Identity g c -> DivAp g x)
-> h (Chain Day Identity g c) -> h (DivAp g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DivAp g c -> Chain Day Identity g c
forall (f :: * -> *) a. DivAp f a -> Chain Day Identity f a
unDivAp (DivAp g c -> Chain Day Identity g c)
-> h (DivAp g c) -> h (Chain Day Identity g c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DivAp g c)
y)
          )
      (Chain Day Identity f a -> h (DivAp g a))
-> (DivAp f a -> Chain Day Identity f a)
-> DivAp f a
-> h (DivAp g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DivAp f a -> Chain Day Identity f a
forall (f :: * -> *) a. DivAp f a -> Chain Day Identity f a
unDivAp


-- | The invariant version of 'NonEmptyF' and 'Dec1': combines the
-- capabilities of both 'NonEmptyF' and 'Dec1' together.
--
-- Conceptually you can think of @'DecAlt1' f a@ as a way of consuming and
-- producing @a@s that contains a (non-empty) collection of @f x@s of
-- different @x@s. When interpreting this, a /specific/ @f@ is chosen to
-- handle the interpreting; the @a@ is sent to that @f@, and the single
-- result is returned back out.
--
-- To do this, the main tools to combine 'DecAlt1's are its 'Inalt'
-- instance, using 'swerve' to combine two 'DecAlt1's in a choice-like
-- manner (with the choosing and re-injecting function).
--
-- This does have an 'Interpret' function, but the target typeclass
-- ('Inalt') doesn't have too many useful instances.  Instead, you are
-- probably going to run it into either an 'Alt' instance (to "produce" an
-- @a@ from a @'DecAlt1' f a@) with 'runCoDecAlt1', or a 'Decide' instance
-- (to "consume" an @a@ from a @'DecAlt1' f a@) with 'runContraDecAlt1'.
--
-- If you think of this type as a combination of 'NonEmptyF' and 'Dec1',
-- then you can also extract the 'NonEmptyF' part out using
-- 'decAltNonEmptyF', and extract the 'Dec1' part out using 'decAltDec1'.
--
-- Note that this type's utility is similar to that of @'PostT' 'Dec1'@,
-- except @'PostT' 'Dec1'@ lets you use 'Decide' typeclass methods to
-- assemble it.
--
-- @since 0.3.5.0
newtype DecAlt1 f a = DecAlt1_ { forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1 :: Chain1 IN.Night f a }
  deriving ((forall a b. (a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b)
-> Invariant (DecAlt1 f)
forall a b. (a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
invmap :: forall a b. (a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
Invariant, (forall (f :: * -> *) (g :: * -> *).
 (f ~> g) -> DecAlt1 f ~> DecAlt1 g)
-> HFunctor DecAlt1
forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g
hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g
HFunctor, HFunctor DecAlt1
HFunctor DecAlt1 =>
(forall (f :: * -> *). f ~> DecAlt1 f) -> Inject DecAlt1
forall {k} (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> DecAlt1 f
$cinject :: forall (f :: * -> *). f ~> DecAlt1 f
inject :: forall (f :: * -> *). f ~> DecAlt1 f
Inject)

instance HTraversable DecAlt1 where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> DecAlt1 f a -> h (DecAlt1 g a)
htraverse forall x. f x -> h (g x)
f =
        (forall x. f x -> h (DecAlt1 g x))
-> (forall x. Night f (Comp h (DecAlt1 g)) x -> h (DecAlt1 g x))
-> Chain1 Night f a
-> h (DecAlt1 g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). f x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain1 t f a
-> h (g a)
foldChain1A
          ((g x -> DecAlt1 g x) -> h (g x) -> h (DecAlt1 g x)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chain1 Night g x -> DecAlt1 g x
forall (f :: * -> *) a. Chain1 Night f a -> DecAlt1 f a
DecAlt1_ (Chain1 Night g x -> DecAlt1 g x)
-> (g x -> Chain1 Night g x) -> g x -> DecAlt1 g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> Chain1 Night g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1) (h (g x) -> h (DecAlt1 g x))
-> (f x -> h (g x)) -> f x -> h (DecAlt1 g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> h (g x)
forall x. f x -> h (g x)
f)
          (\case IN.Night f b1
x (Comp h (DecAlt1 g c1)
y) b1 -> x
g c1 -> x
h x -> Either b1 c1
k ->
                     (\g b1
x' Chain1 Night g c1
y' -> Chain1 Night g x -> DecAlt1 g x
forall (f :: * -> *) a. Chain1 Night f a -> DecAlt1 f a
DecAlt1_ (Night g (Chain1 Night g) x -> Chain1 Night g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (g b1
-> Chain1 Night g c1
-> (b1 -> x)
-> (c1 -> x)
-> (x -> Either b1 c1)
-> Night g (Chain1 Night g) x
forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night g b1
x' Chain1 Night g c1
y' b1 -> x
g c1 -> x
h x -> Either b1 c1
k)))
                   (g b1 -> Chain1 Night g c1 -> DecAlt1 g x)
-> h (g b1) -> h (Chain1 Night g c1 -> DecAlt1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b1 -> h (g b1)
forall x. f x -> h (g x)
f f b1
x h (Chain1 Night g c1 -> DecAlt1 g x)
-> h (Chain1 Night g c1) -> h (DecAlt1 g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DecAlt1 g c1 -> Chain1 Night g c1
forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1 (DecAlt1 g c1 -> Chain1 Night g c1)
-> h (DecAlt1 g c1) -> h (Chain1 Night g c1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DecAlt1 g c1)
y)
          )
      (Chain1 Night f a -> h (DecAlt1 g a))
-> (DecAlt1 f a -> Chain1 Night f a)
-> DecAlt1 f a
-> h (DecAlt1 g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecAlt1 f a -> Chain1 Night f a
forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1

instance HTraversable1 DecAlt1 where
    htraverse1 :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Apply h =>
(forall x. f x -> h (g x)) -> DecAlt1 f a -> h (DecAlt1 g a)
htraverse1 forall x. f x -> h (g x)
f =
        (forall x. f x -> h (DecAlt1 g x))
-> (forall x. Night f (Comp h (DecAlt1 g)) x -> h (DecAlt1 g x))
-> Chain1 Night f a
-> h (DecAlt1 g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (f :: k -> *) (g :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). f x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain1 t f a
-> h (g a)
foldChain1A
          ((g x -> DecAlt1 g x) -> h (g x) -> h (DecAlt1 g x)
forall a b. (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Chain1 Night g x -> DecAlt1 g x
forall (f :: * -> *) a. Chain1 Night f a -> DecAlt1 f a
DecAlt1_ (Chain1 Night g x -> DecAlt1 g x)
-> (g x -> Chain1 Night g x) -> g x -> DecAlt1 g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> Chain1 Night g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
f a -> Chain1 t f a
Done1) (h (g x) -> h (DecAlt1 g x))
-> (f x -> h (g x)) -> f x -> h (DecAlt1 g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> h (g x)
forall x. f x -> h (g x)
f)
          (\case IN.Night f b1
x (Comp h (DecAlt1 g c1)
y) b1 -> x
g c1 -> x
h x -> Either b1 c1
k ->
                     (\g b1
x' Chain1 Night g c1
y' -> Chain1 Night g x -> DecAlt1 g x
forall (f :: * -> *) a. Chain1 Night f a -> DecAlt1 f a
DecAlt1_ (Night g (Chain1 Night g) x -> Chain1 Night g x
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (a :: k).
t f (Chain1 t f) a -> Chain1 t f a
More1 (g b1
-> Chain1 Night g c1
-> (b1 -> x)
-> (c1 -> x)
-> (x -> Either b1 c1)
-> Night g (Chain1 Night g) x
forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night g b1
x' Chain1 Night g c1
y' b1 -> x
g c1 -> x
h x -> Either b1 c1
k)))
                   (g b1 -> Chain1 Night g c1 -> DecAlt1 g x)
-> h (g b1) -> h (Chain1 Night g c1 -> DecAlt1 g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b1 -> h (g b1)
forall x. f x -> h (g x)
f f b1
x h (Chain1 Night g c1 -> DecAlt1 g x)
-> h (Chain1 Night g c1) -> h (DecAlt1 g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (DecAlt1 g c1 -> Chain1 Night g c1
forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1 (DecAlt1 g c1 -> Chain1 Night g c1)
-> h (DecAlt1 g c1) -> h (Chain1 Night g c1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DecAlt1 g c1)
y)
          )
      (Chain1 Night f a -> h (DecAlt1 g a))
-> (DecAlt1 f a -> Chain1 Night f a)
-> DecAlt1 f a
-> h (DecAlt1 g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecAlt1 f a -> Chain1 Night f a
forall (f :: * -> *) a. DecAlt1 f a -> Chain1 Night f a
unDecAlt1

-- | A free 'Inalt'
instance Inalt f => Interpret DecAlt1 f where
    interpret :: forall (g :: * -> *). (g ~> f) -> DecAlt1 g ~> f
interpret g ~> f
f (DecAlt1_ Chain1 Night g x
x) = (g ~> f) -> (Night g f ~> f) -> Chain1 Night g ~> f
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 g x -> f x
g ~> f
f ((g ~> f) -> (f ~> f) -> Night g f ~> f
forall (h :: * -> *) (f :: * -> *) (g :: * -> *).
Inalt h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
IN.runNight g x -> f x
g ~> f
f f x -> f x
forall a. a -> a
f ~> f
id) Chain1 Night g x
x

-- | The invariant version of 'ListF' and 'Dec': combines the capabilities of
-- both 'ListF' and 'Dec' together.
--
-- Conceptually you can think of @'DecAlt' f a@ as a way of consuming and
-- producing @a@s that contains a collection of @f x@s of different @x@s.
-- When interpreting this, a /specific/ @f@ is chosen to handle the
-- interpreting; the @a@ is sent to that @f@, and the single result is
-- returned back out.
--
-- To do this, the main tools to combine 'DecAlt's are its 'Inalt'
-- instance, using 'swerve' to combine two 'DecAlt's in a choice-like
-- manner (with the choosing and re-injecting function), and its 'Inplus'
-- instance, using 'reject' to create an "empty" choice that is never
-- taken.
--
-- This does have an 'Interpret' function, but the target typeclass
-- ('Inplus') doesn't have too many useful instances.  Instead, you are
-- probably going to run it into either 'Plus' instance (to "produce" an
-- @a@ from a @'DecAlt' f a@) with 'runCoDecAlt', or a 'Choose' instance
-- (to "consume" an @a@ from a @'DecAlt' f a@) with 'runContraDecAlt'.
--
-- If you think of this type as a combination of 'ListF' and 'Dec', then
-- you can also extract the 'ListF' part out using 'decAltListF', and
-- extract the 'Dec' part out using 'decAltDec'.
--
-- Note that this type's utility is similar to that of @'PostT' 'Dec'@,
-- except @'PostT' 'Dec'@ lets you use 'Conclude' typeclass methods to
-- assemble it.
--
-- @since 0.3.5.0
newtype DecAlt f a = DecAlt { forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt :: Chain IN.Night IN.Not f a }
  deriving ((forall a b. (a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b)
-> Invariant (DecAlt f)
forall a b. (a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b
$cinvmap :: forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b
invmap :: forall a b. (a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b
Invariant, (forall (f :: * -> *) (g :: * -> *).
 (f ~> g) -> DecAlt f ~> DecAlt g)
-> HFunctor DecAlt
forall {k} {k1} (t :: (k -> *) -> k1 -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g
hmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g
HFunctor)

instance Inject DecAlt where
    inject :: forall (f :: * -> *). f ~> DecAlt f
inject f x
x = Chain Night Not f x -> DecAlt f x
forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt (Chain Night Not f x -> DecAlt f x)
-> Chain Night Not f x -> DecAlt f x
forall a b. (a -> b) -> a -> b
$ Night f (Chain Night Not f) x -> Chain Night Not f x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More (f x
-> Chain Night Not f Void
-> (x -> x)
-> (Void -> x)
-> (x -> Either x Void)
-> Night f (Chain Night Not f) x
forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night f x
x (Not Void -> Chain Night Not f Void
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done Not Void
IN.refuted) x -> x
forall a. a -> a
id Void -> x
forall a. Void -> a
absurd x -> Either x Void
forall a b. a -> Either a b
Left)

instance HTraversable DecAlt where
    htraverse :: forall (h :: * -> *) (f :: * -> *) (g :: * -> *) a.
Applicative h =>
(forall x. f x -> h (g x)) -> DecAlt f a -> h (DecAlt g a)
htraverse forall x. f x -> h (g x)
f =
        (forall x. Not x -> h (DecAlt g x))
-> (forall x. Night f (Comp h (DecAlt g)) x -> h (DecAlt g x))
-> Chain Night Not f a
-> h (DecAlt g a)
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (h :: * -> *)
       (i :: k -> *) (g :: k -> *) (f :: k -> *) (a :: k).
(HBifunctor t, Functor h) =>
(forall (x :: k). i x -> h (g x))
-> (forall (x :: k). t f (Comp h g) x -> h (g x))
-> Chain t i f a
-> h (g a)
foldChainA (DecAlt g x -> h (DecAlt g x)
forall a. a -> h a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DecAlt g x -> h (DecAlt g x))
-> (Not x -> DecAlt g x) -> Not x -> h (DecAlt g x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chain Night Not g x -> DecAlt g x
forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt (Chain Night Not g x -> DecAlt g x)
-> (Not x -> Chain Night Not g x) -> Not x -> DecAlt g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Not x -> Chain Night Not g x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
i a -> Chain t i f a
Done)
          (\case IN.Night f b1
x (Comp h (DecAlt g c1)
y) b1 -> x
g c1 -> x
h x -> Either b1 c1
k ->
                     (\g b1
x' Chain Night Not g c1
y' -> Chain Night Not g x -> DecAlt g x
forall (f :: * -> *) a. Chain Night Not f a -> DecAlt f a
DecAlt (Night g (Chain Night Not g) x -> Chain Night Not g x
forall {k} {k} (t :: k -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k) (a :: k).
t f (Chain t i f) a -> Chain t i f a
More (g b1
-> Chain Night Not g c1
-> (b1 -> x)
-> (c1 -> x)
-> (x -> Either b1 c1)
-> Night g (Chain Night Not g) x
forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night g b1
x' Chain Night Not g c1
y' b1 -> x
g c1 -> x
h x -> Either b1 c1
k)))
                  (g b1 -> Chain Night Not g c1 -> DecAlt g x)
-> h (g b1) -> h (Chain Night Not g c1 -> DecAlt g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b1 -> h (g b1)
forall x. f x -> h (g x)
f f b1
x h (Chain Night Not g c1 -> DecAlt g x)
-> h (Chain Night Not g c1) -> h (DecAlt g x)
forall a b. h (a -> b) -> h a -> h b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DecAlt g c1 -> Chain Night Not g c1
forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt (DecAlt g c1 -> Chain Night Not g c1)
-> h (DecAlt g c1) -> h (Chain Night Not g c1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (DecAlt g c1)
y)
          )
      (Chain Night Not f a -> h (DecAlt g a))
-> (DecAlt f a -> Chain Night Not f a)
-> DecAlt f a
-> h (DecAlt g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecAlt f a -> Chain Night Not f a
forall (f :: * -> *) a. DecAlt f a -> Chain Night Not f a
unDecAlt

-- | A free 'Inplus'
instance Inplus f => Interpret DecAlt f where
    interpret :: forall (g :: * -> *). (g ~> f) -> DecAlt g ~> f
interpret g ~> f
f (DecAlt Chain Night Not g x
x) = (Not ~> f) -> (Night g f ~> f) -> Chain Night Not g ~> f
forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (i :: k -> *)
       (f :: k -> *) (g :: k -> *).
HBifunctor t =>
(i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain ((x -> Void) -> f x
forall a. (a -> Void) -> f a
forall (f :: * -> *) a. Inplus f => (a -> Void) -> f a
reject ((x -> Void) -> f x) -> (Not x -> x -> Void) -> Not x -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Not x -> x -> Void
forall a. Not a -> a -> Void
IN.refute) ((g ~> f) -> (f ~> f) -> Night g f ~> f
forall (h :: * -> *) (f :: * -> *) (g :: * -> *).
Inalt h =>
(f ~> h) -> (g ~> h) -> Night f g ~> h
IN.runNight g x -> f x
g ~> f
f f x -> f x
forall a. a -> a
f ~> f
id) Chain Night Not g x
x