2 -----------------------------------------------------------------------------
4 -- Module : Generics.Pointless.Observe.RecursionPatterns
5 -- Copyright : (c) 2008 University of Minho
8 -- Maintainer : hpacheco@di.uminho.pt
9 -- Stability : experimental
10 -- Portability : non-portable
13 -- point-free programming with recursion patterns as hylomorphisms
15 -- This module redefines recursion patterns with support for GHood observation of intermediate data structures.
17 -----------------------------------------------------------------------------
19 module Generics.Pointless.Observe.RecursionPatterns where
21 import Generics.Pointless.Combinators
22 import Generics.Pointless.Functors
23 import Generics.Pointless.RecursionPatterns
25 import Generics.Pointless.Observe.Functors
26 import Prelude hiding (Functor (..))
29 -- * Recursion patterns with observation of intermediate data structures
31 -- | Redefinition of hylomorphisms with observation of the intermediate data type.
32 hyloO :: (Mu b, Functor (PF b), FunctorO (PF b)) => b -> (F b c -> c) -> (a -> F b a) -> a -> c
33 hyloO (b::b) g h = cata f g . observe ("Recursion Tree Functor: " ++ functorOf f) . ana f h
34 where f = _L :: Fix (PF b)
36 -- | Redefinition of catamorphisms as observable hylomorphisms.
37 cataO :: (Mu a, Functor (PF a), FunctorO (PF a)) => a -> (F a b -> b) -> a -> b
38 cataO a f = hyloO a f out
40 -- | Redefinition of anamorphisms as observable hylomorphisms.
41 anaO :: (Mu b,Functor (PF b), FunctorO (PF b)) => b -> (a -> F b a) -> a -> b
44 -- | Redefinition of paramorphisms as observable hylomorphisms.
45 paraO :: (Mu a,Functor (PF a), FunctorO (PF a), Observable a, Typeable a) => a -> (F a (b,a) -> b) -> a -> b
46 paraO (a::a) f = hyloO (_L :: Para a) f (pmap a (idA /\ idA) . out)
50 -- | Redefinition of apomorphisms as observable hylomorphisms.
51 apoO :: (Mu b,Functor (PF b), FunctorO (PF b), Observable b, Typeable b) => b -> (a -> F b (Either a b)) -> a -> b
52 apoO (b::b) f = hyloO (_L :: Apo b) (inn . pmap b (idB \/ idB)) f
56 -- | Redefinition of zygomorphisms as observable hylomorphisms.
57 zygoO :: (Mu a, Functor (PF a), FunctorO (PF a), Observable b, Typeable b, F a (a,b) ~ F (Zygo a b) a) => a -> (F a b -> b) -> (F (Zygo a b) b -> b) -> a -> b
58 zygoO a g f = aux a (_L :: b) g f
59 where aux :: (Mu a,Functor (PF a), FunctorO (PF a),Observable b, Typeable b, F a (a,b) ~ F (Zygo a b) a) => a -> b -> (F a b -> b) -> (F (Zygo a b) b -> b) -> a -> b
60 aux (a::a) (b::b) g f = hyloO (_L :: Zygo a b) f (pmap a (id /\ cata a g) . out)
62 -- | Redefinition of accumulations as observable hylomorphisms.
63 accumO :: (Mu a,Functor (PF d), FunctorO (PF d), Observable b, Typeable b) => d -> ((F a a,b) -> F d (a,b)) -> (F (Accum d b) c -> c) -> (a,b) -> c
64 accumO (d::d) g f = hyloO (_L :: Accum d b) f ((g /\ snd) . (out >< id))
66 -- | Redefinition of histomorphisms as observable hylomorphisms.
67 histoO :: (Mu a,Functor (PF a), FunctorO (PF a), Observable a) => a -> (F a (Histo a c) -> c) -> a -> c
68 histoO (a::a) g = fst . outH . cataO a (inn . (g /\ id))
69 where outH :: Histo a c -> F (Histo a c) (Histo a c)
72 -- | Redefinition of futumorphisms as observable hylomorphisms.
73 futuO :: (Mu b,Functor (PF b), FunctorO (PF b), Observable b) => b -> (a -> F b (Futu b a)) -> a -> b
74 futuO (b::b) g = anaO b ((g \/ id) . out) . innF . inl
75 where innF :: F (Futu b a) (Futu b a) -> Futu b a
78 -- | Redefinition of dynamorphisms as observable hylomorphisms.
79 dynaO :: (Mu b, Functor (PF b), FunctorO (PF b), Observable b) => b -> (F b (Histo b c) -> c) -> (a -> F b a) -> a -> c
80 dynaO (b::b) g h = fst . outH . hyloO b (inn . (g /\ id)) h
81 where outH :: Histo b c -> F (Histo b c) (Histo b c)
84 -- | Redefinition of chronomorphisms as observable hylomorphisms.
85 chronoO :: (Mu c,Functor (PF c), FunctorO (PF c)) => c -> (F c (Histo c b) -> b) -> (a -> F c (Futu c a)) -> a -> b
86 chronoO (c::c) g h = fst . outH . hyloO c (inn . (g /\ id)) ((h \/ id) . out) . innF . inl
87 where outH :: Histo c b -> F (Histo c b) (Histo c b)
89 innF :: F (Futu c a) (Futu c a) -> (Futu c a)