module A where
class IIFunctor f where
fmapII :: (a -> b) -> (c -> d) -> f a c -> f b d
fmapLI :: (a -> b) -> f a c -> f b c
fmapIR :: (b -> c) -> f a b -> f a c
fmapII f g = fmapLI f . fmapIR g
fmapLI f = fmapII f id
fmapIR g = fmapII id g
data Id a = Id a
fromId :: (a -> b) -> Id a -> b
fromId f (Id x) = f x
toId :: (b -> a) -> b -> Id a
toId f x = Id (f x)
instance Functor Id where
fmap f (Id x) = Id (f x)
fromU :: t -> (a -> t) -> I a -> t
fromB :: t -> (a -> b -> t) -> II a b -> t
fromT :: t -> (a -> b -> b -> t) -> IIV a b -> t
fromP :: t -> (a -> [b] -> t) -> Power a b -> t
toU :: (t -> Bool) -> (t -> a) -> t -> I a
toB :: (t -> Bool) -> (t -> a) -> (t -> b) -> t -> II a b
toT :: (t -> Bool) -> (t -> a) -> (t -> b) -> (t -> b) -> t -> IIV a b
toP :: (t -> Bool) -> (t -> a) -> (t -> [b]) -> t -> Power a b
toP' :: (t -> Bool) -> (t -> (a,[b])) -> t -> Power a b
toB' :: (t -> Bool) -> (t -> (a, b )) -> t -> II a b
fromU u f U_I_U = u
fromU u f (I x) = f x
fromB u f UII_U = u
fromB u f (II x y) = f x y
fromT u f UIIVU = u
fromT u f (IIV x y z) = f x y z
fromP u f UnitP = u
fromP u f (Many x ys) = f x ys
toU p f x = if p x then U_I_U else I (f x)
toB p f g x = if p x then UII_U else II (f x) (g x)
toT p f g h x = if p x then UIIVU else IIV (f x) (g x) (h x)
toP p f g x = if p x then UnitP else Many (f x) (g x)
toP' p f x = if p x then UnitP else Many y zs where (y,zs) = f x
toB' p f x = if p x then UII_U else II y z where (y, z) = f x
data I a = U_I_U | I a
data II a b = UII_U | II a b
data IIV a b = UIIVU | IIV a b b
data Power a b = UnitP | Many a [b]
instance Functor I where fmap f U_I_U = U_I_U
fmap f (I x) = I (f x)
instance Functor ( II a) where fmap f UII_U = UII_U
fmap f (II x y) = II x (f y)
instance Functor ( IIV a) where fmap f UIIVU = UIIVU
fmap f (IIV x y z) = IIV x (f y) (f z)
instance IIFunctor II where fmapII f g UII_U = UII_U
fmapII f g (II x y) = II (f x) (g y)
instance IIFunctor IIV where fmapII f g UIIVU = UIIVU
fmapII f g (IIV x y z) = IIV (f x) (g y) (g y)
instance IIFunctor Power where fmapII f g UnitP = UnitP
fmapII f g (Many x ys) = Many (f x) (fmap g ys)
instance Functor (Power a) where fmap f UnitP = UnitP
fmap f (Many x ys) = Many x (fmap f ys)
ntBU :: (a -> b -> c) -> II a b -> I c
ntTB :: (a -> c) -> (b -> b -> d) -> IIV a b -> II c d
ntPB :: (a -> c) -> ([b] -> d) -> Power a b -> II c d
ntBU f UII_U = U_I_U
ntBU f (II x y ) = I (f x y)
ntTB f g UIIVU = UII_U
ntTB f g (IIV x y z) = II (f x) (g y z)
ntPB f g UnitP = UII_U
ntPB f g (Many x ys ) = II (f x) (g ys)
data A s g t = A (s -> t) (t -> g t)
con (A c _) = c
des (A _ d) = d
type BinA a t = SymA (II a) t
type PowA a t = SymA (Power a) t
type SymA g t = A ( g t) g t
type JoinA a g = A (II [a] (g a) )
(II a ) (g a)
joinView :: (Functor g) => A (II a t) g t -> A (II [ a] t) g t
maybeView :: (Functor g) => A (II a t) g t -> A (II (Maybe a) t) g t
joinView (A c d) = A c' d where c' UII_U = c UII_U
c' (II xs y) = foldr c'' y xs
where c'' x ys = c (II x ys)
maybeView (A c d) = A c' d where c' UII_U = c UII_U
c' (II Nothing y) = y
c' (II (Just x) y) = c (II x y)
fold :: (Functor g) => (g u -> u) -> A s g t -> (t -> u)
unfold :: (Functor f, Functor g) => ( t -> f t) -> A (f u) g u -> (t -> u)
trans :: (Functor g, Functor h) => (g u -> r) -> A s g t -> A r h u -> (t -> u)
transit :: (Functor g, Functor h) => A s g t -> A (g u) h u -> (t -> u)
via :: (Functor g, Functor h, Functor i) => A s g t -> A (g u) h u -> A (h v) i v -> (t -> v)
fold f a = f . fmap (fold f a ) . des a
unfold f a = con a . fmap (unfold f a ) . f
trans f a b = con b . f . fmap (trans f a b) . des a
transit = trans id
via a b c = transit b c . transit a b
hylo :: (Functor f) => (f b -> b) -> (a -> f a) -> (a -> b)
hylot :: (Functor f) => (f b -> g b) -> (g b -> b) -> (a -> f a) -> (a -> b)
hhh :: (Functor f) => (f b -> i b) -> (i b -> g b) -> (g b -> b) -> (a -> f a) -> (a -> b)
h :: (Functor f) => (f b -> i b) -> (i b -> j b) -> (j b -> k b) -> (k b -> b) -> (a -> f a) -> (a -> b)
hylo c d = c . fmap (hylo c d) . d
hylot f c d = c . f . fmap (hylot f c d) . d
hhh g f c d = c . f . g . fmap (hhh g f c d) . d
h i g f c d = c . f . g . i . fmap (h i g f c d) . d
stream :: (Functor g) => [SymA g t] -> t -> t
stream [a,b] = transit a b
stream (a:b:as) = stream (b:as) . (transit a b)