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