{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      : Data.HFunctor.Chain
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- This module provides an 'Interpret'able data type of "linked list of
-- tensor applications".
--
-- The type @'Chain' t@, for any @'Tensor' t@, is meant to be the same as
-- @'ListBy' t@ (the monoidal functor combinator for @t@), and represents
-- "zero or more" applications of @f@ to @t@.
--
-- The type @'Chain1' t@, for any @'Associative' t@, is meant to be the
-- same as @'NonEmptyBy' t@ (the semigroupoidal functor combinator for @t@) and
-- represents "one or more" applications of @f@ to @t@.
--
-- The advantage of using 'Chain' and 'Chain1' over 'ListBy' or 'NonEmptyBy' is that
-- they provide a universal interface for pattern matching and constructing
-- such values, which may simplify working with new such functor
-- combinators you might encounter.
module Data.HFunctor.Chain (
  -- * 'Chain'
    Chain(..)
  , foldChain, foldChainA
  , unfoldChain
  , unroll
  , reroll
  , unrolling
  , appendChain
  , splittingChain
  , toChain
  , injectChain
  , unconsChain
  -- * 'Chain1'
  , Chain1(..)
  , foldChain1, foldChain1A
  , unfoldChain1
  , unrollingNE
  , unrollNE
  , rerollNE
  , appendChain1
  , fromChain1
  , matchChain1
  , toChain1
  , injectChain1
  -- ** Matchable
  -- | The following conversions between 'Chain' and 'Chain1' are only
  -- possible if @t@ is 'Matchable'
  , splittingChain1
  , splitChain1
  , matchingChain
  , unmatchChain
  ) where

import           Control.Monad.Freer.Church
import           Control.Natural
import           Control.Natural.IsoF
import           Data.Functor.Bind
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.Day hiding              (intro1, intro2, elim1, elim2)
import           Data.Functor.Identity
import           Data.Functor.Invariant
import           Data.Functor.Invariant.Inplicative
import           Data.Functor.Invariant.Internative
import           Data.Functor.Plus
import           Data.Functor.Product
import           Data.HBifunctor
import           Data.HBifunctor.Associative
import           Data.HBifunctor.Tensor
import           Data.HBifunctor.Tensor.Internal
import           Data.HFunctor
import           Data.HFunctor.Chain.Internal
import           Data.HFunctor.Interpret
import           Data.Typeable
import           GHC.Generics
import qualified Data.Functor.Contravariant.Day       as CD
import qualified Data.Functor.Contravariant.Night     as N
import qualified Data.Functor.Invariant.Day           as ID
import qualified Data.Functor.Invariant.Night         as IN

instance SemigroupIn t f => Interpret (Chain1 t) f where
    retract :: Chain1 t f ~> f
retract = \case
      Done1 f x
x  -> f x
x
      More1 t f (Chain1 t f) x
xs -> forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
SemigroupIn t f =>
(g ~> f) -> (h ~> f) -> t g h ~> f
binterpret forall a. a -> a
id forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Interpret t f =>
t f ~> f
retract t f (Chain1 t f) x
xs
    interpret :: forall g. g ~> f -> Chain1 t g ~> f
    interpret :: forall (g :: * -> *). (g ~> f) -> Chain1 t g ~> f
interpret g ~> f
f = Chain1 t g ~> f
go
      where
        go :: Chain1 t g ~> f
        go :: Chain1 t g ~> f
go = \case
          Done1 g x
x  -> g ~> f
f g x
x
          More1 t g (Chain1 t g) x
xs -> forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
SemigroupIn t f =>
(g ~> f) -> (h ~> f) -> t g h ~> f
binterpret g ~> f
f Chain1 t g ~> f
go t g (Chain1 t g) x
xs

-- | A type @'NonEmptyBy' t@ is supposed to represent the successive application of
-- @t@s to itself.  The type @'Chain1' t f@ is an actual concrete ADT that contains
-- successive applications of @t@ to itself, and you can pattern match on
-- each layer.
--
-- 'unrollingNE' states that the two types are isormorphic.  Use 'unrollNE'
-- and 'rerollNE' to convert between the two.
unrollingNE :: forall t f. (Associative t, FunctorBy t f) => NonEmptyBy t f <~> Chain1 t f
unrollingNE :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f <~> Chain1 t f
unrollingNE = forall {k} (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> Chain1 t f
unrollNE forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE

-- | A type @'NonEmptyBy' t@ is supposed to represent the successive application of
-- @t@s to itself.  'unrollNE' makes that successive application explicit,
-- buy converting it to a literal 'Chain1' of applications of @t@ to
-- itself.
--
-- @
-- 'unrollNE' = 'unfoldChain1' 'matchNE'
-- @
unrollNE :: (Associative t, FunctorBy t f) => NonEmptyBy t f ~> Chain1 t f
unrollNE :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> Chain1 t f
unrollNE = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *).
HBifunctor t =>
(g ~> (f :+: t f g)) -> g ~> Chain1 t f
unfoldChain1 forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> (f :+: t f (NonEmptyBy t f))
matchNE

-- | 'Chain1' is a semigroup with respect to @t@: we can "combine" them in
-- an associative way.
--
-- This is essentially 'biretract', but only requiring @'Associative' t@:
-- it comes from the fact that @'Chain1' t@ is the "free @'SemigroupIn'
-- t@".
--
-- @since 0.1.1.0
appendChain1
    :: forall t f. (Associative t, FunctorBy t f)
    => t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> Chain1 t f
unrollNE
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
t (NonEmptyBy t f) (NonEmptyBy t f) ~> NonEmptyBy t f
appendNE
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *) (l :: k -> *).
HBifunctor t =>
(f ~> j) -> (g ~> l) -> t f g ~> t j l
hbimap forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE

