1{-# LANGUAGE RankNTypes, CPP #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Data.Generics.Aliases 5-- Copyright : (c) The University of Glasgow, CWI 2001--2004 6-- License : BSD-style (see the LICENSE file) 7-- 8-- Maintainer : generics@haskell.org 9-- Stability : experimental 10-- Portability : non-portable (local universal quantification) 11-- 12-- \"Scrap your boilerplate\" --- Generic programming in Haskell 13-- See <http://www.cs.uu.nl/wiki/GenericProgramming/SYB>. 14-- The present module provides a number of declarations for typical generic 15-- function types, corresponding type case, and others. 16-- 17----------------------------------------------------------------------------- 18 19module Data.Generics.Aliases ( 20 21 -- * Combinators to \"make\" generic functions via cast 22 mkT, mkQ, mkM, mkMp, mkR, 23 ext0, extT, extQ, extM, extMp, extB, extR, 24 25 -- * Type synonyms for generic function types 26 GenericT, 27 GenericQ, 28 GenericM, 29 GenericB, 30 GenericR, 31 Generic, 32 Generic'(..), 33 GenericT'(..), 34 GenericQ'(..), 35 GenericM'(..), 36 37 -- * Ingredients of generic functions 38 orElse, 39 40 -- * Function combinators on generic functions 41 recoverMp, 42 recoverQ, 43 choiceMp, 44 choiceQ, 45 46 -- * Type extension for unary type constructors 47 ext1, 48 ext1T, 49 ext1M, 50 ext1Q, 51 ext1R, 52 ext1B, 53 54 -- * Type extension for binary type constructors 55 ext2T, 56 ext2M, 57 ext2Q, 58 ext2R, 59 ext2B 60 61 ) where 62 63#ifdef __HADDOCK__ 64import Prelude 65#endif 66import Control.Monad 67import Data.Data 68 69------------------------------------------------------------------------------ 70-- 71-- Combinators to "make" generic functions 72-- We use type-safe cast in a number of ways to make generic functions. 73-- 74------------------------------------------------------------------------------ 75 76-- | Make a generic transformation; 77-- start from a type-specific case; 78-- preserve the term otherwise 79-- 80mkT :: ( Typeable a 81 , Typeable b 82 ) 83 => (b -> b) 84 -> a 85 -> a 86mkT = extT id 87 88 89-- | Make a generic query; 90-- start from a type-specific case; 91-- return a constant otherwise 92-- 93mkQ :: ( Typeable a 94 , Typeable b 95 ) 96 => r 97 -> (b -> r) 98 -> a 99 -> r 100(r `mkQ` br) a = case cast a of 101 Just b -> br b 102 Nothing -> r 103 104 105-- | Make a generic monadic transformation; 106-- start from a type-specific case; 107-- resort to return otherwise 108-- 109mkM :: ( Monad m 110 , Typeable a 111 , Typeable b 112 ) 113 => (b -> m b) 114 -> a 115 -> m a 116mkM = extM return 117 118 119{- 120 121For the remaining definitions, we stick to a more concise style, i.e., 122we fold maybes with "maybe" instead of case ... of ..., and we also 123use a point-free style whenever possible. 124 125-} 126 127 128-- | Make a generic monadic transformation for MonadPlus; 129-- use \"const mzero\" (i.e., failure) instead of return as default. 130-- 131mkMp :: ( MonadPlus m 132 , Typeable a 133 , Typeable b 134 ) 135 => (b -> m b) 136 -> a 137 -> m a 138mkMp = extM (const mzero) 139 140 141-- | Make a generic builder; 142-- start from a type-specific ase; 143-- resort to no build (i.e., mzero) otherwise 144-- 145mkR :: ( MonadPlus m 146 , Typeable a 147 , Typeable b 148 ) 149 => m b -> m a 150mkR f = mzero `extR` f 151 152 153-- | Flexible type extension 154ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a 155ext0 def ext = maybe def id (gcast ext) 156 157 158-- | Extend a generic transformation by a type-specific case 159extT :: ( Typeable a 160 , Typeable b 161 ) 162 => (a -> a) 163 -> (b -> b) 164 -> a 165 -> a 166extT def ext = unT ((T def) `ext0` (T ext)) 167 168 169-- | Extend a generic query by a type-specific case 170extQ :: ( Typeable a 171 , Typeable b 172 ) 173 => (a -> q) 174 -> (b -> q) 175 -> a 176 -> q 177extQ f g a = maybe (f a) g (cast a) 178 179 180-- | Extend a generic monadic transformation by a type-specific case 181extM :: ( Monad m 182 , Typeable a 183 , Typeable b 184 ) 185 => (a -> m a) -> (b -> m b) -> a -> m a 186extM def ext = unM ((M def) `ext0` (M ext)) 187 188 189-- | Extend a generic MonadPlus transformation by a type-specific case 190extMp :: ( MonadPlus m 191 , Typeable a 192 , Typeable b 193 ) 194 => (a -> m a) -> (b -> m b) -> a -> m a 195extMp = extM 196 197 198-- | Extend a generic builder 199extB :: ( Typeable a 200 , Typeable b 201 ) 202 => a -> b -> a 203extB a = maybe a id . cast 204 205 206-- | Extend a generic reader 207extR :: ( Monad m 208 , Typeable a 209 , Typeable b 210 ) 211 => m a -> m b -> m a 212extR def ext = unR ((R def) `ext0` (R ext)) 213 214 215 216------------------------------------------------------------------------------ 217-- 218-- Type synonyms for generic function types 219-- 220------------------------------------------------------------------------------ 221 222 223-- | Generic transformations, 224-- i.e., take an \"a\" and return an \"a\" 225-- 226type GenericT = forall a. Data a => a -> a 227 228 229-- | Generic queries of type \"r\", 230-- i.e., take any \"a\" and return an \"r\" 231-- 232type GenericQ r = forall a. Data a => a -> r 233 234 235-- | Generic monadic transformations, 236-- i.e., take an \"a\" and compute an \"a\" 237-- 238type GenericM m = forall a. Data a => a -> m a 239 240 241-- | Generic builders 242-- i.e., produce an \"a\". 243-- 244type GenericB = forall a. Data a => a 245 246 247-- | Generic readers, say monadic builders, 248-- i.e., produce an \"a\" with the help of a monad \"m\". 249-- 250type GenericR m = forall a. Data a => m a 251 252 253-- | The general scheme underlying generic functions 254-- assumed by gfoldl; there are isomorphisms such as 255-- GenericT = Generic T. 256-- 257type Generic c = forall a. Data a => a -> c a 258 259 260-- | Wrapped generic functions; 261-- recall: [Generic c] would be legal but [Generic' c] not. 262-- 263data Generic' c = Generic' { unGeneric' :: Generic c } 264 265 266-- | Other first-class polymorphic wrappers 267newtype GenericT' = GT { unGT :: forall a. Data a => a -> a } 268newtype GenericQ' r = GQ { unGQ :: GenericQ r } 269newtype GenericM' m = GM { unGM :: forall a. Data a => a -> m a } 270 271 272-- | Left-biased choice on maybes 273orElse :: Maybe a -> Maybe a -> Maybe a 274x `orElse` y = case x of 275 Just _ -> x 276 Nothing -> y 277 278 279{- 280 281The following variations take "orElse" to the function 282level. Furthermore, we generalise from "Maybe" to any 283"MonadPlus". This makes sense for monadic transformations and 284queries. We say that the resulting combinators modell choice. We also 285provide a prime example of choice, that is, recovery from failure. In 286the case of transformations, we recover via return whereas for 287queries a given constant is returned. 288 289-} 290 291-- | Choice for monadic transformations 292choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m 293choiceMp f g x = f x `mplus` g x 294 295 296-- | Choice for monadic queries 297choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r) 298choiceQ f g x = f x `mplus` g x 299 300 301-- | Recover from the failure of monadic transformation by identity 302recoverMp :: MonadPlus m => GenericM m -> GenericM m 303recoverMp f = f `choiceMp` return 304 305 306-- | Recover from the failure of monadic query by a constant 307recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r) 308recoverQ r f = f `choiceQ` const (return r) 309 310 311 312------------------------------------------------------------------------------ 313-- Type extension for unary type constructors 314------------------------------------------------------------------------------ 315 316#if __GLASGOW_HASKELL__ >= 707 317#define Typeable1 Typeable 318#define Typeable2 Typeable 319#endif 320 321-- | Flexible type extension 322ext1 :: (Data a, Typeable1 t) 323 => c a 324 -> (forall d. Data d => c (t d)) 325 -> c a 326ext1 def ext = maybe def id (dataCast1 ext) 327 328 329-- | Type extension of transformations for unary type constructors 330ext1T :: (Data d, Typeable1 t) 331 => (forall e. Data e => e -> e) 332 -> (forall f. Data f => t f -> t f) 333 -> d -> d 334ext1T def ext = unT ((T def) `ext1` (T ext)) 335 336 337-- | Type extension of monadic transformations for type constructors 338ext1M :: (Monad m, Data d, Typeable1 t) 339 => (forall e. Data e => e -> m e) 340 -> (forall f. Data f => t f -> m (t f)) 341 -> d -> m d 342ext1M def ext = unM ((M def) `ext1` (M ext)) 343 344 345-- | Type extension of queries for type constructors 346ext1Q :: (Data d, Typeable1 t) 347 => (d -> q) 348 -> (forall e. Data e => t e -> q) 349 -> d -> q 350ext1Q def ext = unQ ((Q def) `ext1` (Q ext)) 351 352 353-- | Type extension of readers for type constructors 354ext1R :: (Monad m, Data d, Typeable1 t) 355 => m d 356 -> (forall e. Data e => m (t e)) 357 -> m d 358ext1R def ext = unR ((R def) `ext1` (R ext)) 359 360 361-- | Type extension of builders for type constructors 362ext1B :: (Data a, Typeable1 t) 363 => a 364 -> (forall b. Data b => (t b)) 365 -> a 366ext1B def ext = unB ((B def) `ext1` (B ext)) 367 368------------------------------------------------------------------------------ 369-- Type extension for binary type constructors 370------------------------------------------------------------------------------ 371 372-- | Flexible type extension 373ext2 :: (Data a, Typeable2 t) 374 => c a 375 -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2)) 376 -> c a 377ext2 def ext = maybe def id (dataCast2 ext) 378 379 380-- | Type extension of transformations for unary type constructors 381ext2T :: (Data d, Typeable2 t) 382 => (forall e. Data e => e -> e) 383 -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> t d1 d2) 384 -> d -> d 385ext2T def ext = unT ((T def) `ext2` (T ext)) 386 387 388-- | Type extension of monadic transformations for type constructors 389ext2M :: (Monad m, Data d, Typeable2 t) 390 => (forall e. Data e => e -> m e) 391 -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2)) 392 -> d -> m d 393ext2M def ext = unM ((M def) `ext2` (M ext)) 394 395 396-- | Type extension of queries for type constructors 397ext2Q :: (Data d, Typeable2 t) 398 => (d -> q) 399 -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) 400 -> d -> q 401ext2Q def ext = unQ ((Q def) `ext2` (Q ext)) 402 403 404-- | Type extension of readers for type constructors 405ext2R :: (Monad m, Data d, Typeable2 t) 406 => m d 407 -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2)) 408 -> m d 409ext2R def ext = unR ((R def) `ext2` (R ext)) 410 411 412-- | Type extension of builders for type constructors 413ext2B :: (Data a, Typeable2 t) 414 => a 415 -> (forall d1 d2. (Data d1, Data d2) => (t d1 d2)) 416 -> a 417ext2B def ext = unB ((B def) `ext2` (B ext)) 418 419------------------------------------------------------------------------------ 420-- 421-- Type constructors for type-level lambdas 422-- 423------------------------------------------------------------------------------ 424 425 426-- | The type constructor for transformations 427newtype T x = T { unT :: x -> x } 428 429-- | The type constructor for transformations 430newtype M m x = M { unM :: x -> m x } 431 432-- | The type constructor for queries 433newtype Q q x = Q { unQ :: x -> q } 434 435-- | The type constructor for readers 436newtype R m x = R { unR :: m x } 437 438-- | The type constructor for builders 439newtype B x = B {unB :: x} 440