Data/Generics/Twins.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Data.Generics.Twins
   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.Twins (
  17
  18         -- * The idiom of multi-parameter traversal
  19         tfoldl,
  20
  21         -- * Twin mapping combinators
  22         tmapT,
  23         tmapQ,
  24         tmapM,
  25
  26         -- * Prime examples of twin traversal
  27         geq,
  28         gzip
  29
  30   ) where
  31
  32
  33 ------------------------------------------------------------------------------
  34
  35
  36 import Data.Generics.Basics
  37 import Data.Generics.Aliases
  38
  39
  40 ------------------------------------------------------------------------------
  41
  42
  43 ------------------------------------------------------------------------------
  44 --
  45 --      The idiom of multi-parameter traversal
  46 --
  47 ------------------------------------------------------------------------------
  48
  49 {-
  50
  51 The fact that we traverse two terms semi-simultaneously is reflected
  52 by the nested generic function type that occurs as the result type of
  53 tfoldl. By "semi-simultaneously", we mean that we first fold over the
  54 first term and compute a LIST of generic functions to be folded over
  55 the second term. So the outermost generic function type is GenericQ
  56 because we compute a list of generic functions which is a kind of
  57 query.  The inner generic function type is parameterised in a type
  58 constructor c so that we can instantiate twin traversal for
  59 transformations (T), queries (Q), and monadic transformations (M).
  60 The combinator tfoldl is also parameterised by a nested generic
  61 function which serves as the function to be mapped over the first term
  62 to get the functions to be mapped over the second term. The combinator
  63 tfoldl is further parameterised by gfoldl-like parameters k and z
  64 which however need to be lifted to k' and z' such that plain term
  65 traversal is combined with list traversal (of the list of generic
  66 functions).  That is, the essence of multi-parameter term traversal is
  67 a single term traversal interleaved with a list fold. As the
  68 definition of k' and z' details, the list fold can be arranged by the
  69 ingredients of the term fold. To this end, we use a designated TWIN
  70 datatype constructor which pairs a given type constructor c with a
  71 list of generic functions.
  72
  73 -}
  74
  75 tfoldl :: (forall a b. Data a => c (a -> b) -> c a -> c b)
  76        -> (forall g. g -> c g)
  77        -> GenericQ (Generic c)
  78        -> GenericQ (Generic c)
  79
  80 tfoldl k z t xs ys = case gfoldl k' z' ys of { TWIN _ c -> c }
  81  where
  82    l = gmapL (\x -> Generic' (t x)) xs
  83    k' (TWIN (r:rs) c) y = TWIN rs (k c (unGeneric' r y))
  84    z' f                 = TWIN l (z f)
  85
  86
  87 -- Pairing ID, CONST, m or others with lists of generic functions
  88 data TWIN c a   = TWIN [Generic' c] (c a)
  89
  90
  91
  92 ------------------------------------------------------------------------------
  93 --
  94 --      Twin mapping combinators
  95 --
  96 ------------------------------------------------------------------------------
  97
  98 tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
  99 tmapT f x y = unID $ tfoldl k z f' x y
 100  where
 101   f' x y = ID $ f x y
 102   k (ID c) (ID x) = ID (c x)
 103   z = ID
 104
 105
 106 tmapQ :: (r -> r -> r)
 107       -> r
 108       -> GenericQ (GenericQ r)
 109       -> GenericQ (GenericQ r)
 110 tmapQ o r f x y = unCONST $ tfoldl k z f' x y
 111  where
 112   f' x y = CONST $ f x y
 113   k (CONST c) (CONST x) = CONST (c `o` x)
 114   z _ = CONST r
 115
 116
 117 tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
 118 tmapM f x y = tfoldl k z f x y
 119  where
 120   k c x = do c' <- c
 121              x' <- x
 122              return $ c' x'
 123   z = return
 124
 125
 126 -- The identity type constructor needed for the definition of tmapT
 127 newtype ID x = ID { unID :: x }
 128
 129
 130 -- The constant type constructor needed for the definition of tmapQ
 131 newtype CONST c a = CONST { unCONST :: c }
 132
 133
 134
 135 ------------------------------------------------------------------------------
 136 --
 137 --      Prime examples of twin traversal
 138 --
 139 ------------------------------------------------------------------------------
 140
 141 -- | Generic equality: an alternative to \"deriving Eq\"
 142 geq :: Data a => a -> a -> Bool
 143
 144 {-
 145
 146 Testing for equality of two terms goes like this. Firstly, we
 147 establish the equality of the two top-level datatype
 148 constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
 149 to compare the two lists of immediate subterms.
 150
 151 (Note for the experts: the type of the worker geq' is rather general
 152 but precision is recovered via the restrictive type of the top-level
 153 operation geq. The imprecision of geq' is caused by the type system's
 154 unability to express the type equivalence for the corresponding
 155 couples of immediate subterms from the two given input terms.)
 156
 157 -}
 158
 159 geq x y = geq' x y
 160  where
 161   geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
 162   geq' x y = and [ (toConstr x == toConstr y)
 163                  , tmapQ (\b1 b2 -> and [b1,b2]) True geq' x y
 164                  ]
 165
 166
 167 -- | Generic zip controlled by a function with type-specific branches
 168 gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
 169      -> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
 170
 171
 172 -- See testsuite/.../Generics/gzip.hs for an illustration
 173 gzip f x y =
 174   f x y
 175   `orElse`
 176   if toConstr x == toConstr y
 177    then tmapM (gzip f) x y
 178    else Nothing