-- | @'Chain1' t@ is the "free @'SemigroupIn' t@".  However, we have to
-- wrap @t@ in 'WrapHBF' to prevent overlapping instances.
instance (Associative t, FunctorBy t f, FunctorBy t (Chain1 t f)) => SemigroupIn (WrapHBF t) (Chain1 t f) where
    biretract :: WrapHBF t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
biretract = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3 -> *) (f :: k1)
       (g :: k2) (a :: k3).
WrapHBF t f g a -> t f g a
unwrapHBF
    binterpret :: forall (g :: * -> *) (h :: * -> *).
(g ~> Chain1 t f)
-> (h ~> Chain1 t f) -> WrapHBF t g h ~> Chain1 t f
binterpret g ~> Chain1 t f
f h ~> Chain1 t f
g = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
SemigroupIn t f =>
t f f ~> f
biretract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *) (l :: k -> *).
HBifunctor t =>
(f ~> j) -> (g ~> l) -> t f g ~> t j l
hbimap g ~> Chain1 t f
f h ~> Chain1 t f
g

-- | @'Chain1' 'Day'@ is the free "semigroup in the semigroupoidal category
-- of endofunctors enriched by 'Day'" --- aka, the free 'Apply'.
instance Functor f => Apply (Chain1 Day f) where
    Chain1 Day f (a -> b)
f <.> :: forall a b.
Chain1 Day f (a -> b) -> Chain1 Day f a -> Chain1 Day f b
<.> Chain1 Day f a
x = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day Chain1 Day f (a -> b)
f Chain1 Day f a
x forall a b. (a -> b) -> a -> b
($)

instance Functor f => Apply (Chain1 Comp f) where
    <.> :: forall a b.
Chain1 Comp f (a -> b) -> Chain1 Comp f a -> Chain1 Comp f b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault

-- | @'Chain1' 'Comp'@ is the free "semigroup in the semigroupoidal
-- category of endofunctors enriched by 'Comp'" --- aka, the free 'Bind'.
instance Functor f => Bind (Chain1 Comp f) where
    Chain1 Comp f a
x >>- :: forall a b.
Chain1 Comp f a -> (a -> Chain1 Comp f b) -> Chain1 Comp f b
>>- a -> Chain1 Comp f b
f = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Chain1 Comp f a
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= a -> Chain1 Comp f b
f)

-- | @'Chain1' (':*:')@ is the free "semigroup in the semigroupoidal
-- category of endofunctors enriched by ':*:'" --- aka, the free 'Alt'.
instance Functor f => Alt (Chain1 (:*:) f) where
    Chain1 (:*:) f a
x <!> :: forall a. Chain1 (:*:) f a -> Chain1 (:*:) f a -> Chain1 (:*:) f a
<!> Chain1 (:*:) f a
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Chain1 (:*:) f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Chain1 (:*:) f a
y)

