Data/Generics/Reify.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Reify
   4 -- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
   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/>.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Data.Generics.Reify (
  17
  18         -- * Types as values
  19         TypeVal,                -- view type "a" as "a -> ()"
  20         typeVal,                -- :: TypeVal a
  21         sameType,               -- two type values are the same
  22         typeValOf,              -- :: a -> TypeVal a
  23         undefinedType,          -- :: TypeVal a -> a
  24         withType,               -- :: a -> TypeVal a -> a
  25         argType,                -- :: (a -> b) -> TypeVal a
  26         resType,                -- :: (a -> b) -> TypeVal b
  27         paraType,               -- :: t a -> TypeVal a
  28         TypeFun,                -- functions on types
  29
  30         -- * Generic operations to reify terms
  31         glength,
  32         gcount,
  33         gnodecount,
  34         gtypecount,
  35
  36         -- * Generic operations to reify types
  37         constrArity,
  38         typeReachableFrom
  39
  40  ) where
  41
  42
  43 ------------------------------------------------------------------------------
  44
  45
  46 import Data.Generics.Basics
  47 import Data.Generics.Aliases
  48 import Data.Generics.Schemes
  49
  50
  51
  52 -------------------------------------------------------------
  53 --
  54 --      Types as values
  55 --
  56 -------------------------------------------------------------
  57
  58 {-
  59
  60 This group provides a style of encoding types as values and using
  61 them. This style is seen as an alternative to the pragmatic style used
  62 in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
  63 to denote a type argument. This pragmatic style suffers from lack
  64 of robustness: one feels tempted to pattern match on undefineds.
  65 Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
  66
  67 -}
  68
  69
  70 -- | Type as values to stipulate use of undefineds
  71 type TypeVal a = a -> ()
  72
  73
  74 -- | The value that denotes a type
  75 typeVal :: TypeVal a
  76 typeVal = const ()
  77
  78
  79 -- | Test for type equivalence
  80 sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
  81 sameType tva tvb = typeOf (undefinedType tva) ==
  82                    typeOf (undefinedType tvb)
  83
  84
  85 -- | Map a value to its type
  86 typeValOf :: a -> TypeVal a
  87 typeValOf _ = typeVal
  88
  89
  90 -- | Stipulate this idiom!
  91 undefinedType :: TypeVal a -> a
  92 undefinedType _ = undefined
  93
  94
  95 -- | Constrain a type
  96 withType :: a -> TypeVal a -> a
  97 withType x _ = x
  98
  99
 100 -- | The argument type of a function
 101 argType :: (a -> b) -> TypeVal a
 102 argType _ = typeVal
 103
 104
 105 -- | The result type of a function
 106 resType :: (a -> b) -> TypeVal b
 107 resType _ = typeVal
 108
 109
 110 -- | The parameter type of type constructor
 111 paraType :: t a -> TypeVal a
 112 paraType _ = typeVal
 113
 114
 115 -- Type functions,
 116 -- i.e., functions mapping types to values
 117 --
 118 type TypeFun a r = TypeVal a -> r
 119
 120
 121
 122 -- Generic type functions,
 123 -- i.e., functions mapping types to values
 124 --
 125 type GTypeFun r  = forall a. Typeable a => TypeFun a r
 126
 127
 128
 129 ------------------------------------------------------------------------------
 130 --
 131 --      Generic operations to reify terms
 132 --
 133 ------------------------------------------------------------------------------
 134
 135
 136 -- | Count the number of immediate subterms of the given term
 137 glength :: GenericQ Int
 138 glength = length . gmapQ (const ())
 139
 140
 141 -- | Determine the number of all suitable nodes in a given term
 142 gcount :: GenericQ Bool -> GenericQ Int
 143 gcount p =  everything (+) (\x -> if p x then 1 else 0)
 144
 145
 146 -- | Determine the number of all nodes in a given term
 147 gnodecount :: GenericQ Int
 148 gnodecount = gcount (const True)
 149
 150
 151 -- | Determine the number of nodes of a given type in a given term
 152 gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
 153 gtypecount f = gcount (False `mkQ` (const True . f))
 154
 155
 156
 157 ------------------------------------------------------------------------------
 158 --
 159 --      Generic operations to reify types
 160 --
 161 ------------------------------------------------------------------------------
 162
 163 -- | Compute arity of a constructor against a type argument
 164 constrArity :: Data a => (a -> ()) -> Constr -> Int
 165 constrArity ta c = glength $ withType (fromConstr c) ta
 166
 167
 168 --
 169 -- Reachability relation on types:
 170 --  Test if nodes of type "a" are reachable from nodes of type "b".
 171 --  This is a naive, inefficient encoding.
 172 --  As of writing, it does not even cope with recursive types.
 173 --
 174 typeReachableFrom :: (Data a, Data b) => TypeVal a -> TypeVal b -> Bool
 175 typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
 176   or ( sameType a b
 177      : map (recurse . fromConstr) (dataTypeCons $ dataTypeOf b)
 178      )
 179   where
 180
 181     -- See if a is reachable from immediate subterms of a kind of b
 182     recurse :: b -> Bool
 183     recurse = or
 184             . gmapQ ( typeReachableFrom a
 185                     . typeValOf
 186                     )