2 -----------------------------------------------------------------------------
4 -- Module : Generics.Pointless.Combinators
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 defines many standard combinators used for point-free programming.
17 -----------------------------------------------------------------------------
19 module Generics.Pointless.Combinators where
23 -- | The bottom value for any type.
24 -- It is many times used just for type annotations.
28 -- | The final object.
29 -- The only possible value of type 'One' is '_L'.
32 instance Show One where
40 -- | Creates a point to the terminal object.
44 -- | Converts elements into points.
51 -- | The infix split combinator.
52 (/\) :: (a -> b) -> (a -> c) -> a -> (b,c)
53 (/\) f g x = (f x, g x)
56 -- The infix product combinator.
57 (><) :: (a -> b) -> (c -> d) -> (a,c) -> (b,d)
58 f >< g = f . fst /\ g . snd
62 -- | Injects a value to the left of a sum.
63 inl :: a -> Either a b
66 -- | Injects a value to the right of a sum.
67 inr :: b -> Either a b
71 -- | The infix either combinator.
72 (\/) :: (b -> a) -> (c -> a) -> Either b c -> a
76 -- | The infix sum combinator.
77 (-|-) :: (a -> b) -> (c -> d) -> Either a c -> Either b d
78 f -|- g = inl . f \/ inr . g
81 -- | Alias for the infix sum combinator.
82 (<>) :: (a -> b) -> (c -> d) -> Either a c -> Either b d
87 -- | The application combinator.
88 app :: (a -> b, a) -> b
92 -- | The infix combinator for a constant point.
98 -- | Guard combinator that operates on Haskell booleans.
99 grd :: (a -> Bool) -> a -> Either a a
100 grd p x = if p x then inl x else inr x
102 -- | Infix guarc combinator that simulates the postfix syntax.
103 (?) :: (a -> Bool) -> a -> Either a a
106 -- * Point-free definitions of uncurried versions of the basic combinators
108 -- | The uncurried split combinator.
109 split :: (a -> b, a -> c) -> (a -> (b,c))
110 split = curry ((app >< app) . ((fst >< id) /\ (snd >< id)))
112 -- | The uncurried either combinator.
113 eithr :: (a -> c, b -> c) -> Either a b -> c
114 eithr = curry ((app \/ app) . (fst >< id -|- snd >< id) . distr)
116 -- | The uncurried composition combinator.
117 comp :: (b -> c, a -> b) -> (a -> c)
118 comp = curry (app . (id >< app) . assocr)
120 -- * Point-free isomorphic combinators
122 -- | Swap the elements of a product.
123 swap :: (a,b) -> (b,a)
126 -- | Swap the elements of a sum.
127 coswap :: Either a b -> Either b a
130 -- | Distribute products over the left of sums.
131 distl :: (Either a b, c) -> Either (a,c) (b,c)
132 distl = app . ((curry inl \/ curry inr) >< id)
134 -- | Distribute sums over the left of products.
135 undistl :: Either (a,c) (b,c) -> (Either a b, c)
136 undistl = inl >< id \/ inr >< id
138 -- | Distribute products over the right of sums.
139 distr :: (c, Either a b) -> Either (c,a) (c,b)
140 distr = (swap -|- swap) . distl . swap
142 -- | Distribute sums over the right of products.
143 undistr :: Either (c,a) (c,b) -> (c, Either a b)
144 undistr = (id >< inl) \/ (id >< inr)
146 -- | Associate nested products to the left.
147 assocl :: (a,(b,c)) -> ((a,b),c)
148 assocl = id >< fst /\ snd . snd
150 -- | Associates nested products to the right.
151 assocr :: ((a,b),c) -> (a,(b,c))
152 assocr = fst . fst /\ snd >< id
154 -- | Associates nested sums to the left.
155 coassocl :: Either a (Either b c) -> Either (Either a b) c
156 coassocl = (inl . inl) \/ (inr -|- id)
158 -- | Associates nested sums to the right.
159 coassocr :: Either (Either a b) c -> Either a (Either b c)
160 coassocr = (id -|- inl) \/ (inr . inr)