-- | @'Chain1' 'Product'@ is the free "semigroup in the semigroupoidal
-- category of endofunctors enriched by 'Product'" --- aka, the free 'Alt'.
instance Functor f => Alt (Chain1 Product f) where
    Chain1 Product f a
x <!> :: forall a.
Chain1 Product f a -> Chain1 Product f a -> Chain1 Product f a
<!> Chain1 Product f a
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Chain1 Product f a
x Chain1 Product f a
y)

-- | @'Chain1' 'CD.Day'@ is the free "semigroup in the semigroupoidal
-- category of endofunctors enriched by 'CD.Day'" --- aka, the free 'Divise'.
--
-- @since 0.3.0.0
instance Contravariant f => Divise (Chain1 CD.Day f) where
    divise :: forall a b c.
(a -> (b, c)) -> Chain1 Day f b -> Chain1 Day f c -> Chain1 Day f a
divise a -> (b, c)
f Chain1 Day f b
x Chain1 Day f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day Chain1 Day f b
x Chain1 Day f c
y a -> (b, c)
f

-- | @'Chain1' 'N.Night'@ is the free "semigroup in the semigroupoidal
-- category of endofunctors enriched by 'N.Night'" --- aka, the free
-- 'Decide'.
--
-- @since 0.3.0.0
instance Contravariant f => Decide (Chain1 N.Night f) where
    decide :: forall a b c.
(a -> Either b c)
-> Chain1 Night f b -> Chain1 Night f c -> Chain1 Night f a
decide a -> Either b c
f Chain1 Night f b
x Chain1 Night f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1 -> b c1 -> (c -> Either b1 c1) -> Night a b c
N.Night Chain1 Night f b
x Chain1 Night f c
y a -> Either b c
f

-- | @since 0.4.0.0
instance Invariant f => Inply (Chain1 ID.Day f) where
    gather :: forall b c a.
(b -> c -> a)
-> (a -> (b, c))
-> Chain1 Day f b
-> Chain1 Day f c
-> Chain1 Day f a
gather b -> c -> a
f a -> (b, c)
g Chain1 Day f b
x Chain1 Day f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day Chain1 Day f b
x Chain1 Day f c
y b -> c -> a
f a -> (b, c)
g)

instance Tensor t i => Inject (Chain t i) where
    inject :: forall (f :: * -> *). f ~> Chain t i f
inject = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
f ~> Chain t i f
injectChain

-- | @since 0.4.0.0
instance Invariant f => Inalt (Chain1 IN.Night f) where
    swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Chain1 Night f b
-> Chain1 Night f c
-> Chain1 Night f a
swerve b -> a
f c -> a
g a -> Either b c
h Chain1 Night f b
x Chain1 Night f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night Chain1 Night f b
x Chain1 Night f c
y b -> a
f c -> a
g a -> Either b c
h)

-- | We can collapse and interpret an @'Chain' t i@ if we have @'Tensor' t@.
instance MonoidIn t i f => Interpret (Chain t i) f where
    interpret
        :: forall g. ()
        => g ~> f
        -> Chain t i g ~> f
    interpret :: forall (g :: * -> *). (g ~> f) -> Chain t i g ~> f
interpret g ~> f
f = Chain t i g ~> f
go
      where
        go :: Chain t i g ~> f
        go :: Chain t i g ~> f
go = \case
          Done i x
x  -> forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
MonoidIn t i f =>
i ~> f
pureT @t i x
x
          More t g (Chain t i g) x
xs -> forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
SemigroupIn t f =>
(g ~> f) -> (h ~> f) -> t g h ~> f
binterpret g ~> f
f Chain t i g ~> f
go t g (Chain t i g) x
xs

