2 -----------------------------------------------------------------------------
4 -- Module : Generics.Pointless.Examples.Observe
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 provides the same examples, but with support for GHood observations.
17 -----------------------------------------------------------------------------
19 module Generics.Pointless.Examples.Observe where
21 import Generics.Pointless.Combinators
22 import Generics.Pointless.Functors
23 import Generics.Pointless.RecursionPatterns
24 import Generics.Pointless.Observe.RecursionPatterns
25 import Generics.Pointless.Observe.Functors
26 import Generics.Pointless.Examples.Examples
30 -- | Definition of the observable length function as an hylomorphism.
31 lengthHyloO :: Observable a => [a] -> Int
32 lengthHyloO = hyloO (_L::Int) f g
34 g = (id -|- snd) . out
36 -- | Definition of the observable length function as an anamorphism.
37 lengthAnaO :: Observable a => [a] -> Int
38 lengthAnaO = anaO (_L::Int) f
39 where f = (id -|- snd) . out
41 -- | Definition of the observable length function as a catamorphism.
42 lengthCataO :: (Typeable a, Observable a) => [a] -> Int
43 lengthCataO = cataO (_L :: [a]) g
44 where g = inn . (id -|- snd)
46 -- | Definition of the observable factorial function as an hylomorphism.
47 factHyloO :: Int -> Int
48 factHyloO = hyloO (_L::[Int]) f g
49 where g = (id -|- succ /\ id) . out
52 -- | Definition of the observable factorial function as a paramorphism.
53 factParaO :: Int -> Int
54 factParaO = paraO (_L::Int) f
55 where f = one \/ prod . (id >< succ)
57 -- | Definition of the observable factorial function as a zygomorphism.
58 factZygoO :: Int -> Int
59 factZygoO = zygoO (_L::Int) inn f
60 where f = one \/ (prod . (id >< succ))
62 -- | Definition of the observable fibonacci function as an hylomorphism.
63 fibHyloO :: Int -> Int
64 fibHyloO = hyloO (_L::LTree One) f g
65 where g = (bang -|- pred /\ pred . pred) . ((<=1)?)
68 -- | Definition of the observable fibonacci function as an histomorphism.
69 fibHistoO :: Int -> Int
70 fibHistoO = histoO (_L::Int) f
71 where f = (zero \/ (one . snd \/ add . (id >< outl)) . distr . out)
73 -- | Definition of the observable fibonacci function as a dynamorphism.
74 fibDynaO :: Int -> Int
75 fibDynaO = dynaO (_L::Int) f g
76 where f = (zero \/ (one . snd \/ add . (id >< outl)) . distr . out)
79 -- | Definition of the observable quicksort function as an hylomorphism.
80 qsortHyloO :: (Typeable a, Observable a, Ord a) => [a] -> [a]
81 qsortHyloO = hyloO (_L::Tree a) f g
82 where g = (id -|- fst /\ partition) . out
83 f = nil \/ cat . (id >< cons) . assocr . (swap >< id) . assocl
85 -- | Definition of the observable tail function as a paramorphism.
86 tailParaO :: (Typeable a, Observable a) => [a] -> [a]
87 tailParaO = paraO (_L::[a]) (nil \/ snd . snd)
89 -- | Definition of the observable add function as an accumulation.
90 addAccumO :: (Int,Int) -> Int
91 addAccumO = accumO (_L::Int) t f
92 where t = (fst -|- id >< succ) . distl
93 f = (snd \/ fst) . distl