Data/Generics/Basics.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Basics
   4 -- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
  12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module provides
  13 -- the Data class with its primitives for generic programming.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Data.Generics.Basics (
  18
  19         -- Module Data.Typeable re-exported for convenience
  20         module Data.Typeable,
  21
  22         -- * The Data class for processing constructor applications
  23         Data(
  24                 gfoldl,         -- :: ... -> a -> c a
  25                 toConstr,       -- :: a -> Constr
  26                 fromConstr,     -- :: Constr -> a
  27                 dataTypeOf,     -- :: a -> DataType
  28                 cast0to1,       -- mediate types and unary type constructors
  29                 cast0to2        -- mediate types and binary type constructors
  30             ),
  31
  32         -- * Datatype representations
  33         DataType,       -- abstract, instance of: Show
  34         Constr,         -- abstract, instance of: Eq, Show
  35         DataRep(..),    -- instance of: Eq, Show
  36         ConRep(..),     -- instance of: Eq, Show
  37         ConIndex,       -- alias for Int, start at 1
  38         Fixity(..),     -- instance of: Eq, Show
  39
  40         -- * Observers for datatype representations
  41         dataTypeCon,    -- :: DataType -> String
  42         dataTypeRep,    -- :: DataType -> DataRep
  43         conDataType,    -- :: Constr -> DataType
  44         conRep,         -- :: Constr -> ConRep
  45         repCon,         -- :: DataType -> ConRep -> Constr
  46
  47         -- * Representations of algebraic data types
  48         mkDataType,     -- :: String -> [Constr] -> DataType
  49         mkDataCon,      -- :: DataType -> String -> Fixity -> Constr
  50         algTypeCons,    -- :: DataType -> [Constr]
  51         conFixity,      -- :: Constr -> Fixity
  52
  53         -- * From strings to constr's and vice versa: all data types
  54         conString,      -- :: Constr -> String
  55         stringCon,      -- :: DataType -> String -> Maybe Constr
  56
  57         -- * Convenience funtions: algebraic data types
  58         isAlgType,      -- :: DataType -> Bool
  59         indexCon,       -- :: DataType -> ConIndex -> Constr
  60         conIndex,       -- :: Constr -> ConIndex
  61         maxConIndex,    -- :: DataType -> ConIndex
  62
  63         -- * Representation of primitive types
  64         mkIntType,      -- :: String -> DataType
  65         mkFloatType,    -- :: String -> DataType
  66         mkStringType,   -- :: String -> DataType
  67         mkIntCon,       -- :: DataType -> Integer -> Constr
  68         mkFloatCon,     -- :: DataType -> Double  -> Constr
  69         mkStringCon,    -- :: DataType -> String  -> Constr
  70
  71         -- * Non-representations for non-presentable types
  72         mkNorepType,    -- :: String -> DataType
  73         isNorepType,    -- :: DataType -> Bool
  74
  75         -- * Convenience functions: take type constructors apart
  76         tyconUQname,    -- :: String -> String
  77         tyconModule,    -- :: String -> String
  78
  79         -- * Generic maps defined in terms of gfoldl
  80         gmapT,
  81         gmapQ,
  82         gmapQl,
  83         gmapQr,
  84         gmapQi,
  85         gmapM,
  86         gmapMp,
  87         gmapMo,
  88
  89   ) where
  90
  91
  92 ------------------------------------------------------------------------------
  93
  94 #ifdef __HADDOCK__
  95 import Prelude
  96 #endif
  97
  98 import Data.Typeable
  99 import Data.Maybe
 100 import Control.Monad
 101
 102
 103
 104 ------------------------------------------------------------------------------
 105 --
 106 --      The Data class
 107 --
 108 ------------------------------------------------------------------------------
 109
 110 {-
 111
 112 The Data class comprehends a fundamental primitive "gfoldl" for
 113 folding over constructor applications, say terms. This primitive can
 114 be instantiated in several ways to map over the immediate subterms of
 115 a term; see the "gmap" combinators later in this module. Indeed, a
 116 generic programmer does not necessarily need to use the ingenious
 117 gfoldl primitive but rather the intuitive "gmap" combinators. The
 118 "gfoldl" primitive is completed by means to query top-level
 119 constructors, to turn constructor representations into proper terms,
 120 and to list all possible datatype constructors. This completion
 121 allows us to serve generic programming scenarios like read, show,
 122 equality, term generation.
 123
 124 -}
 125
 126 class Typeable a => Data a where
 127
 128 {-
 129
 130 Folding constructor applications ("gfoldl")
 131
 132 The combinator takes two arguments "f" and "z" to fold over a term
 133 "x".  The result type is defined in terms of "x" but variability is
 134 achieved by means of type constructor "c" for the construction of the
 135 actual result type. The purpose of the argument "z" is to define how
 136 the empty constructor application is folded. So "z" is like the
 137 neutral / start element for list folding. The purpose of the argument
 138 "f" is to define how the nonempty constructor application is
 139 folded. That is, "f" takes the folded "tail" of the constructor
 140 application and its head, i.e., an immediate subterm, and combines
 141 them in some way. See the Data instances in this file for an
 142 illustration of "gfoldl". Conclusion: the type of gfoldl is a
 143 headache, but operationally it is simple generalisation of a list
 144 fold.
 145
 146 -}
 147
 148   -- | Left-associative fold operation for constructor applications
 149   gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
 150           -> (forall g. g -> c g)
 151           -> a -> c a
 152
 153   -- Default definition for gfoldl
 154   -- which copes immediately with basic datatypes
 155   --
 156   gfoldl _ z = z
 157
 158   -- | Obtaining the constructor from a given datum.
 159   -- For proper terms, this is meant to be the top-level constructor.
 160   -- Primitive datatypes are here viewed as potentially infinite sets of
 161   -- values (i.e., constructors).
 162   --
 163   toConstr   :: a -> Constr
 164
 165
 166   -- | Building a term from a constructor
 167   fromConstr   :: Constr -> a
 168
 169
 170   -- | Provide access to list of all constructors
 171   dataTypeOf  :: a -> DataType
 172
 173
 174
 175 ------------------------------------------------------------------------------
 176 --
 177 -- Mediate types and type constructors
 178 --
 179 ------------------------------------------------------------------------------
 180
 181   -- | Mediate types and unary type constructors
 182   cast0to1 :: Typeable1 t
 183            => (forall a. Data a => c (t a))
 184            -> Maybe (c a)
 185   cast0to1 _ = Nothing
 186
 187   -- | Mediate types and binary type constructors
 188   cast0to2 :: Typeable2 t
 189            => (forall a b. (Data a, Data b) => c (t a b))
 190            -> Maybe (c a)
 191   cast0to2 _ = Nothing
 192
 193
 194
 195 ------------------------------------------------------------------------------
 196 --
 197 --      Typical generic maps defined in terms of gfoldl
 198 --
 199 ------------------------------------------------------------------------------
 200
 201 {-
 202
 203 The combinators gmapT, gmapQ, gmapM, ... can all be defined in terms
 204 of gfoldl. We provide corresponding default definitions leaving open
 205 the opportunity to provide datatype-specific definitions.
 206
 207 (The inclusion of the gmap combinators as members of class Data allows
 208 the programmer or the compiler to derive specialised, and maybe more
 209 efficient code per datatype. Note: gfoldl is more higher-order than
 210 the gmap combinators. This is subject to ongoing benchmarking
 211 experiments. It might turn out that the gmap combinators will be moved
 212 out of the class Data.)
 213
 214 Conceptually, the definition of the gmap combinators in terms of the
 215 primitive gfoldl requires the identification of the gfoldl function
 216 arguments. Technically, we also need to identify the type constructor
 217 "c" for the construction of the result type from the folded term type.
 218
 219 -}
 220
 221
 222   -- | A generic transformation that maps over the immediate subterms
 223   gmapT :: (forall b. Data b => b -> b) -> a -> a
 224
 225   -- Use an identity datatype constructor ID (see below)
 226   -- to instantiate the type constructor c in the type of gfoldl,
 227   -- and perform injections ID and projections unID accordingly.
 228   --
 229   gmapT f x = unID (gfoldl k ID x)
 230     where
 231       k (ID c) x = ID (c (f x))
 232
 233
 234   -- | A generic query with a left-associative binary operator
 235   gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 236   gmapQl o r f = unCONST . gfoldl k z
 237     where
 238       k c x = CONST $ (unCONST c) `o` f x
 239       z _   = CONST r
 240
 241 {-
 242
 243 In the definition of gmapQ? combinators, we use phantom type
 244 constructors for the "c" in the type of "gfoldl" because the result
 245 type of a query does not involve the (polymorphic) type of the term
 246 argument. In the definition of gmapQl we simply use the plain constant
 247 type constructor because gfoldl is left-associative anyway and so it
 248 is readily suited to fold a left-associative binary operation over the
 249 immediate subterms. In the definition of gmapQr, extra effort is
 250 needed. We use a higher-order accumulation trick to mediate between
 251 left-associative constructor application vs. right-associative binary
 252 operation (e.g., (:)). When the query is meant to compute a value of
 253 type r, then the result type withing generic folding is r -> r. So the
 254 result of folding is a function to which we finally pass the right
 255 unit.
 256
 257 -}
 258
 259   -- | A generic query with a right-associative binary operator
 260   gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
 261   gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r
 262     where
 263       k (Qr c) x = Qr (\r -> c (f x `o` r))
 264
 265
 266   -- | A generic query that processes the immediate subterms and returns a list
 267   gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
 268   gmapQ f = gmapQr (:) [] f
 269
 270
 271   -- | A generic query that processes one child by index (zero-based)
 272   gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
 273   gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
 274     where
 275       k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
 276       z f           = Qi 0 Nothing
 277
 278
 279   -- | A generic monadic transformation that maps over the immediate subterms
 280   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 281
 282   -- Use immediately the monad datatype constructor
 283   -- to instantiate the type constructor c in the type of gfoldl,
 284   -- so injection and projection is done by return and >>=.
 285   --
 286   gmapM f = gfoldl k return
 287     where
 288       k c x = do c' <- c
 289                  x' <- f x
 290                  return (c' x')
 291
 292
 293   -- | Transformation of at least one immediate subterm does not fail
 294   gmapMp :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 295
 296 {-
 297
 298 The type constructor that we use here simply keeps track of the fact
 299 if we already succeeded for an immediate subterm; see Mp below. To
 300 this end, we couple the monadic computation with a Boolean.
 301
 302 -}
 303
 304   gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
 305                 if b then return x' else mzero
 306     where
 307       z g = Mp (return (g,False))
 308       k (Mp c) x
 309         = Mp ( c >>= \(h,b) ->
 310                  (f x >>= \x' -> return (h x',True))
 311                  `mplus` return (h x,b)
 312              )
 313
 314   -- | Transformation of one immediate subterm with success
 315   gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 316
 317 {-
 318
 319 We use the same pairing trick as for gmapMp,
 320 i.e., we use an extra Bool component to keep track of the
 321 fact whether an immediate subterm was processed successfully.
 322 However, we cut of mapping over subterms once a first subterm
 323 was transformed successfully.
 324
 325 -}
 326
 327   gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
 328                 if b then return x' else mzero
 329     where
 330       z g = Mp (return (g,False))
 331       k (Mp c) x
 332         = Mp ( c >>= \(h,b) -> if b
 333                         then return (h x,b)
 334                         else (f x >>= \x' -> return (h x',True))
 335                              `mplus` return (h x,b)
 336              )
 337
 338
 339 -- | The identity type constructor needed for the definition of gmapT
 340 newtype ID x = ID { unID :: x }
 341
 342
 343 -- | The constant type constructor needed for the definition of gmapQl
 344 newtype CONST c a = CONST { unCONST :: c }
 345
 346
 347 -- | Type constructor for adding counters to queries
 348 data Qi q a = Qi Int (Maybe q)
 349
 350
 351 -- | The type constructor used in definition of gmapQr
 352 newtype Qr r a = Qr { unQr  :: r -> r }
 353
 354
 355 -- | The type constructor used in definition of gmapMp
 356 newtype Mp m x = Mp { unMp :: m (x, Bool) }
 357
 358
 359
 360 ------------------------------------------------------------------------------
 361 --
 362 --      Datatype and constructor representations
 363 --
 364 ------------------------------------------------------------------------------
 365
 366
 367 --
 368 -- | Representation of datatypes.
 369 -- | A package of constructor representations with names of type and module.
 370 -- | The list of constructors could be an array, a balanced tree, or others.
 371 --
 372 data DataType = DataType
 373                         { tycon   :: String
 374                         , datarep :: DataRep
 375                         }
 376
 377               deriving Show
 378
 379
 380 -- | Representation of constructors
 381 data Constr = Constr
 382                         { conrep    :: ConRep
 383                         , constring :: String
 384                         , confixity :: Fixity   -- for AlgRep only
 385                         , datatype  :: DataType
 386                         }
 387
 388 instance Show Constr where
 389  show = constring
 390
 391
 392 -- | Equality of constructors
 393 instance Eq Constr where
 394   c == c' = conRep c == conRep c'
 395
 396
 397 -- | Public representation of datatypes
 398 data DataRep = AlgRep [Constr]
 399              | IntRep
 400              | FloatRep
 401              | StringRep
 402              | NoRep
 403
 404             deriving (Eq,Show)
 405
 406
 407 -- | Public representation of constructors
 408 data ConRep = AlgCon ConIndex
 409             | IntCon Integer
 410             | FloatCon Double
 411             | StringCon String
 412
 413             deriving (Eq,Show)
 414
 415
 416 --
 417 -- | Unique index for datatype constructors.
 418 -- | Textual order is respected. Starts at 1.
 419 --
 420 type ConIndex = Int
 421
 422
 423 -- | Fixity of constructors
 424 data Fixity = Prefix
 425             | Infix     -- Later: add associativity and precedence
 426
 427             deriving (Eq,Show)
 428
 429
 430 ------------------------------------------------------------------------------
 431 --
 432 --      Observers for datatype representations
 433 --
 434 ------------------------------------------------------------------------------
 435
 436
 437 -- | Gets the type constructor including the module
 438 dataTypeCon :: DataType -> String
 439 dataTypeCon = tycon
 440
 441
 442
 443 -- | Gets the public presentation of datatypes
 444 dataTypeRep :: DataType -> DataRep
 445 dataTypeRep = datarep
 446
 447
 448 -- | Gets the datatype of a constructor
 449 conDataType :: Constr -> DataType
 450 conDataType = datatype
 451
 452
 453 -- | Gets the public presentation of constructors
 454 conRep :: Constr -> ConRep
 455 conRep = conrep
 456
 457
 458 -- | Look up a constructor by its representation
 459 repCon :: DataType -> ConRep -> Constr
 460 repCon dt cr =
 461       case (dataTypeRep dt, cr) of
 462         (AlgRep cs, AlgCon i)      -> cs !! (i-1)
 463         (IntRep,    IntCon i)      -> mkIntCon dt i
 464         (FloatRep,  FloatCon f)    -> mkFloatCon dt f
 465         (StringRep, StringCon str) -> mkStringCon dt str
 466         _ -> error "repCon"
 467
 468
 469
 470 ------------------------------------------------------------------------------
 471 --
 472 --      Representations of algebraic data types
 473 --
 474 ------------------------------------------------------------------------------
 475
 476
 477 -- | Constructs an algebraic datatype
 478 mkDataType :: String -> [Constr] -> DataType
 479 mkDataType str cs = DataType
 480                         { tycon   = str
 481                         , datarep = AlgRep cs
 482                         }
 483
 484
 485 -- | Constructs a constructor
 486 mkDataCon :: DataType -> String -> Fixity -> Constr
 487 mkDataCon dt str fix =
 488         Constr
 489                 { conrep    = AlgCon idx
 490                 , constring = str
 491                 , confixity = fix
 492                 , datatype  = dt
 493                 }
 494   where
 495     idx = head [ i | (c,i) <- algTypeCons dt `zip` [1..],
 496                      conString c == str ]
 497
 498
 499 -- | Gets the constructors
 500 algTypeCons :: DataType -> [Constr]
 501 algTypeCons dt = case datarep dt of
 502                    (AlgRep cons) -> cons
 503                    _ -> error "algTypeCons"
 504
 505
 506 -- | Gets the fixity of a constructor
 507 conFixity :: Constr -> Fixity
 508 conFixity = confixity
 509
 510
 511
 512 ------------------------------------------------------------------------------
 513 --
 514 --      From strings to constr's and vice versa: all data types
 515 --
 516 ------------------------------------------------------------------------------
 517
 518
 519 -- | Gets the string for a constructor
 520 conString :: Constr -> String
 521 conString = constring
 522
 523
 524 -- | Lookup a constructor via a string
 525 stringCon :: DataType -> String -> Maybe Constr
 526 stringCon dt str =
 527       case dataTypeRep dt of
 528         AlgRep cons -> idx cons
 529         IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntCon i)))
 530         FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatCon f)))
 531         StringRep   -> Just (mkStringCon dt str)
 532         NoRep       -> Nothing
 533   where
 534
 535     -- Read a value and build a constructor
 536     mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
 537     mkReadCon f = case (reads str) of
 538                     [(t,"")] -> Just (f t)
 539                     _ -> Nothing
 540
 541     -- Traverse list of algebraic datatype constructors
 542     idx :: [Constr] -> Maybe Constr
 543     idx cons = let fit = filter ((==) str . conString) cons
 544                 in if fit == []
 545                      then Nothing
 546                      else Just (head fit)
 547
 548
 549 ------------------------------------------------------------------------------
 550 --
 551 --      Convenience funtions: algebraic data types
 552 --
 553 ------------------------------------------------------------------------------
 554
 555
 556 -- | Test for an algebraic type
 557 isAlgType :: DataType -> Bool
 558 isAlgType dt = case datarep dt of
 559                  (AlgRep _) -> True
 560                  _ -> False
 561
 562
 563 -- | Gets the constructor for an index
 564 indexCon :: DataType -> ConIndex -> Constr
 565 indexCon dt idx = case datarep dt of
 566                     (AlgRep cs) -> cs !! (idx-1)
 567                     _           -> error "indexCon"
 568
 569
 570 -- | Gets the index of a constructor
 571 conIndex :: Constr -> ConIndex
 572 conIndex con = case conRep con of
 573                  (AlgCon idx) -> idx
 574                  _ -> error "conIndex"
 575
 576
 577 -- | Gets the maximum constructor index
 578 maxConIndex :: DataType -> ConIndex
 579 maxConIndex dt = case dataTypeRep dt of
 580                    AlgRep cs -> length cs
 581                    _         -> error "maxConIndex"
 582
 583
 584
 585 ------------------------------------------------------------------------------
 586 --
 587 --      Representation of primitive types
 588 --
 589 ------------------------------------------------------------------------------
 590
 591
 592 -- | Constructs the Int type
 593 mkIntType :: String -> DataType
 594 mkIntType = mkPrimType IntRep
 595
 596
 597 -- | Constructs the Float type
 598 mkFloatType :: String -> DataType
 599 mkFloatType = mkPrimType FloatRep
 600
 601
 602 -- | Constructs the String type
 603 mkStringType :: String -> DataType
 604 mkStringType = mkPrimType StringRep
 605
 606
 607 -- | Helper for mkIntType, mkFloatType, mkStringType
 608 mkPrimType :: DataRep -> String -> DataType
 609 mkPrimType dr str = DataType
 610                         { tycon   = str
 611                         , datarep = dr
 612                         }
 613
 614
 615 -- Makes a constructor for primitive types
 616 mkPrimCon :: DataType -> String -> ConRep -> Constr
 617 mkPrimCon dt str cr = Constr
 618                         { datatype  = dt
 619                         , conrep    = cr
 620                         , constring = str
 621                         , confixity = error "conFixity"
 622                         }
 623
 624
 625 mkIntCon :: DataType -> Integer -> Constr
 626 mkIntCon dt i = case datarep dt of
 627                   IntRep -> mkPrimCon dt (show i) (IntCon i)
 628                   _ -> error "mkIntCon"
 629
 630
 631 mkFloatCon :: DataType -> Double -> Constr
 632 mkFloatCon dt f = case datarep dt of
 633                     FloatRep -> mkPrimCon dt (show f) (FloatCon f)
 634                     _ -> error "mkFloatCon"
 635
 636
 637 mkStringCon :: DataType -> String -> Constr
 638 mkStringCon dt str = case datarep dt of
 639                        StringRep -> mkPrimCon dt str (StringCon str)
 640                        _ -> error "mkStringCon"
 641
 642
 643 ------------------------------------------------------------------------------
 644 --
 645 --      Non-representations for non-presentable types
 646 --
 647 ------------------------------------------------------------------------------
 648
 649
 650 -- | Constructs a non-representation
 651 mkNorepType :: String -> DataType
 652 mkNorepType str = DataType
 653                         { tycon   = str
 654                         , datarep = NoRep
 655                         }
 656
 657
 658 -- | Test for a non-representable type
 659 isNorepType :: DataType -> Bool
 660 isNorepType dt = case datarep dt of
 661                    NoRep -> True
 662                    _ -> False
 663
 664
 665
 666 ------------------------------------------------------------------------------
 667 --
 668 --      Convenience for qualified type constructors
 669 --
 670 ------------------------------------------------------------------------------
 671
 672
 673 -- | Gets the unqualified type constructor
 674 -- Drop *.*.*... before name
 675 --
 676 tyconUQname :: String -> String
 677 tyconUQname x = let x' = dropWhile (not . (==) '.') x
 678                  in if x' == [] then x else tyconUQname (tail x')
 679
 680
 681 -- | Gets the module of a type constructor
 682 -- Take *.*.*... before name
 683 tyconModule :: String -> String
 684 tyconModule x = let (a,b) = break ((==) '.') x
 685                  in if b == ""
 686                       then b
 687                       else a ++ tyconModule' (tail b)
 688   where
 689     tyconModule' x = let x' = tyconModule x
 690                       in if x' == "" then "" else ('.':x')