-- | Convert a tensor value pairing two @f@s into a two-item 'Chain'.  An
-- analogue of 'toListBy'.
--
-- @since 0.3.1.0
toChain :: Tensor t i => t f f ~> Chain t i f
toChain :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t f f ~> Chain t i f
toChain = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright forall {k} (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject

-- | Create a singleton chain.
--
-- @since 0.3.0.0
injectChain :: Tensor t i => f ~> Chain t i f
injectChain :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
f ~> Chain t i f
injectChain = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
f ~> t f i
intro1

-- | A 'Chain1' is "one or more linked @f@s", and a 'Chain' is "zero or
-- more linked @f@s".  So, we can convert from a 'Chain1' to a 'Chain' that
-- always has at least one @f@.
--
-- The result of this function always is made with 'More' at the top level.
fromChain1
    :: Tensor t i
    => Chain1 t f ~> Chain t i f
fromChain1 :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
Chain1 t f ~> Chain t i f
fromChain1 = forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 (forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
f ~> t f i
intro1) forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
t f (Chain t i f) a -> Chain t i f a
More

-- | A type @'ListBy' t@ is supposed to represent the successive application of
-- @t@s to itself.  The type @'Chain' t i f@ is an actual concrete
-- ADT that contains successive applications of @t@ to itself, and you can
-- pattern match on each layer.
--
-- 'unrolling' states that the two types are isormorphic.  Use 'unroll'
-- and 'reroll' to convert between the two.
unrolling
    :: Tensor t i
    => ListBy t f <~> Chain t i f
unrolling :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
ListBy t f <~> Chain t i f
unrolling = forall {k} (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
ListBy t f ~> Chain t i f
unroll forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
Chain t i f ~> ListBy t f
reroll

-- | A @'Chain1' t f@ is like a non-empty linked list of @f@s, and
-- a @'Chain' t i f@ is a possibly-empty linked list of @f@s.  This
-- witnesses the fact that the former is isomorphic to @f@ consed to the
-- latter.
splittingChain1
    :: forall t i f. (Matchable t i, FunctorBy t f)
    => Chain1 t f <~> t f (Chain t i f)
splittingChain1 :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
Chain1 t f <~> t f (Chain t i f)
splittingChain1 = forall (f :: * -> *) (g :: * -> *). (f <~> g) -> g <~> f
fromF forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f <~> Chain1 t f
unrollingNE
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
NonEmptyBy t f <~> t f (ListBy t f)
splittingNE @t
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
HBifunctor t =>
(f <~> f') -> (g <~> g') -> t f g <~> t f' g'
overHBifunctor forall a. a -> a
id forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
ListBy t f <~> Chain t i f
unrolling

-- | A @'Chain' t i f@ is a linked list of @f@s, and a @'Chain1' t f@ is
-- a non-empty linked list of @f@s.  This witnesses the fact that
-- a @'Chain' t i f@ is either empty (@i@) or non-empty (@'Chain1' t f@).
matchingChain
    :: forall t i f. (Matchable t i, FunctorBy t f)
    => Chain t i f <~> i :+: Chain1 t f
matchingChain :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
Chain t i f <~> (i :+: Chain1 t f)
matchingChain = forall (f :: * -> *) (g :: * -> *). (f <~> g) -> g <~> f
fromF forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
ListBy t f <~> Chain t i f
unrolling
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
ListBy t f <~> (i :+: NonEmptyBy t f)
matchingLB @t
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (f' :: k -> *) (g :: k -> *) (g' :: k -> *).
HBifunctor t =>
(f <~> f') -> (g <~> g') -> t f g <~> t f' g'
overHBifunctor forall a. a -> a
id forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f <~> Chain1 t f
unrollingNE

-- | The "reverse" function representing 'matchingChain'.  Provided here
-- as a separate function because it does not require @'Functor' f@.
unmatchChain
    :: forall t i f. Tensor t i
    => i :+: Chain1 t f ~> Chain t i f
unmatchChain :: forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
(i :+: Chain1 t f) ~> Chain t i f
unmatchChain = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
ListBy t f ~> Chain t i f
unroll forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
i ~> ListBy t f
nilLB @t forall (t :: (* -> *) -> (* -> *) -> * -> *) (h :: * -> *)
       (f :: * -> *) (g :: * -> *).
SemigroupIn t h =>
(f ~> h) -> (g ~> h) -> t f g ~> h
!*! forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
NonEmptyBy t f ~> ListBy t f
fromNE @t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
       (l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE

-- | We have to wrap @t@ in 'WrapHBF' to prevent overlapping instances.
instance (Tensor t i, FunctorBy t (Chain t i f)) => SemigroupIn (WrapHBF t) (Chain t i f) where
    biretract :: WrapHBF t (Chain t i f) (Chain t i f) ~> Chain t i f
biretract = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3 -> *) (f :: k1)
       (g :: k2) (a :: k3).
WrapHBF t f g a -> t f g a
unwrapHBF
    binterpret :: forall (g :: * -> *) (h :: * -> *).
(g ~> Chain t i f)
-> (h ~> Chain t i f) -> WrapHBF t g h ~> Chain t i f
binterpret g ~> Chain t i f
f h ~> Chain t i f
g = forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
SemigroupIn t f =>
t f f ~> f
biretract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
       (j :: k -> *) (g :: k -> *) (l :: k -> *).
HBifunctor t =>
(f ~> j) -> (g ~> l) -> t f g ~> t j l
hbimap g ~> Chain t i f
f h ~> Chain t i f
g

-- | @'Chain' t i@ is the "free @'MonoidIn' t i@".  However, we have to
-- wrap @t@ in 'WrapHBF' and @i@ in 'WrapF' to prevent overlapping instances.
instance (Tensor t i, FunctorBy t (Chain t i f)) => MonoidIn (WrapHBF t) (WrapF i) (Chain t i f) where
    pureT :: WrapF i ~> Chain t i f
pureT = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). WrapF f a -> f a
unwrapF

instance Apply (Chain Day Identity f) where
    Chain Day Identity f (a -> b)
f <.> :: forall a b.
Chain Day Identity f (a -> b)
-> Chain Day Identity f a -> Chain Day Identity f b
<.> Chain Day Identity f a
x = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> Day f g a
Day Chain Day Identity f (a -> b)
f Chain Day Identity f a
x forall a b. (a -> b) -> a -> b
($)

-- | @'Chain' 'Day' 'Identity'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by 'Day'" --- aka, the free
-- 'Applicative'.
instance Applicative (Chain Day Identity f) where
    pure :: forall a. a -> Chain Day Identity f a
pure  = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
    <*> :: forall a b.
Chain Day Identity f (a -> b)
-> Chain Day Identity f a -> Chain Day Identity f b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)

