gmapQ,
gmapQl,
gmapQr,
+ gmapQi,
gmapM,
gmapMp,
gmapMo,
where
k (Qr c) x = Qr (\r -> c (f x `o` r))
+
-- | A generic query that processes the immediate subterms and returns a list
gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
gmapQ f = gmapQr (:) [] f
+ -- | A generic query that processes one child by index (zero-based)
+ gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
+ gmapQi i f x = case gfoldl k z x of { COUNT _ (Just q) -> q }
+ where
+ k (COUNT i' q) a = COUNT (i'+1) (if i==i' then Just (f a) else q)
+ z f = COUNT 0 Nothing
+
+
-- | A generic monadic transformation that maps over the immediate subterms
gmapM :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
newtype CONST c a = CONST { unCONST :: c }
+-- | Type constructor for adding counters to queries
+data COUNT q a = COUNT Int (Maybe q)
+
+
-- | The type constructor used in definition of gmapQr
newtype Qr r a = Qr { unQr :: r -> r }
dataTypeOf _ = StringType
--
--- Bool as the most trivial algebraic datatype;
+-- () as the most trivial algebraic datatype;
+-- define top-level definitions for representations.
+--
+
+emptyTupleConstr = mkConstr 1 "()" Prefix
+unitDataType = mkDataType [emptyTupleConstr]
+
+instance Data () where
+ toConstr _ = emptyTupleConstr
+ fromConstr c | conIndex c == 1 = ()
+ dataTypeOf _ = unitDataType
+
+--
+-- Bool as another trivial algebraic datatype;
-- define top-level definitions for representations.
--
--- /dev/null
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Generics.List
+-- Copyright : (c) The University of Glasgow, CWI 2001--2004
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : experimental
+-- Portability : non-portable
+--
+-- \"Scrap your boilerplate\" --- Generic programming in Haskell
+-- See <http://www.cs.vu.nl/boilerplate/>. The present module illustrates
+-- one possible treatment of polymorphic datatypes for specialising
+-- generic functions.
+--
+-----------------------------------------------------------------------------
+
+module Data.Generics.List (
+
+ -- * Processing polymorphic lists
+ isList,
+ isNil,
+ isCons,
+ lgmapQ
+
+
+ ) where
+
+
+------------------------------------------------------------------------------
+
+#ifdef __HADDOCK__
+import Prelude
+#endif
+import Data.Maybe
+import Data.Generics.Basics
+
+-------------------------------------------------------------
+--
+-- Processing polymorphic lists
+--
+-------------------------------------------------------------
+
+
+-- | Test for list datatype
+isList :: Data a => a -> Bool
+isList x = typerepTyCon (typeOf x) ==
+ typerepTyCon (typeOf (undefined::[()]))
+
+
+-- | Test for nil
+isNil :: Data a => a -> Bool
+isNil x = toConstr x == toConstr ([]::[()])
+
+
+-- | Test for cons
+isCons :: Data a => a -> Bool
+isCons x = toConstr x == toConstr (():[])
+
+
+-- | gmapQ for polymorphic lists; Nothing for other than lists
+lgmapQ :: forall a q. Data a => (forall a. Data a => a -> q) -> a -> Maybe [q]
+lgmapQ f x =
+ if not $ isList x
+ then Nothing
+ else Just ( if isNil x
+ then []
+ else if isCons x
+ then ( gmapQi 0 f x : gmapQi 1 (fromJust . lgmapQ f) x )
+ else error "lgmapQ"
+ )
module Data.Generics.Twins (
- -- * The idiom of multi-parameter traversal
- tfoldl,
+ -- * The idiom for multi-parameter traversal
+ gzipWith,
- -- * Twin mapping combinators
+ -- * Mapping combinators with an additional list
+ gzipWithT,
+ gzipWithM,
+ gzipWithQ,
+ gzipWithQl,
+ gzipWithQr,
+
+ -- * Mapping combinators for twin traversal
tmapT,
- tmapQl,
- tmapM,
+ tmapM,
+ tmapQ,
+
- -- * Prime examples of twin traversal
+ -- * Typical twin traversals
geq,
gzip
------------------------------------------------------------------------------
--
--- The idiom of multi-parameter traversal
+-- The idiom for multi-parameter traversal
--
------------------------------------------------------------------------------
{-
-The fact that we traverse two terms semi-simultaneously is reflected
-by the nested generic function type that occurs as the result type of
-tfoldl. By "semi-simultaneously", we mean that we first fold over the
-first term and compute a LIST of generic functions to be folded over
-the second term. So the outermost generic function type is GenericQ
-because we compute a list of generic functions which is a kind of
-query. The inner generic function type is parameterised in a type
-constructor c so that we can instantiate twin traversal for
-transformations (T), queries (Q), and monadic transformations (M).
-The combinator tfoldl is also parameterised by a nested generic
-function which serves as the function to be mapped over the first term
-to get the functions to be mapped over the second term. The combinator
-tfoldl is further parameterised by gfoldl-like parameters k and z
-which however need to be lifted to k' and z' such that plain term
-traversal is combined with list traversal (of the list of generic
-functions). That is, the essence of multi-parameter term traversal is
-a single term traversal interleaved with a list fold. As the
-definition of k' and z' details, the list fold can be arranged by the
-ingredients of the term fold. To this end, we use a designated TWIN
-datatype constructor which pairs a given type constructor c with a
-list of generic functions.
+gfoldl and friends so far facilitated traversal of a single term. We
+will now consider an idiom gfoldlWith to traverse two terms
+semi-simultaneously. By cascasding this idiom, we can also traverse
+more than two terms. The gfoldlWith primitive completes gfoldl in a
+way that is similar to the well-known couple map and
+zipWith. Basically, gfoldlWith takes an additional argument, namely a
+list, and this list is traversed simultaneously with the immediate
+subterms of a given term.
-}
-tfoldl :: (forall a b. Data a => c (a -> b) -> c a -> c b)
- -> (forall g. g -> c g)
- -> GenericQ (Generic c)
- -> GenericQ (Generic c)
-tfoldl k z t xs ys = case gfoldl k' z' ys of { TWIN _ c -> c }
+-- | gfoldl with an additional list
+gzipWith :: Data a
+ => (forall a b. Data a => d -> c (a -> b) -> a -> c b)
+ -> (forall g. g -> c g)
+ -> [d]
+ -> a
+ -> c a
+
+gzipWith k z l x = case gfoldl k' z' x of { WITH _ c -> c }
where
- l = gmapQ (\x -> Generic' (t x)) xs
- k' (TWIN (r:rs) c) y = TWIN rs (k c (unGeneric' r y))
- z' f = TWIN l (z f)
+ k' (WITH (h:t) c) y = WITH t (k h c y)
+ k' (WITH [] _) _ = error "gzipWith"
+ z' f = WITH l (z f)
--- Pairing ID, CONST, m or others with lists of generic functions
-data TWIN c a = TWIN [Generic' c] (c a)
+-- | A type constructor for folding over the extra list
+data WITH q c a = WITH [q] (c a)
------------------------------------------------------------------------------
--
--- Twin mapping combinators
+-- Mapping combinators with an additional list
--
------------------------------------------------------------------------------
-tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
-tmapT f x y = unID $ tfoldl k z f' x y
- where
- f' x y = ID $ f x y
- k (ID c) (ID x) = ID (c x)
- z = ID
+-- | gmapT with an additional list
+gzipWithT :: Data a
+ => (forall a. Data a => b -> a -> a)
+ -> [b]
+ -> a
+ -> a
-tmapQl :: (r -> r -> r)
- -> r
- -> GenericQ (GenericQ r)
- -> GenericQ (GenericQ r)
-tmapQl o r f x y = unCONST $ tfoldl k z f' x y
- where
- f' x y = CONST $ f x y
- k (CONST c) (CONST x) = CONST (c `o` x)
- z _ = CONST r
+gzipWithT f l = unID . gzipWith k ID l
+ where
+ k b (ID c) x = ID $ c $ f b x
-tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
-tmapM f x y = tfoldl k z f x y
- where
- k c x = do c' <- c
- x' <- x
- return $ c' x'
- z = return
+-- | gmapM with an additional list
+gzipWithM :: (Data a, Monad m)
+ => (forall a. Data a => b -> a -> m a)
+ -> [b]
+ -> a
+ -> m a
+
+gzipWithM f = gzipWith k return
+ where
+ k b c x = do c' <- c
+ x' <- f b x
+ return (c' x')
+
+
+-- | gmapQl with an additional list
+gzipWithQl :: Data a
+ => (r -> r -> r)
+ -> r
+ -> (forall a. Data a => b -> a -> r)
+ -> [b]
+ -> a
+ -> r
+
+gzipWithQl o r f l = unCONST . gzipWith k z l
+ where
+ k b (CONST c) x = CONST (c `o` f b x)
+ z _ = CONST r
+
+
+-- | gmapQr with an additional list
+gzipWithQr :: Data a
+ => (r' -> r -> r)
+ -> r
+ -> (forall a. Data a => b -> a -> r')
+ -> [b]
+ -> a
+ -> r
+
+gzipWithQr o r f l x = unQr (gzipWith k z l x) r
+ where
+ k b (Qr c) x = Qr (\r -> c (f b x `o` r))
+ z _ = Qr id
+
+
+-- | gmapQ with an additional list
+gzipWithQ :: Data a
+ => (forall a. Data a => b -> a -> u)
+ -> [b]
+ -> a
+ -> [u]
+
+gzipWithQ f = gzipWithQr (:) [] f
+
+
+
+------------------------------------------------------------------------------
+--
+-- Helper type constructors
+--
+------------------------------------------------------------------------------
--- The identity type constructor needed for the definition of tmapT
+
+-- | The identity type constructor needed for the definition of gzipWithT
newtype ID x = ID { unID :: x }
--- The constant type constructor needed for the definition of tmapQl
+-- | The constant type constructor needed for the definition of gzipWithQl
newtype CONST c a = CONST { unCONST :: c }
+-- | The type constructor needed for the definition of gzipWithQr
+newtype Qr r a = Qr { unQr :: r -> r }
+
+
+
+------------------------------------------------------------------------------
+--
+-- Mapping combinators for twin traversal
+--
+------------------------------------------------------------------------------
+
+
+-- | Twin map for transformation
+tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
+tmapT f x y =
+ gzipWithT unGenericT'
+ (gmapQ (\x -> GenericT' (f x)) x)
+ y
+
+
+-- | Twin map for monadic transformation
+tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
+tmapM f x y =
+ gzipWithM unGenericM'
+ (gmapQ (\x -> GenericM' (f x)) x)
+ y
+
+
+-- | Twin map for monadic transformation
+tmapQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
+tmapQ f x y =
+ gzipWithQ unGenericQ'
+ (gmapQ (\x -> GenericQ' (f x)) x)
+ y
+
+
------------------------------------------------------------------------------
--
--- Prime examples of twin traversal
+-- Typical twin traversals
--
------------------------------------------------------------------------------
-}
geq x y = geq' x y
- where
- geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
- geq' x y = and [ (toConstr x == toConstr y)
- , tmapQl (\b1 b2 -> and [b1,b2]) True geq' x y
- ]
+ where
+ geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
+ geq' x y = and ( (toConstr x == toConstr y)
+ : tmapQ geq' x y
+ )
-- | Generic zip controlled by a function with type-specific branches
f x y
`orElse`
if toConstr x == toConstr y
- then tmapM (gzip f) x y
- else Nothing
+ then tmapM (gzip f) x y
+ else Nothing
projects / ghc-base.git / commitdiff