{-# LANGUAGE FlexibleContexts #-}
-- | This module ported from Text.XML.Light.Proc
module Text.XML.Expat.Proc where

import Text.XML.Expat.Internal.NodeClass
import Text.XML.Expat.SAX

import Control.Monad
import Data.List.Class (filter)
import Data.Maybe(listToMaybe)
import Data.Monoid
import Prelude hiding (filter)


-- | Select only the elements from a list of XML content.
onlyElems          :: NodeClass n c => c (n c tag text) -> c (n c tag text)
onlyElems :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
c (n c tag text) -> c (n c tag text)
onlyElems           = (n c tag text -> Bool) -> c (n c tag text) -> c (n c tag text)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
filter n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement

-- | Select only the text from a list of XML content.
onlyText           :: (NodeClass n c, Monoid text) => c (n c tag text) -> c text
onlyText :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
c (n c tag text) -> c text
onlyText            = (n c tag text -> text) -> c (n c tag text) -> c text
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText (c (n c tag text) -> c text)
-> (c (n c tag text) -> c (n c tag text))
-> c (n c tag text)
-> c text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n c tag text -> Bool) -> c (n c tag text) -> c (n c tag text)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
filter n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isText

-- | Find all immediate children with the given name.
findChildren       :: (NodeClass n c, Eq tag, Monoid tag) => tag -> n c tag text -> c (n c tag text)
findChildren :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Eq tag, Monoid tag) =>
tag -> n c tag text -> c (n c tag text)
findChildren tag
q n c tag text
e    = (n c tag text -> Bool) -> n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterChildren ((tag
q tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
==) (tag -> Bool) -> (n c tag text -> tag) -> n c tag text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n c tag text -> tag
forall tag text. Monoid tag => n c tag text -> tag
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
n c tag text -> tag
getName) n c tag text
e

-- | Filter all immediate children wrt a given predicate.
filterChildren       :: NodeClass n c => (n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterChildren :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterChildren n c tag text -> Bool
p n c tag text
e | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
e = (n c tag text -> Bool) -> c (n c tag text) -> c (n c tag text)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
filter n c tag text -> Bool
p (c (n c tag text) -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
c (n c tag text) -> c (n c tag text)
onlyElems (n c tag text -> c (n c tag text)
forall tag text. n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> c (n c tag text)
getChildren n c tag text
e))
filterChildren n c tag text -> Bool
_ n c tag text
_               = c (n c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Filter all immediate children wrt a given predicate over their names.
filterChildrenName      :: (NodeClass n c, Monoid tag) => (tag -> Bool) -> n c tag text -> c (n c tag text)
filterChildrenName :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
(tag -> Bool) -> n c tag text -> c (n c tag text)
filterChildrenName tag -> Bool
p n c tag text
e | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
e = (n c tag text -> Bool) -> c (n c tag text) -> c (n c tag text)
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
filter (tag -> Bool
p (tag -> Bool) -> (n c tag text -> tag) -> n c tag text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n c tag text -> tag
forall tag text. Monoid tag => n c tag text -> tag
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
n c tag text -> tag
getName) (c (n c tag text) -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
c (n c tag text) -> c (n c tag text)
onlyElems (n c tag text -> c (n c tag text)
forall tag text. n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> c (n c tag text)
getChildren n c tag text
e))
filterChildrenName tag -> Bool
_ n c tag text
_               = c (n c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Find an immediate child with the given name.
findChild          :: (NodeClass n [], GenericXMLString tag) => tag -> n [] tag text -> Maybe (n [] tag text)
findChild :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag) =>
tag -> n [] tag text -> Maybe (n [] tag text)
findChild tag
q n [] tag text
e       = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe (tag -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Eq tag, Monoid tag) =>
tag -> n c tag text -> c (n c tag text)
findChildren tag
q n [] tag text
e)

-- | Find an immediate child with the given name.
filterChild          :: NodeClass n [] => (n [] tag text -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterChild :: forall (n :: (* -> *) -> * -> * -> *) tag text.
NodeClass n [] =>
(n [] tag text -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterChild n [] tag text -> Bool
p n [] tag text
e       = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe ((n [] tag text -> Bool) -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterChildren n [] tag text -> Bool
p n [] tag text
e)

-- | Find an immediate child with name matching a predicate.
filterChildName      :: (NodeClass n [], Monoid tag) => (tag -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterChildName :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], Monoid tag) =>
(tag -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterChildName tag -> Bool
p n [] tag text
e   = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe ((tag -> Bool) -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
(tag -> Bool) -> n c tag text -> c (n c tag text)
filterChildrenName tag -> Bool
p n [] tag text
e)

-- | Find the left-most occurrence of an element matching given name.
findElement        :: (NodeClass n [], Eq tag, Monoid tag) => tag -> n [] tag text -> Maybe (n [] tag text)
findElement :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], Eq tag, Monoid tag) =>
tag -> n [] tag text -> Maybe (n [] tag text)
findElement tag
q n [] tag text
e     = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe (tag -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Eq tag, Monoid tag) =>
tag -> n c tag text -> c (n c tag text)
findElements tag
q n [] tag text
e)

