-- | 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 :: CFilter i -> DFilter i
local  CFilter i
f Content i
_xml Content i
sub = CFilter i
f Content i
sub
global :: 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 :: 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 :: DFilter i -> CFilter i
cfilter DFilter i
f = DFilter i
f Content i
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 :: (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 :: (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 :: DFilter i -> DFilter i -> DFilter i
`o` DFilter i
f = \Content i
xml-> (Content i -> [Content i]) -> [Content i] -> [Content i]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DFilter i
g Content i
xml) ([Content i] -> [Content i])
-> (Content i -> [Content i]) -> Content i -> [Content i]
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 |>| :: (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 [c] -> Bool
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 :: (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
union = ([c] -> [c] -> [c])
-> (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
forall t t t t t.
(t -> t -> t) -> (t -> t -> t) -> (t -> t -> t) -> t -> t -> t
lift [c] -> [c] -> [c]
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 :: DFilter i -> DFilter i -> DFilter i
`with` DFilter i
g    = \Content i
xml-> (Content i -> Bool) -> [Content i] -> [Content i]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Content i -> Bool) -> Content i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Content i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Content i] -> Bool)
-> (Content i -> [Content i]) -> Content i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DFilter i
g Content i
xml) ([Content i] -> [Content i])
-> (Content i -> [Content i]) -> Content i -> [Content i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFilter i
f Content i
xml
DFilter i
f without :: DFilter i -> DFilter i -> DFilter i
`without` DFilter i
g = \Content i
xml-> (Content i -> Bool) -> [Content i] -> [Content i]
forall a. (a -> Bool) -> [a] -> [a]
filter     ([Content i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null([Content i] -> Bool)
-> (Content i -> [Content i]) -> Content i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DFilter i
g Content i
xml) ([Content i] -> [Content i])
-> (Content i -> [Content i]) -> Content i -> [Content i]
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 :: DFilter i
keep Content i
_xml  Content i
sub = [Content i
sub]       -- local C.keep
none :: DFilter i
none Content i
_xml Content i
_sub = []          -- local C.none

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

applypred :: CFilter i -> DFilter i -> CFilter i
applypred :: CFilter i -> DFilter i -> CFilter i
applypred CFilter i
f DFilter i
p Content i
xml = (CFilter i -> DFilter i
forall a b. a -> b -> a
const CFilter i
f DFilter i -> DFilter i -> DFilter i
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 :: 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 QName -> [Attribute] -> Maybe AttValue
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 (AttValue -> String
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 :: (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 :: [a -> b -> [c]] -> a -> b -> [c]
cat [a -> b -> [c]]
fs a
xml b
sub = [[c]] -> [c]
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 /> :: DFilter i -> DFilter i -> DFilter i
/> DFilter i
g = DFilter i
g DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`o` DFilter i
forall i. DFilter i
children DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`o` DFilter i
f

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

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