{-# OPTIONS_GHC -Wno-orphans #-}
module Data.HFunctor.Chain (
Chain(..)
, foldChain, foldChainA
, unfoldChain
, unroll
, reroll
, unrolling
, appendChain
, splittingChain
, toChain
, injectChain
, unconsChain
, Chain1(..)
, foldChain1, foldChain1A
, unfoldChain1
, unrollingNE
, unrollNE
, rerollNE
, appendChain1
, fromChain1
, matchChain1
, toChain1
, injectChain1
, 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.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
instance (HBifunctor t, SemigroupIn t f) => Interpret (Chain1 t) f where
retract :: Chain1 t f x -> f x
retract = \case
Done1 x :: f x
x -> f x
x
More1 xs :: t f (Chain1 t f) x
xs -> (f ~> f) -> (Chain1 t f ~> f) -> t f (Chain1 t f) x -> f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
SemigroupIn t f =>
(g ~> f) -> (h ~> f) -> t g h ~> f
binterpret forall a. a -> a
f ~> f
id Chain1 t f ~> f
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 :: (g ~> f) -> Chain1 t g ~> f
interpret f :: g ~> f
f = Chain1 t g x -> f x
Chain1 t g ~> f
go
where
go :: Chain1 t g ~> f
go :: Chain1 t g x -> f x
go = \case
Done1 x :: g x
x -> g x -> f x
g ~> f
f g x
x
More1 xs :: t g (Chain1 t g) x
xs -> (g ~> f) -> (Chain1 t g ~> f) -> t g (Chain1 t g) x -> f x
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
unrollingNE :: forall t f. (Associative t, FunctorBy t f) => NonEmptyBy t f <~> Chain1 t f
unrollingNE :: NonEmptyBy t f <~> Chain1 t f
unrollingNE = (NonEmptyBy t f ~> Chain1 t f)
-> (Chain1 t f ~> NonEmptyBy t f) -> NonEmptyBy t f <~> Chain1 t f
forall k (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF NonEmptyBy t f ~> Chain1 t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> Chain1 t f
unrollNE Chain1 t f ~> NonEmptyBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE
unrollNE :: (Associative t, FunctorBy t f) => NonEmptyBy t f ~> Chain1 t f
unrollNE :: NonEmptyBy t f ~> Chain1 t f
unrollNE = (NonEmptyBy t f ~> (f :+: t f (NonEmptyBy t f)))
-> NonEmptyBy t f ~> Chain1 t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *)
(g :: * -> *).
HBifunctor t =>
(g ~> (f :+: t f g)) -> g ~> Chain1 t f
unfoldChain1 NonEmptyBy t f ~> (f :+: t f (NonEmptyBy t f))
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> (f :+: t f (NonEmptyBy t f))
matchNE
appendChain1
:: forall t f. (Associative t, FunctorBy t f)
=> t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 :: t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 = NonEmptyBy t f x -> Chain1 t f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f ~> Chain1 t f
unrollNE
(NonEmptyBy t f x -> Chain1 t f x)
-> (t (Chain1 t f) (Chain1 t f) x -> NonEmptyBy t f x)
-> t (Chain1 t f) (Chain1 t f) x
-> Chain1 t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (NonEmptyBy t f) (NonEmptyBy t f) x -> NonEmptyBy t f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
t (NonEmptyBy t f) (NonEmptyBy t f) ~> NonEmptyBy t f
appendNE
(t (NonEmptyBy t f) (NonEmptyBy t f) x -> NonEmptyBy t f x)
-> (t (Chain1 t f) (Chain1 t f) x
-> t (NonEmptyBy t f) (NonEmptyBy t f) x)
-> t (Chain1 t f) (Chain1 t f) x
-> NonEmptyBy t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chain1 t f ~> NonEmptyBy t f)
-> (Chain1 t f ~> NonEmptyBy t f)
-> t (Chain1 t f) (Chain1 t f)
~> t (NonEmptyBy t f) (NonEmptyBy t f)
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 Chain1 t f ~> NonEmptyBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE Chain1 t f ~> NonEmptyBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE
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) x -> Chain1 t f x
biretract = t (Chain1 t f) (Chain1 t f) x -> Chain1 t f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (t (Chain1 t f) (Chain1 t f) x -> Chain1 t f x)
-> (WrapHBF t (Chain1 t f) (Chain1 t f) x
-> t (Chain1 t f) (Chain1 t f) x)
-> WrapHBF t (Chain1 t f) (Chain1 t f) x
-> Chain1 t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapHBF t (Chain1 t f) (Chain1 t f) x
-> t (Chain1 t f) (Chain1 t f) x
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 :: (g ~> Chain1 t f)
-> (h ~> Chain1 t f) -> WrapHBF t g h ~> Chain1 t f
binterpret f :: g ~> Chain1 t f
f g :: h ~> Chain1 t f
g = WrapHBF t (Chain1 t f) (Chain1 t f) x -> Chain1 t f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
SemigroupIn t f =>
t f f ~> f
biretract (WrapHBF t (Chain1 t f) (Chain1 t f) x -> Chain1 t f x)
-> (WrapHBF t g h x -> WrapHBF t (Chain1 t f) (Chain1 t f) x)
-> WrapHBF t g h x
-> Chain1 t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g ~> Chain1 t f)
-> (h ~> Chain1 t f)
-> WrapHBF t g h ~> WrapHBF t (Chain1 t f) (Chain1 t f)
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
instance Functor f => Apply (Chain1 Day f) where
f :: Chain1 Day f (a -> b)
f <.> :: Chain1 Day f (a -> b) -> Chain1 Day f a -> Chain1 Day f b
<.> x :: Chain1 Day f a
x = Day (Chain1 Day f) (Chain1 Day f) b -> Chain1 Day f b
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Day (Chain1 Day f) (Chain1 Day f) b -> Chain1 Day f b)
-> Day (Chain1 Day f) (Chain1 Day f) b -> Chain1 Day f b
forall a b. (a -> b) -> a -> b
$ Chain1 Day f (a -> b)
-> Chain1 Day f a
-> ((a -> b) -> a -> b)
-> Day (Chain1 Day f) (Chain1 Day f) 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 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
instance Functor f => Apply (Chain1 Comp f) where
<.> :: Chain1 Comp f (a -> b) -> Chain1 Comp f a -> Chain1 Comp f 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
instance Functor f => Bind (Chain1 Comp f) where
x :: Chain1 Comp f a
x >>- :: Chain1 Comp f a -> (a -> Chain1 Comp f b) -> Chain1 Comp f b
>>- f :: a -> Chain1 Comp f b
f = Comp (Chain1 Comp f) (Chain1 Comp f) b -> Chain1 Comp f b
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Chain1 Comp f a
x Chain1 Comp f a
-> (a -> Chain1 Comp f b) -> Comp (Chain1 Comp f) (Chain1 Comp f) b
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= a -> Chain1 Comp f b
f)
instance Functor f => Alt (Chain1 (:*:) f) where
x :: Chain1 (:*:) f a
x <!> :: Chain1 (:*:) f a -> Chain1 (:*:) f a -> Chain1 (:*:) f a
<!> y :: Chain1 (:*:) f a
y = (:*:) (Chain1 (:*:) f) (Chain1 (:*:) f) a -> Chain1 (:*:) f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Chain1 (:*:) f a
x Chain1 (:*:) f a
-> Chain1 (:*:) f a -> (:*:) (Chain1 (:*:) f) (Chain1 (:*:) f) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Chain1 (:*:) f a
y)
instance Functor f => Alt (Chain1 Product f) where
x :: Chain1 Product f a
x <!> :: Chain1 Product f a -> Chain1 Product f a -> Chain1 Product f a
<!> y :: Chain1 Product f a
y = Product (Chain1 Product f) (Chain1 Product f) a
-> Chain1 Product f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Chain1 Product f a
-> Chain1 Product f a
-> Product (Chain1 Product f) (Chain1 Product f) a
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)
instance Contravariant f => Divise (Chain1 CD.Day f) where
divise :: (a -> (b, c)) -> Chain1 Day f b -> Chain1 Day f c -> Chain1 Day f a
divise f :: a -> (b, c)
f x :: Chain1 Day f b
x y :: Chain1 Day f c
y = Day (Chain1 Day f) (Chain1 Day f) a -> Chain1 Day f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Day (Chain1 Day f) (Chain1 Day f) a -> Chain1 Day f a)
-> Day (Chain1 Day f) (Chain1 Day f) a -> Chain1 Day f a
forall a b. (a -> b) -> a -> b
$ Chain1 Day f b
-> Chain1 Day f c
-> (a -> (b, c))
-> Day (Chain1 Day f) (Chain1 Day f) a
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
instance Contravariant f => Decide (Chain1 N.Night f) where
decide :: (a -> Either b c)
-> Chain1 Night f b -> Chain1 Night f c -> Chain1 Night f a
decide f :: a -> Either b c
f x :: Chain1 Night f b
x y :: Chain1 Night f c
y = Night (Chain1 Night f) (Chain1 Night f) a -> Chain1 Night f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
t (Chain1 t f) (Chain1 t f) ~> Chain1 t f
appendChain1 (Night (Chain1 Night f) (Chain1 Night f) a -> Chain1 Night f a)
-> Night (Chain1 Night f) (Chain1 Night f) a -> Chain1 Night f a
forall a b. (a -> b) -> a -> b
$ Chain1 Night f b
-> Chain1 Night f c
-> (a -> Either b c)
-> Night (Chain1 Night f) (Chain1 Night f) a
forall (f :: * -> *) b (g :: * -> *) c a.
f b -> g c -> (a -> Either b c) -> Night f g a
N.Night Chain1 Night f b
x Chain1 Night f c
y a -> Either b c
f
instance Tensor t i => Inject (Chain t i) where
inject :: f x -> Chain t i f x
inject = f x -> Chain t i f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
f ~> Chain t i f
injectChain
instance MonoidIn t i f => Interpret (Chain t i) f where
interpret
:: forall g. ()
=> g ~> f
-> Chain t i g ~> f
interpret :: (g ~> f) -> Chain t i g ~> f
interpret f :: g ~> f
f = Chain t i g x -> f x
Chain t i g ~> f
go
where
go :: Chain t i g ~> f
go :: Chain t i g x -> f x
go = \case
Done x :: i x
x -> i x -> f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
MonoidIn t i f =>
i ~> f
pureT @t i x
x
More xs :: t g (Chain t i g) x
xs -> (g ~> f) -> (Chain t i g ~> f) -> t g (Chain t i g) x -> f x
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
toChain :: Tensor t i => t f f ~> Chain t i f
toChain :: t f f ~> Chain t i f
toChain = 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 -> Chain t i f x)
-> (t f f x -> t f (Chain t i f) x) -> t f f x -> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f ~> Chain t i f) -> t f f ~> 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
hright f ~> Chain t i f
forall k (t :: (k -> *) -> k -> *) (f :: k -> *).
Inject t =>
f ~> t f
inject
injectChain :: Tensor t i => f ~> Chain t i f
injectChain :: f ~> Chain t i f
injectChain = 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 -> Chain t i f x)
-> (f x -> t f (Chain t i f) x) -> f x -> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i ~> Chain t i f) -> t f i ~> 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
hright i ~> Chain t i f
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done (t f i x -> t f (Chain t i f) x)
-> (f x -> t f i x) -> f x -> t f (Chain t i f) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> t f i x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
f ~> t f i
intro1
fromChain1
:: Tensor t i
=> Chain1 t f ~> Chain t i f
fromChain1 :: Chain1 t f ~> Chain t i f
fromChain1 = (f ~> Chain t i f)
-> (t f (Chain t i f) ~> Chain t i f) -> Chain1 t f ~> Chain t i f
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
(g :: k -> *).
HBifunctor t =>
(f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 (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 -> Chain t i f x)
-> (f x -> t f (Chain t i f) x) -> f x -> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i ~> Chain t i f) -> t f i ~> 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
hright i ~> Chain t i f
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done (t f i x -> t f (Chain t i f) x)
-> (f x -> t f i x) -> f x -> t f (Chain t i f) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> t f i x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
f ~> t f i
intro1) t f (Chain t i f) ~> Chain t i f
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
unrolling
:: Tensor t i
=> ListBy t f <~> Chain t i f
unrolling :: ListBy t f <~> Chain t i f
unrolling = (ListBy t f ~> Chain t i f)
-> (Chain t i f ~> ListBy t f) -> ListBy t f <~> Chain t i f
forall k (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF ListBy t f ~> Chain t i f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
ListBy t f ~> Chain t i f
unroll Chain t i f ~> ListBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
Chain t i f ~> ListBy t f
reroll
splittingChain1
:: forall t i f. (Matchable t i, FunctorBy t f)
=> Chain1 t f <~> t f (Chain t i f)
splittingChain1 :: Chain1 t f <~> t f (Chain t i f)
splittingChain1 = (NonEmptyBy t f <~> Chain1 t f) -> Chain1 t f <~> NonEmptyBy t f
forall (f :: * -> *) (g :: * -> *). (f <~> g) -> g <~> f
fromF NonEmptyBy t f <~> Chain1 t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f <~> Chain1 t f
unrollingNE
(p (NonEmptyBy t f a) (NonEmptyBy t f a)
-> p (Chain1 t f a) (Chain1 t f a))
-> (p (t f (Chain t i f) a) (t f (Chain t i f) a)
-> p (NonEmptyBy t f a) (NonEmptyBy t f a))
-> p (t f (Chain t i f) a) (t f (Chain t i f) a)
-> p (Chain1 t f a) (Chain1 t f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (i :: * -> *) (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
NonEmptyBy t f <~> t f (ListBy t f)
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
(Matchable t i, FunctorBy t f) =>
NonEmptyBy t f <~> t f (ListBy t f)
splittingNE @t
(p (t f (ListBy t f) a) (t f (ListBy t f) a)
-> p (NonEmptyBy t f a) (NonEmptyBy t f a))
-> (p (t f (Chain t i f) a) (t f (Chain t i f) a)
-> p (t f (ListBy t f) a) (t f (ListBy t f) a))
-> p (t f (Chain t i f) a) (t f (Chain t i f) a)
-> p (NonEmptyBy t f a) (NonEmptyBy t f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f <~> f)
-> (ListBy t f <~> Chain t i f)
-> t f (ListBy t f) <~> t f (Chain t i f)
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
f <~> f
id ListBy t f <~> Chain t i f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
ListBy t f <~> Chain t i f
unrolling
matchingChain
:: forall t i f. (Tensor t i, Matchable t i, FunctorBy t f)
=> Chain t i f <~> i :+: Chain1 t f
matchingChain :: Chain t i f <~> (i :+: Chain1 t f)
matchingChain = (ListBy t f <~> Chain t i f) -> Chain t i f <~> ListBy t f
forall (f :: * -> *) (g :: * -> *). (f <~> g) -> g <~> f
fromF ListBy t f <~> Chain t i f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
ListBy t f <~> Chain t i f
unrolling
(p (ListBy t f a) (ListBy t f a)
-> p (Chain t i f a) (Chain t i f a))
-> (p ((:+:) i (Chain1 t f) a) ((:+:) i (Chain1 t f) a)
-> p (ListBy t f a) (ListBy t f a))
-> p ((:+:) i (Chain1 t f) a) ((:+:) i (Chain1 t f) a)
-> p (Chain t i f a) (Chain t i f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (i :: * -> *) (f :: * -> *).
(Matchable t i, FunctorBy t f) =>
ListBy t f <~> (i :+: NonEmptyBy t f)
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
(Matchable t i, FunctorBy t f) =>
ListBy t f <~> (i :+: NonEmptyBy t f)
matchingLB @t
(p ((:+:) i (NonEmptyBy t f) a) ((:+:) i (NonEmptyBy t f) a)
-> p (ListBy t f a) (ListBy t f a))
-> (p ((:+:) i (Chain1 t f) a) ((:+:) i (Chain1 t f) a)
-> p ((:+:) i (NonEmptyBy t f) a) ((:+:) i (NonEmptyBy t f) a))
-> p ((:+:) i (Chain1 t f) a) ((:+:) i (Chain1 t f) a)
-> p (ListBy t f a) (ListBy t f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i <~> i)
-> (NonEmptyBy t f <~> Chain1 t f)
-> (i :+: NonEmptyBy t f) <~> (i :+: Chain1 t f)
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
i <~> i
id NonEmptyBy t f <~> Chain1 t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
(Associative t, FunctorBy t f) =>
NonEmptyBy t f <~> Chain1 t f
unrollingNE
unmatchChain
:: forall t i f. Tensor t i
=> i :+: Chain1 t f ~> Chain t i f
unmatchChain :: (i :+: Chain1 t f) ~> Chain t i f
unmatchChain = ListBy t f x -> Chain t i f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
ListBy t f ~> Chain t i f
unroll (ListBy t f x -> Chain t i f x)
-> ((:+:) i (Chain1 t f) x -> ListBy t f x)
-> (:+:) i (Chain1 t f) x
-> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (i :: * -> *) (f :: * -> *). Tensor t i => i ~> ListBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
i ~> ListBy t f
nilLB @t (forall x. i x -> ListBy t f x)
-> (NonEmptyBy t f ~> ListBy t f)
-> (i :+: NonEmptyBy t f) ~> ListBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (h :: * -> *)
(f :: * -> *) (g :: * -> *).
SemigroupIn t h =>
(f ~> h) -> (g ~> h) -> t f g ~> h
!*! forall (i :: * -> *) (f :: * -> *).
Tensor t i =>
NonEmptyBy t f ~> ListBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
NonEmptyBy t f ~> ListBy t f
fromNE @t) ((:+:) i (NonEmptyBy t f) x -> ListBy t f x)
-> ((:+:) i (Chain1 t f) x -> (:+:) i (NonEmptyBy t f) x)
-> (:+:) i (Chain1 t f) x
-> ListBy t f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Chain1 t f ~> NonEmptyBy t f)
-> (i :+: Chain1 t f) ~> (i :+: NonEmptyBy t f)
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
(l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright Chain1 t f ~> NonEmptyBy t f
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
Associative t =>
Chain1 t f ~> NonEmptyBy t f
rerollNE
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) x -> Chain t i f x
biretract = t (Chain t i f) (Chain t i f) x -> Chain t i f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (t (Chain t i f) (Chain t i f) x -> Chain t i f x)
-> (WrapHBF t (Chain t i f) (Chain t i f) x
-> t (Chain t i f) (Chain t i f) x)
-> WrapHBF t (Chain t i f) (Chain t i f) x
-> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapHBF t (Chain t i f) (Chain t i f) x
-> t (Chain t i f) (Chain t i f) x
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 :: (g ~> Chain t i f)
-> (h ~> Chain t i f) -> WrapHBF t g h ~> Chain t i f
binterpret f :: g ~> Chain t i f
f g :: h ~> Chain t i f
g = WrapHBF t (Chain t i f) (Chain t i f) x -> Chain t i f x
forall (t :: (* -> *) -> (* -> *) -> * -> *) (f :: * -> *).
SemigroupIn t f =>
t f f ~> f
biretract (WrapHBF t (Chain t i f) (Chain t i f) x -> Chain t i f x)
-> (WrapHBF t g h x -> WrapHBF t (Chain t i f) (Chain t i f) x)
-> WrapHBF t g h x
-> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g ~> Chain t i f)
-> (h ~> Chain t i f)
-> WrapHBF t g h ~> WrapHBF t (Chain t i f) (Chain t i f)
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
instance (Tensor t i, FunctorBy t (Chain t i f)) => MonoidIn (WrapHBF t) (WrapF i) (Chain t i f) where
pureT :: WrapF i x -> Chain t i f x
pureT = 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 -> Chain t i f x)
-> (WrapF i x -> i x) -> WrapF i x -> Chain t i f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapF i x -> i x
forall k (f :: k -> *) (a :: k). WrapF f a -> f a
unwrapF
instance Apply (Chain Day Identity f) where
f :: Chain Day Identity f (a -> b)
f <.> :: Chain Day Identity f (a -> b)
-> Chain Day Identity f a -> Chain Day Identity f b
<.> x :: Chain Day Identity f a
x = Day (Chain Day Identity f) (Chain Day Identity f) b
-> Chain Day Identity f b
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Day (Chain Day Identity f) (Chain Day Identity f) b
-> Chain Day Identity f b)
-> Day (Chain Day Identity f) (Chain Day Identity f) b
-> Chain Day Identity f b
forall a b. (a -> b) -> a -> b
$ Chain Day Identity f (a -> b)
-> Chain Day Identity f a
-> ((a -> b) -> a -> b)
-> Day (Chain Day Identity f) (Chain Day Identity f) 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 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
instance Applicative (Chain Day Identity f) where
pure :: a -> Chain Day Identity f a
pure = Identity a -> Chain Day Identity f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done (Identity a -> Chain Day Identity f a)
-> (a -> Identity a) -> a -> Chain Day Identity f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
<*> :: Chain Day Identity f (a -> b)
-> Chain Day Identity f a -> Chain Day Identity f 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
(<.>)
instance Divise (Chain CD.Day Proxy f) where
divise :: (a -> (b, c))
-> Chain Day Proxy f b
-> Chain Day Proxy f c
-> Chain Day Proxy f a
divise f :: a -> (b, c)
f x :: Chain Day Proxy f b
x y :: Chain Day Proxy f c
y = Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a)
-> Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a
forall a b. (a -> b) -> a -> b
$ Chain Day Proxy f b
-> Chain Day Proxy f c
-> (a -> (b, c))
-> Day (Chain Day Proxy f) (Chain Day Proxy f) a
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
instance Divisible (Chain CD.Day Proxy f) where
divide :: (a -> (b, c))
-> Chain Day Proxy f b
-> Chain Day Proxy f c
-> Chain Day Proxy f a
divide f :: a -> (b, c)
f x :: Chain Day Proxy f b
x y :: Chain Day Proxy f c
y = Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a)
-> Day (Chain Day Proxy f) (Chain Day Proxy f) a
-> Chain Day Proxy f a
forall a b. (a -> b) -> a -> b
$ Chain Day Proxy f b
-> Chain Day Proxy f c
-> (a -> (b, c))
-> Day (Chain Day Proxy f) (Chain Day Proxy f) a
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 :: Chain Day Proxy f a
conquer = Proxy a -> Chain Day Proxy f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done Proxy a
forall k (t :: k). Proxy t
Proxy
instance Decide (Chain N.Night N.Not f) where
decide :: (a -> Either b c)
-> Chain Night Not f b
-> Chain Night Not f c
-> Chain Night Not f a
decide f :: a -> Either b c
f x :: Chain Night Not f b
x y :: Chain Night Not f c
y = Night (Chain Night Not f) (Chain Night Not f) a
-> Chain Night Not f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Night (Chain Night Not f) (Chain Night Not f) a
-> Chain Night Not f a)
-> Night (Chain Night Not f) (Chain Night Not f) a
-> Chain Night Not f a
forall a b. (a -> b) -> a -> b
$ Chain Night Not f b
-> Chain Night Not f c
-> (a -> Either b c)
-> Night (Chain Night Not f) (Chain Night Not f) a
forall (f :: * -> *) b (g :: * -> *) c a.
f b -> g c -> (a -> Either b c) -> Night f g a
N.Night Chain Night Not f b
x Chain Night Not f c
y a -> Either b c
f
instance Conclude (Chain N.Night N.Not f) where
conclude :: (a -> Void) -> Chain Night Not f a
conclude = Not a -> Chain Night Not f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done (Not a -> Chain Night Not f a)
-> ((a -> Void) -> Not a) -> (a -> Void) -> Chain Night Not f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Void) -> Not a
forall a. (a -> Void) -> Not a
N.Not
instance Apply (Chain Comp Identity f) where
<.> :: Chain Comp Identity f (a -> b)
-> Chain Comp Identity f a -> Chain Comp Identity f 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 :: a -> Chain Comp Identity f a
pure = Identity a -> Chain Comp Identity f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done (Identity a -> Chain Comp Identity f a)
-> (a -> Identity a) -> a -> Chain Comp Identity f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity
<*> :: Chain Comp Identity f (a -> b)
-> Chain Comp Identity f a -> Chain Comp Identity f 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
x :: Chain Comp Identity f a
x >>- :: Chain Comp Identity f a
-> (a -> Chain Comp Identity f b) -> Chain Comp Identity f b
>>- f :: a -> Chain Comp Identity f b
f = Comp (Chain Comp Identity f) (Chain Comp Identity f) b
-> Chain Comp Identity f b
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 Chain Comp Identity f a
-> (a -> Chain Comp Identity f b)
-> Comp (Chain Comp Identity f) (Chain Comp Identity f) b
forall k (f :: * -> *) (g :: k -> *) (a :: k) x.
f x -> (x -> g a) -> Comp f g a
:>>= a -> Chain Comp Identity f b
f)
instance Monad (Chain Comp Identity f) where
>>= :: Chain Comp Identity f a
-> (a -> Chain Comp Identity f b) -> Chain Comp Identity f 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
x :: Chain (:*:) Proxy f a
x <!> :: Chain (:*:) Proxy f a
-> Chain (:*:) Proxy f a -> Chain (:*:) Proxy f a
<!> y :: Chain (:*:) Proxy f a
y = (:*:) (Chain (:*:) Proxy f) (Chain (:*:) Proxy f) a
-> Chain (:*:) Proxy f a
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 Chain (:*:) Proxy f a
-> Chain (:*:) Proxy f a
-> (:*:) (Chain (:*:) Proxy f) (Chain (:*:) Proxy f) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Chain (:*:) Proxy f a
y)
instance Functor f => Plus (Chain (:*:) Proxy f) where
zero :: Chain (:*:) Proxy f a
zero = Proxy a -> Chain (:*:) Proxy f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done Proxy a
forall k (t :: k). Proxy t
Proxy
instance Functor f => Alt (Chain Product Proxy f) where
x :: Chain Product Proxy f a
x <!> :: Chain Product Proxy f a
-> Chain Product Proxy f a -> Chain Product Proxy f a
<!> y :: Chain Product Proxy f a
y = Product (Chain Product Proxy f) (Chain Product Proxy f) a
-> Chain Product Proxy f a
forall (t :: (* -> *) -> (* -> *) -> * -> *) (i :: * -> *)
(f :: * -> *).
Tensor t i =>
t (Chain t i f) (Chain t i f) ~> Chain t i f
appendChain (Chain Product Proxy f a
-> Chain Product Proxy f a
-> Product (Chain Product Proxy f) (Chain Product Proxy f) a
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)
instance Functor f => Plus (Chain Product Proxy f) where
zero :: Chain Product Proxy f a
zero = Proxy a -> Chain Product Proxy f a
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k)
(a :: k).
i a -> Chain t i f a
Done Proxy a
forall k (t :: k). Proxy t
Proxy