-- | @since 0.3.0.0
instance Divise (Chain CD.Day Proxy f) where
    divise :: forall a b c.
(a -> (b, c))
-> Chain Day Proxy f b
-> Chain Day Proxy f c
-> Chain Day Proxy f a
divise a -> (b, c)
f Chain Day Proxy f b
x Chain Day Proxy f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day Chain Day Proxy f b
x Chain Day Proxy f c
y a -> (b, c)
f

-- | @'Chain' 'CD.Day' 'Proxy'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by contravariant 'CD.Day'" --- aka,
-- the free 'Divisible'.
--
-- @since 0.3.0.0
instance Divisible (Chain CD.Day Proxy f) where
    divide :: forall a b c.
(a -> (b, c))
-> Chain Day Proxy f b
-> Chain Day Proxy f c
-> Chain Day Proxy f a
divide a -> (b, c)
f Chain Day Proxy f b
x Chain Day Proxy f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (a -> (b, c)) -> Day f g a
CD.Day Chain Day Proxy f b
x Chain Day Proxy f c
y a -> (b, c)
f
    conquer :: forall a. Chain Day Proxy f a
conquer = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall {k} (t :: k). Proxy t
Proxy

-- | @since 0.4.0.0
instance Inply (Chain ID.Day Identity f) where
    gather :: forall b c a.
(b -> c -> a)
-> (a -> (b, c))
-> Chain Day Identity f b
-> Chain Day Identity f c
-> Chain Day Identity f a
gather b -> c -> a
f a -> (b, c)
g Chain Day Identity f b
x Chain Day Identity f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (forall (f :: * -> *) (g :: * -> *) a b c.
f b -> g c -> (b -> c -> a) -> (a -> (b, c)) -> Day f g a
ID.Day Chain Day Identity f b
x Chain Day Identity f c
y b -> c -> a
f a -> (b, c)
g)

-- | @since 0.4.0.0
instance Inplicative (Chain ID.Day Identity f) where
    knot :: forall a. a -> Chain Day Identity f a
knot = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity

-- | @since 0.4.0.0
instance Inalt (Chain IN.Night IN.Not f) where
    swerve :: forall b a c.
