    -- | This is a new set of XML combinators for Xtract, not standard,
    --   but based on the standard set in "Text.Xml.Haxml.Combinators".
    --   The main difference is that the Content Filter type becomes a
    --   Double Filter.  A Double Filter always takes the whole document
    --   as an extra argument, so you can start to traverse it again from
    --   the root, when at any inner location within the document tree.
    --
    --   The new combinator definitions are derived from the old ones.
    --   The same names have the equivalent meaning - use module qualification
    --   on imports to distinguish between CFilter and DFilter variations.

    module Text.XML.HaXml.Xtract.Combinators where

    import Text.XML.HaXml.Types
    import Text.XML.HaXml.Combinators (CFilter)
    import qualified Text.XML.HaXml.Combinators as C

    -- | double content filter - takes document root + local subtree.
    type DFilter i = Content i -> Content i -> [Content i]

    -- | lift an ordinary content filter to a double filter.
    local,global :: CFilter i -> DFilter i
    local  f = \_xml  sub-> f sub
    global f = \ xml _sub-> f xml

    -- | drop a double filter to an ordinary content filter.
    --   (permitting interior access to document root)
    dfilter :: DFilter i -> CFilter i
    dfilter f = \xml-> f xml xml

    -- | drop a double filter to an ordinary content filter.
    --   (Where interior access to the document root is not needed, the
    --    retaining pointer to the outer element can be pruned away.
    --   'cfilter' is more space-efficient than 'dfilter' in this situation.)
    cfilter :: DFilter i -> CFilter i
    cfilter f = \xml -> f undefined xml
    --cfilter f = \xml-> flip f xml
    --                          (case xml of
    --                             CElem (Elem n as cs) i -> CElem (Elem n [] []) i
    --                             _ -> xml)

    -- | lift a CFilter combinator to a DFilter combinator
    liftLocal, liftGlobal :: (CFilter i->CFilter i) -> (DFilter i->DFilter i)
    liftLocal  ff = \df-> \xml  sub-> (ff (df xml)) sub
    liftGlobal ff = \df-> \xml _sub-> (ff (df xml)) xml

    -- | lifted composition over double filters.
    o :: DFilter i -> DFilter i -> DFilter i
    g `o` f = \xml-> concatMap (g xml) . (f xml)

    -- | lifted choice.
    (|>|) :: (a->b->[c]) -> (a->b->[c]) -> (a->b->[c])
    f |>| g = \xml sub-> let first = f xml sub in
                         if null first then g xml sub else first

    -- | lifted union.
    union :: (a->b->[c]) -> (a->b->[c]) -> (a->b->[c])
    union = lift (++)
      where
        lift f g h = \x y-> f (g x y) (h x y)

    -- | lifted predicates.
    with, without :: DFilter i -> DFilter i -> DFilter i
    f `with` g    = \xml-> filter (not.null.g xml) . f xml
    f `without` g = \xml-> filter     (null.g xml) . f xml

    -- | lifted unit and zero.
    keep, none :: DFilter i
    keep = \_xml  sub-> [sub]	-- local C.keep
    none = \_xml _sub-> []	-- local C.none

    children, elm, txt :: DFilter i
    children = local C.children
    elm      = local C.elm
    txt      = local C.txt

    applypred :: CFilter i -> DFilter i -> CFilter i
    applypred f p = \xml-> (const f `with` p) xml xml

    iffind :: String -> (String -> DFilter i) -> DFilter i -> DFilter i
    iffind  key  yes no xml c@(CElem (Elem _ as _) _) =
      case (lookup key as) of
        Nothing -> no xml c
        (Just v@(AttValue _)) -> yes (show v) xml c
    iffind _key _yes no xml other = no xml other

    ifTxt :: (String->DFilter i) -> DFilter i -> DFilter i
    ifTxt  yes _no xml c@(CString _ s _) = yes s xml c
    ifTxt _yes  no xml c                 = no xml c

    cat :: [a->b->[c]] -> (a->b->[c])
    cat fs = \xml sub-> concat [ f xml sub | f <- fs ]

    (/>) :: DFilter i -> DFilter i -> DFilter i
    f /> g = g `o` children `o` f

    (</) :: DFilter i -> DFilter i -> DFilter i
    f </ g = f `with` (g `o` children)

    deep, deepest, multi :: DFilter i -> DFilter i
    deep f    = f |>| (deep f `o` children)
    deepest f = (deepest f `o` children) |>| f
    multi f   = f `union` (multi f `o` children)