module Data.HFunctor.Chain.Internal (
Chain1(..)
, foldChain1, unfoldChain1
, toChain1, injectChain1
, matchChain1
, Chain(..)
, foldChain, unfoldChain
, splittingChain, unconsChain
, DivAp1(..)
, DivAp(..)
, DecAlt(..)
, DecAlt1(..)
) where
import Control.Natural
import Control.Natural.IsoF
import Data.Functor.Classes
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Functor.Invariant
import Data.HBifunctor
import Data.HFunctor
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
$cto :: forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
(a :: k) x.
Rep (Chain1 t f a) x -> Chain1 t f a
$cfrom :: forall k (t :: (k -> *) -> (k -> *) -> k -> *) (f :: k -> *)
(a :: k) x.
Chain1 t f a -> Rep (Chain1 t f a) x
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 :: (a -> b -> Bool) -> Chain1 t f a -> Chain1 t f b -> Bool
liftEq eq :: a -> b -> Bool
eq = \case
Done1 x :: f a
x -> \case
Done1 y :: f b
y -> (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 _ -> Bool
False
More1 x :: t f (Chain1 t f) a
x -> \case
Done1 _ -> Bool
False
More1 y :: t f (Chain1 t f) b
y -> (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 :: (a -> b -> Ordering) -> Chain1 t f a -> Chain1 t f b -> Ordering
liftCompare c :: a -> b -> Ordering
c = \case
Done1 x :: f a
x -> \case
Done1 y :: f b
y -> (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 _ -> Ordering
LT
More1 x :: t f (Chain1 t f) a
x -> \case
Done1 _ -> Ordering
GT
More1 y :: t f (Chain1 t f) b
y -> (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 :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Chain1 t f a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d = \case
Done1 x :: 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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "Done1" Int
d f a
x
More1 xs :: 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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "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 :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Chain1 t f a)
liftReadsPrec rp :: Int -> ReadS a
rp rl :: 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 (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) "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 (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) "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 :: (a -> b) -> Chain1 t f b -> Chain1 t f a
contramap f :: a -> b
f = \case
Done1 x :: f b
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 -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
x )
More1 xs :: t f (Chain1 t f) b
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 -> b) -> t f (Chain1 t f) b -> t f (Chain1 t f) a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f t f (Chain1 t f) b
xs)
instance (Invariant f, Invariant (t f (Chain1 t f))) => Invariant (Chain1 t f) where
invmap :: (a -> b) -> (b -> a) -> Chain1 t f a -> Chain1 t f b
invmap f :: a -> b
f g :: b -> a
g = \case
Done1 x :: 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 (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g f a
x )
More1 xs :: 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 (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 :: (f ~> g) -> Chain1 t f ~> Chain1 t g
hmap f :: 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
hleft f ~> g
f)
instance HBifunctor t => Inject (Chain1 t) where
inject :: f x -> Chain1 t f x
inject = f x -> Chain1 t f x
forall k (f :: k -> *) (t :: (k -> *) -> (k -> *) -> k -> *).
f ~> Chain1 t f
injectChain1
foldChain1
:: forall t f g. HBifunctor t
=> f ~> g
-> t f g ~> g
-> Chain1 t f ~> g
foldChain1 :: (f ~> g) -> (t f g ~> g) -> Chain1 t f ~> g
foldChain1 f :: f ~> g
f g :: 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 x -> g x
go = \case
Done1 x :: f x
x -> f x -> g x
f ~> g
f f x
x
More1 xs :: 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) x -> t f g x
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 ~> g
go t f (Chain1 t f) x
xs)
unfoldChain1
:: forall t f (g :: Type -> Type). HBifunctor t
=> (g ~> f :+: t f g)
-> g ~> Chain1 t f
unfoldChain1 :: (g ~> (f :+: t f g)) -> g ~> Chain1 t f
unfoldChain1 f :: 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 x -> Chain1 t f x
go = (\case L1 x :: 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 y :: 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 x -> t f (Chain1 t f) x
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
(l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright 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 :: 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
hright 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 :: 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 :: Chain1 t f x -> (:+:) f (t f (Chain1 t f)) x
matchChain1 = \case
Done1 x :: 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 xs :: 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 :: (a -> b -> Bool) -> Chain t i f a -> Chain t i f b -> Bool
liftEq eq :: a -> b -> Bool
eq = \case
Done x :: i a
x -> \case
Done y :: i b
y -> (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 _ -> Bool
False
More x :: t f (Chain t i f) a
x -> \case
Done _ -> Bool
False
More y :: 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 (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 :: (a -> b -> Ordering) -> Chain t i f a -> Chain t i f b -> Ordering
liftCompare c :: a -> b -> Ordering
c = \case
Done x :: i a
x -> \case
Done y :: i b
y -> (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 _ -> Ordering
LT
More x :: t f (Chain t i f) a
x -> \case
Done _ -> Ordering
GT
More y :: 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 (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 :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Chain t i f a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl d :: Int
d = \case
Done x :: 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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "Done" Int
d i a
x
More xs :: 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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "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 :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Chain t i f a)
liftReadsPrec rp :: Int -> ReadS a
rp rl :: 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 (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) "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 (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) "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 :: (a -> b) -> Chain t i f b -> Chain t i f a
contramap f :: a -> b
f = \case
Done x :: i b
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 -> b) -> i b -> i a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f i b
x )
More xs :: t f (Chain t i f) b
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 -> b) -> t f (Chain t i f) b -> t f (Chain t i f) a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f t f (Chain t i f) b
xs)
instance (Invariant i, Invariant (t f (Chain t i f))) => Invariant (Chain t i f) where
invmap :: (a -> b) -> (b -> a) -> Chain t i f a -> Chain t i f b
invmap f :: a -> b
f g :: b -> a
g = \case
Done x :: 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 (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmap a -> b
f b -> a
g i a
x )
More xs :: 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 (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 :: (f ~> g) -> Chain t i f ~> Chain t i g
hmap f :: 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 ~> 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
hleft f ~> g
f)
foldChain
:: forall t i f g. HBifunctor t
=> (i ~> g)
-> (t f g ~> g)
-> Chain t i f ~> g
foldChain :: (i ~> g) -> (t f g ~> g) -> Chain t i f ~> g
foldChain f :: i ~> g
f g :: 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 x -> g x
go = \case
Done x :: i x
x -> i x -> g x
i ~> g
f i x
x
More xs :: 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) x -> t f g x
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
(l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright Chain t i f ~> g
go t f (Chain t i f) x
xs)
unfoldChain
:: forall t f (g :: Type -> Type) i. HBifunctor t
=> (g ~> i :+: t f g)
-> g ~> Chain t i f
unfoldChain :: (g ~> (i :+: t f g)) -> g ~> Chain t i f
unfoldChain f :: g ~> (i :+: t f g)
f = g x -> Chain t i f x
g ~> Chain t i f
go
where
go :: g a -> Chain t i f a
go :: g a -> Chain t i f a
go = (\case L1 x :: 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 y :: 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 ((g ~> Chain t i f) -> t f g a -> t f (Chain t i f) a
forall k (t :: (k -> *) -> (k -> *) -> k -> *) (g :: k -> *)
(l :: k -> *) (f :: k -> *).
HBifunctor t =>
(g ~> l) -> t f g ~> t f l
hright g ~> Chain t i f
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 :: 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)))
-> ((i :+: t f (Chain t i f)) ~> Chain t i f)
-> Chain t i f <~> (i :+: t f (Chain t i f))
forall k (f :: k -> *) (g :: k -> *).
(f ~> g) -> (g ~> f) -> f <~> g
isoF Chain t i f ~> (i :+: t f (Chain t i f))
forall k k (t :: k -> (k -> *) -> k -> *) (i :: k -> *) (f :: k).
Chain t i f ~> (i :+: t f (Chain t i f))
unconsChain (((i :+: t f (Chain t i f)) ~> Chain t i f)
-> 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))
-> ((i :+: t f (Chain t i f)) ~> Chain t i f)
-> 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 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 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 :: Chain t i f x -> (:+:) i (t f (Chain t i f)) x
unconsChain = \case
Done x :: 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 xs :: 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_ { DivAp1 f a -> Chain1 Day f a
unDivAp1 :: Chain1 ID.Day f a }
deriving ((a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
(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
invmap :: (a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DivAp1 f a -> DivAp1 f b
Invariant, (f ~> g) -> DivAp1 f ~> DivAp1 g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g)
-> HFunctor DivAp1
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g
hmap :: (f ~> g) -> DivAp1 f ~> DivAp1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp1 f ~> DivAp1 g
HFunctor, HFunctor DivAp1
f x -> DivAp1 f x
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
inject :: f x -> DivAp1 f x
$cinject :: forall (f :: * -> *). f ~> DivAp1 f
$cp1Inject :: HFunctor DivAp1
Inject)
newtype DivAp f a = DivAp { DivAp f a -> Chain Day Identity f a
unDivAp :: Chain ID.Day Identity f a }
deriving ((a -> b) -> (b -> a) -> DivAp f a -> DivAp f b
(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
invmap :: (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
Invariant, (f ~> g) -> DivAp f ~> DivAp g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DivAp f ~> DivAp g)
-> HFunctor DivAp
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *). (f ~> g) -> DivAp f ~> DivAp g
hmap :: (f ~> g) -> DivAp f ~> DivAp g
$chmap :: forall (f :: * -> *) (g :: * -> *). (f ~> g) -> DivAp f ~> DivAp g
HFunctor)
instance Inject DivAp where
inject :: f x -> DivAp f x
inject x :: 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 (,()))
newtype DecAlt1 f a = DecAlt1_ { DecAlt1 f a -> Chain1 Night f a
unDecAlt1 :: Chain1 IN.Night f a }
deriving ((a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
(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
invmap :: (a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DecAlt1 f a -> DecAlt1 f b
Invariant, (f ~> g) -> DecAlt1 f ~> DecAlt1 g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g)
-> HFunctor DecAlt1
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g
hmap :: (f ~> g) -> DecAlt1 f ~> DecAlt1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt1 f ~> DecAlt1 g
HFunctor, HFunctor DecAlt1
f x -> DecAlt1 f x
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
inject :: f x -> DecAlt1 f x
$cinject :: forall (f :: * -> *). f ~> DecAlt1 f
$cp1Inject :: HFunctor DecAlt1
Inject)
newtype DecAlt f a = DecAlt { DecAlt f a -> Chain Night Not f a
unDecAlt :: Chain IN.Night IN.Not f a }
deriving ((a -> b) -> (b -> a) -> DecAlt f a -> DecAlt f b
(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
invmap :: (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
Invariant, (f ~> g) -> DecAlt f ~> DecAlt g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g)
-> HFunctor DecAlt
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g
hmap :: (f ~> g) -> DecAlt f ~> DecAlt g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DecAlt f ~> DecAlt g
HFunctor)
instance Inject DecAlt where
inject :: f x -> DecAlt f x
inject x :: 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 -> Either x Void)
-> (x -> x)
-> (Void -> x)
-> Night f (Chain Night Not f) x
forall (f :: * -> *) b (g :: * -> *) c a.
f b
-> g c -> (a -> Either b c) -> (b -> a) -> (c -> a) -> Night f g a
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 -> Either x Void
forall a b. a -> Either a b
Left x -> x
forall a. a -> a
id Void -> x
forall a. Void -> a
absurd)