{-# 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
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
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)
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
foldChain1
:: forall t f g. HBifunctor t
=> f ~> g
-> t f g ~> g
-> 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)
foldChain1A
:: (HBifunctor t, Functor h)
=> (forall x. f x -> h (g x))
-> (forall x. t f (Comp h g) x -> h (g x))
-> 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)
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
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
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
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
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)
foldChain
:: forall t i f g. HBifunctor t
=> (i ~> g)
-> (t f g ~> g)
-> 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)
foldChainA
:: (HBifunctor t, Functor h)
=> (forall x. i x -> h (g x))
-> (forall x. t f (Comp h g) x -> h (g x))
-> 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)
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
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
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
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
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
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
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
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
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