(b -> a)
-> (c -> a)
-> (a -> Either b c)
-> Chain Night Not f b
-> Chain Night Not f c
-> Chain Night Not f a
swerve b -> a
f c -> a
g a -> Either b c
h Chain Night Not f b
x Chain Night Not f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1
-> b c1
-> (b1 -> c)
-> (c1 -> c)
-> (c -> Either b1 c1)
-> Night a b c
IN.Night Chain Night Not f b
x Chain Night Not f c
y b -> a
f c -> a
g a -> Either b c
h)

-- | @since 0.4.0.0
instance Inplus (Chain IN.Night IN.Not f) where
    reject :: forall a. (a -> Void) -> Chain Night Not f a
reject = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Void) -> Not a
IN.Not

-- | @since 0.3.0.0
instance Decide (Chain N.Night N.Not f) where
    decide :: forall a b c.
(a -> Either b c)
-> Chain Night Not f b
-> Chain Night Not f c
-> Chain Night Not f a
decide a -> Either b c
f Chain Night Not f b
x Chain Night Not f c
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) b1 (b :: * -> *) c1 c.
a b1 -> b c1 -> (c -> Either b1 c1) -> Night a b c
N.Night Chain Night Not f b
x Chain Night Not f c
y a -> Either b c
f

-- | @'Chain' 'N.Night' 'N.Refutec'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by 'N.Night'" --- aka, the free
-- 'Conclude'.
--
-- @since 0.3.0.0
instance Conclude (Chain N.Night N.Not f) where
    conclude :: forall a. (a -> Void) -> Chain Night Not f a
conclude = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Void) -> Not a
N.Not

instance Apply (Chain Comp Identity f) where
    <.> :: forall a b.
Chain Comp Identity f (a -> b)
-> Chain Comp Identity f a -> Chain Comp Identity f b
(<.>) = forall (f :: * -> *) a b. Bind f => f (a -> b) -> f a -> f b
apDefault

instance Applicative (Chain Comp Identity f) where
    pure :: forall a. a -> Chain Comp Identity f a
pure  = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
    <*> :: forall a b.
Chain Comp Identity f (a -> b)
-> Chain Comp Identity f a -> Chain Comp Identity f b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)

instance Bind (Chain Comp Identity f) where
    Chain Comp Identity f a
x >>- :: forall a b.
Chain Comp Identity f a
-> (a -> Chain Comp Identity f b) -> Chain Comp Identity f b
>>- a -> Chain Comp Identity f b
f = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Chain Comp Identity f a
x forall {k} (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= a -> Chain Comp Identity f b
f)

-- | @'Chain' 'Comp' 'Identity'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by 'Comp'" --- aka, the free
-- 'Monad'.
instance Monad (Chain Comp Identity f) where
    >>= :: forall a b.
Chain Comp Identity f a
-> (a -> Chain Comp Identity f b) -> Chain Comp Identity f b
(>>=) = forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)

instance Functor f => Alt (Chain (:*:) Proxy f) where
    Chain (:*:) Proxy f a
x <!> :: forall a.
Chain (:*:) Proxy f a
-> Chain (:*:) Proxy f a -> Chain (:*:) Proxy f a
<!> Chain (:*:) Proxy f a
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Chain (:*:) Proxy f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Chain (:*:) Proxy f a
y)

-- | @'Chain' (':*:') 'Proxy'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by ':*:'" --- aka, the free
-- 'Plus'.
instance Functor f => Plus (Chain (:*:) Proxy f) where
    zero :: forall a. Chain (:*:) Proxy f a
zero = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall {k} (t :: k). Proxy t
Proxy

instance Functor f => Alt (Chain Product Proxy f) where
    Chain Product Proxy f a
x <!> :: forall a.
Chain Product Proxy f a
-> Chain Product Proxy f a -> Chain Product Proxy f a
<!> Chain Product Proxy f a
y = forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
       (f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Chain Product Proxy f a
x Chain Product Proxy f a
y)

-- | @'Chain' (':*:') 'Proxy'@ is the free "monoid in the monoidal
-- category of endofunctors enriched by ':*:'" --- aka, the free
-- 'Plus'.
instance Functor f => Plus (Chain Product Proxy f) where
    zero :: forall a. Chain Product Proxy f a
zero = forall {k} {k1} (t :: k -> (k1 -> *) -> k1 -> *) (i :: k1 -> *)
       (f :: k) (a :: k1).
i a -> Chain t i f a
Done forall {k} (t :: k). Proxy t
Proxy