-- | Filter the left-most occurrence of an element wrt. given predicate.
filterElement        :: NodeClass n [] => (n [] tag text -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterElement :: forall (n :: (* -> *) -> * -> * -> *) tag text.
NodeClass n [] =>
(n [] tag text -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterElement n [] tag text -> Bool
p n [] tag text
e     = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe ((n [] tag text -> Bool) -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterElements n [] tag text -> Bool
p n [] tag text
e)

-- | Filter the left-most occurrence of an element wrt. given predicate.
filterElementName     :: (NodeClass n [], Monoid tag) => (tag -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterElementName :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], Monoid tag) =>
(tag -> Bool) -> n [] tag text -> Maybe (n [] tag text)
filterElementName tag -> Bool
p n [] tag text
e  = [n [] tag text] -> Maybe (n [] tag text)
forall a. [a] -> Maybe a
listToMaybe ((tag -> Bool) -> n [] tag text -> [n [] tag text]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
(tag -> Bool) -> n c tag text -> c (n c tag text)
filterElementsName tag -> Bool
p n [] tag text
e)

-- | Find all non-nested occurances of an element.
-- (i.e., once we have found an element, we do not search
-- for more occurances among the element's children).
findElements       :: (NodeClass n c, Eq tag, Monoid tag) => tag -> n c tag text -> c (n c tag text)
findElements :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Eq tag, Monoid tag) =>
tag -> n c tag text -> c (n c tag text)
findElements tag
qn n c tag text
e = (tag -> Bool) -> n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
(tag -> Bool) -> n c tag text -> c (n c tag text)
filterElementsName (tag
qntag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
==) n c tag text
e

-- | Find all non-nested occurrences of an element wrt. given predicate.
-- (i.e., once we have found an element, we do not search
-- for more occurances among the element's children).
filterElements       :: NodeClass n c => (n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterElements :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterElements n c tag text -> Bool
p n c tag text
e
    | n c tag text -> Bool
p n c tag text
e         = n c tag text -> c (n c tag text)
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return n c tag text
e
    | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
e = c (c (n c tag text)) -> c (n c tag text)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (c (c (n c tag text)) -> c (n c tag text))
-> c (c (n c tag text)) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$ (n c tag text -> c (n c tag text))
-> c (n c tag text) -> c (c (n c tag text))
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((n c tag text -> Bool) -> n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterElements n c tag text -> Bool
p) (c (n c tag text) -> c (c (n c tag text)))
-> c (n c tag text) -> c (c (n c tag text))
forall a b. (a -> b) -> a -> b
$ c (n c tag text) -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
c (n c tag text) -> c (n c tag text)
onlyElems (c (n c tag text) -> c (n c tag text))
-> c (n c tag text) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$ n c tag text -> c (n c tag text)
forall tag text. n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> c (n c tag text)
getChildren n c tag text
e
    | Bool
otherwise   = c (n c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- | Find all non-nested occurences of an element wrt a predicate over element names.
-- (i.e., once we have found an element, we do not search
-- for more occurances among the element's children).
filterElementsName       :: (NodeClass n c, Monoid tag) => (tag -> Bool) -> n c tag text -> c (n c tag text)
filterElementsName :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
(tag -> Bool) -> n c tag text -> c (n c tag text)
filterElementsName tag -> Bool
p n c tag text
e | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
e = (n c tag text -> Bool) -> n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(n c tag text -> Bool) -> n c tag text -> c (n c tag text)
filterElements (tag -> Bool
p (tag -> Bool) -> (n c tag text -> tag) -> n c tag text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n c tag text -> tag
forall tag text. Monoid tag => n c tag text -> tag
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
n c tag text -> tag
getName) n c tag text
e
filterElementsName tag -> Bool
_ n c tag text
_               = c (n c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero