-- | 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 :: forall i. CFilter i -> DFilter i
local  CFilter i
f Content i
_xml Content i
sub = CFilter i
f Content i
sub
global :: forall i. CFilter i -> DFilter i
global CFilter i
f Content i
xml Content i
_sub = CFilter i
f Content i
xml

-- | drop a double filter to an ordinary content filter.
--   (permitting interior access to document root)
dfilter :: DFilter i -> CFilter i
dfilter :: forall i. DFilter i -> CFilter i
dfilter DFilter i
f Content i
xml = DFilter i
f Content i
xml Content i
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 :: forall i. DFilter i -> CFilter i
cfilter DFilter i
f = DFilter i
f forall a. HasCallStack => a
undefined
--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 :: forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftLocal  CFilter i -> CFilter i
ff DFilter i
df Content i
xml  Content i
sub = CFilter i -> CFilter i
ff (DFilter i
df Content i
xml) Content i
sub
liftGlobal :: forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftGlobal CFilter i -> CFilter i
ff DFilter i
df Content i
xml Content i
_sub = CFilter i -> CFilter i
ff (DFilter i
df Content i
xml) Content i
xml

-- | lifted composition over double filters.
o :: DFilter i -> DFilter i -> DFilter i
DFilter i
g o :: forall i. DFilter i -> DFilter i -> DFilter i
`o` DFilter i
f = \Content i
xml-> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DFilter i
g Content i
xml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFilter i
f Content i
xml

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

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

-- | lifted predicates.
with, without :: DFilter i -> DFilter i -> DFilter i
DFilter i
f with :: forall i. DFilter i -> DFilter i -> DFilter i
`with` DFilter i
g    = \Content i
xml-> forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.DFilter i
g Content i
xml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFilter i
f Content i
xml
DFilter i
f without :: forall i. DFilter i -> DFilter i -> DFilter i
`without` DFilter i
g = \Content i
xml-> forall a. (a -> Bool) -> [a] -> [a]
filter     (forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.DFilter i
g Content i
xml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFilter i
f Content i
xml

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

children, elm, txt :: DFilter i
children :: forall i. DFilter i
children = forall i. CFilter i -> DFilter i
local forall i. CFilter i
C.children
elm :: forall i. DFilter i
elm      = forall i. CFilter i -> DFilter i
local forall i. CFilter i
C.elm
txt :: forall i. DFilter i
txt      = forall i. CFilter i -> DFilter i
local forall i. CFilter i
C.txt

applypred :: CFilter i -> DFilter i -> CFilter i
applypred :: forall i. CFilter i -> DFilter i -> CFilter i
applypred CFilter i
f DFilter i
p Content i
xml = (forall a b. a -> b -> a
const CFilter i
f forall i. DFilter i -> DFilter i -> DFilter i
`with` DFilter i
p) Content i
xml Content i
xml

iffind :: String -> (String -> DFilter i) -> DFilter i -> DFilter i
iffind :: forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
iffind  String
key  String -> DFilter i
yes DFilter i
no Content i
xml c :: Content i
c@(CElem (Elem QName
_ [Attribute]
as [Content i]
_) i
_) =
  case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> QName
N String
key) [Attribute]
as of
    Maybe AttValue
Nothing -> DFilter i
no Content i
xml Content i
c
    (Just v :: AttValue
v@(AttValue [Either String Reference]
_)) -> String -> DFilter i
yes (forall a. Show a => a -> String
show AttValue
v) Content i
xml Content i
c
iffind String
_key String -> DFilter i
_yes DFilter i
no Content i
xml Content i
other = DFilter i
no Content i
xml Content i
other

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

cat :: [a->b->[c]] -> (a->b->[c])
cat :: forall a b c. [a -> b -> [c]] -> a -> b -> [c]
cat [a -> b -> [c]]
fs a
xml b
sub = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ a -> b -> [c]
f a
xml b
sub | a -> b -> [c]
f <- [a -> b -> [c]]
fs ]

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

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

deep, deepest, multi :: DFilter i -> DFilter i
deep :: forall i. DFilter i -> DFilter i
deep DFilter i
f    = DFilter i
f forall a b c. (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
|>| (forall i. DFilter i -> DFilter i
deep DFilter i
f forall i. DFilter i -> DFilter i -> DFilter i
`o` forall i. DFilter i
children)
deepest :: forall i. DFilter i -> DFilter i
deepest DFilter i
f = (forall i. DFilter i -> DFilter i
deepest DFilter i
f forall i. DFilter i -> DFilter i -> DFilter i
`o` forall i. DFilter i
children) forall a b c. (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
|>| DFilter i
f
multi :: forall i. DFilter i -> DFilter i
multi DFilter i
f   = DFilter i
f forall a b c. (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
`union` (forall i. DFilter i -> DFilter i
multi DFilter i
f forall i. DFilter i -> DFilter i -> DFilter i
`o` forall i. DFilter i
children)