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