module Data.HFunctor.Chain.Internal (
Chain1(..)
, foldChain1, unfoldChain1
, toChain1, injectChain1
, matchChain1
, Chain(..)
, foldChain, unfoldChain
, splittingChain, unconsChain
, DayChain1(..)
, DayChain(..)
, NightChain(..)
, NightChain1(..)
) 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 DayChain1 f a = DayChain1_ { DayChain1 f a -> Chain1 Day f a
unDayChain1 :: Chain1 ID.Day f a }
deriving ((a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b
(forall a b.
(a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b)
-> Invariant (DayChain1 f)
forall a b. (a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
invmap :: (a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> DayChain1 f a -> DayChain1 f b
Invariant, (f ~> g) -> DayChain1 f ~> DayChain1 g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain1 f ~> DayChain1 g)
-> HFunctor DayChain1
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain1 f ~> DayChain1 g
hmap :: (f ~> g) -> DayChain1 f ~> DayChain1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain1 f ~> DayChain1 g
HFunctor, HFunctor DayChain1
f x -> DayChain1 f x
HFunctor DayChain1 =>
(forall (f :: * -> *). f ~> DayChain1 f) -> Inject DayChain1
forall k (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> DayChain1 f
inject :: f x -> DayChain1 f x
$cinject :: forall (f :: * -> *). f ~> DayChain1 f
$cp1Inject :: HFunctor DayChain1
Inject)
newtype DayChain f a = DayChain { DayChain f a -> Chain Day Identity f a
unDayChain :: Chain ID.Day Identity f a }
deriving ((a -> b) -> (b -> a) -> DayChain f a -> DayChain f b
(forall a b. (a -> b) -> (b -> a) -> DayChain f a -> DayChain f b)
-> Invariant (DayChain f)
forall a b. (a -> b) -> (b -> a) -> DayChain f a -> DayChain 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) -> DayChain f a -> DayChain f b
invmap :: (a -> b) -> (b -> a) -> DayChain f a -> DayChain f b
$cinvmap :: forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> DayChain f a -> DayChain f b
Invariant, (f ~> g) -> DayChain f ~> DayChain g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain f ~> DayChain g)
-> HFunctor DayChain
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain f ~> DayChain g
hmap :: (f ~> g) -> DayChain f ~> DayChain g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> DayChain f ~> DayChain g
HFunctor)
instance Inject DayChain where
inject :: f x -> DayChain f x
inject x :: f x
x = Chain Day Identity f x -> DayChain f x
forall (f :: * -> *) a. Chain Day Identity f a -> DayChain f a
DayChain (Chain Day Identity f x -> DayChain f x)
-> Chain Day Identity f x -> DayChain 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 NightChain1 f a = NightChain1_ { NightChain1 f a -> Chain1 Night f a
unNightChain1 :: Chain1 IN.Night f a }
deriving ((a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b
(forall a b.
(a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b)
-> Invariant (NightChain1 f)
forall a b.
(a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b
forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> (b -> a) -> f a -> f b) -> Invariant f
invmap :: (a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b
$cinvmap :: forall (f :: * -> *) a b.
Invariant f =>
(a -> b) -> (b -> a) -> NightChain1 f a -> NightChain1 f b
Invariant, (f ~> g) -> NightChain1 f ~> NightChain1 g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain1 f ~> NightChain1 g)
-> HFunctor NightChain1
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain1 f ~> NightChain1 g
hmap :: (f ~> g) -> NightChain1 f ~> NightChain1 g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain1 f ~> NightChain1 g
HFunctor, HFunctor NightChain1
f x -> NightChain1 f x
HFunctor NightChain1 =>
(forall (f :: * -> *). f ~> NightChain1 f) -> Inject NightChain1
forall k (t :: (k -> *) -> k -> *).
HFunctor t =>
(forall (f :: k -> *). f ~> t f) -> Inject t
forall (f :: * -> *). f ~> NightChain1 f
inject :: f x -> NightChain1 f x
$cinject :: forall (f :: * -> *). f ~> NightChain1 f
$cp1Inject :: HFunctor NightChain1
Inject)
newtype NightChain f a = NightChain { NightChain f a -> Chain Night Not f a
unNightChain :: Chain IN.Night IN.Not f a }
deriving ((a -> b) -> (b -> a) -> NightChain f a -> NightChain f b
(forall a b.
(a -> b) -> (b -> a) -> NightChain f a -> NightChain f b)
-> Invariant (NightChain f)
forall a b.
(a -> b) -> (b -> a) -> NightChain f a -> NightChain 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) -> NightChain f a -> NightChain f b
invmap :: (a -> b) -> (b -> a) -> NightChain f a -> NightChain f b
$cinvmap :: forall (f :: * -> *) a b.
(a -> b) -> (b -> a) -> NightChain f a -> NightChain f b
Invariant, (f ~> g) -> NightChain f ~> NightChain g
(forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain f ~> NightChain g)
-> HFunctor NightChain
forall k k (t :: (k -> *) -> k -> *).
(forall (f :: k -> *) (g :: k -> *). (f ~> g) -> t f ~> t g)
-> HFunctor t
forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain f ~> NightChain g
hmap :: (f ~> g) -> NightChain f ~> NightChain g
$chmap :: forall (f :: * -> *) (g :: * -> *).
(f ~> g) -> NightChain f ~> NightChain g
HFunctor)
instance Inject NightChain where
inject :: f x -> NightChain f x
inject x :: f x
x = Chain Night Not f x -> NightChain f x
forall (f :: * -> *) a. Chain Night Not f a -> NightChain f a
NightChain (Chain Night Not f x -> NightChain f x)
-> Chain Night Not f x -> NightChain 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)