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