{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies,
ScopedTypeVariables, Rank2Types #-}
module Text.XML.Expat.Internal.NodeClass where
import Control.Monad (mzero, liftM)
import Data.Functor.Identity
import Data.List.Class (List(..), ListItem(..), cons, fromList, mapL, toList)
import Data.Monoid (Monoid)
import Text.XML.Expat.SAX (GenericXMLString)
type Attributes tag text = [(tag, text)]
type UAttributes text = Attributes text text
textContent :: (NodeClass n [], Monoid text) => n [] tag text -> text
textContent :: forall (n :: (* -> *) -> * -> * -> *) text tag.
(NodeClass n [], Monoid text) =>
n [] tag text -> text
textContent n [] tag text
node = Identity text -> text
forall a. Identity a -> a
runIdentity (Identity text -> text) -> Identity text -> text
forall a b. (a -> b) -> a -> b
$ n [] tag text -> ItemM [] text
forall text tag. Monoid text => n [] tag text -> ItemM [] text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> ItemM c text
textContentM n [] tag text
node
type family ListOf n
class (Functor c, List c) => NodeClass (n :: (* -> *) -> * -> * -> *) c where
isElement :: n c tag text -> Bool
isText :: n c tag text -> Bool
isCData :: n c tag text -> Bool
isProcessingInstruction :: n c tag text -> Bool
:: n c tag text -> Bool
textContentM :: Monoid text => n c tag text -> ItemM c text
isNamed :: Eq tag => tag -> n c tag text -> Bool
getName :: Monoid tag => n c tag text -> tag
hasTarget :: Eq text => text -> n c tag text -> Bool
getTarget :: Monoid text => n c tag text -> text
getAttributes :: n c tag text -> [(tag,text)]
getChildren :: n c tag text -> c (n c tag text)
getText :: Monoid text => n c tag text -> text
modifyName :: (tag -> tag)
-> n c tag text
-> n c tag text
modifyAttributes :: ([(tag, text)] -> [(tag, text)])
-> n c tag text
-> n c tag text
modifyChildren :: (c (n c tag text) -> c (n c tag text))
-> n c tag text
-> n c tag text
modifyElement :: ((tag, [(tag, text)], c (n c tag text))
-> (tag', [(tag', text)], c (n c tag' text)))
-> n c tag text
-> n c tag' text
mapAllTags :: (tag -> tag')
-> n c tag text
-> n c tag' text
mapNodeContainer :: List c' =>
(forall a . c a -> ItemM c (c' a))
-> n c tag text
-> ItemM c (n c' tag text)
mkText :: text -> n c tag text
mapNodeListContainer :: (NodeClass n c, List c') =>
(forall a . c a -> ItemM c (c' a))
-> c (n c tag text)
-> ItemM c (c' (n c' tag text))
mapNodeListContainer :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
(forall a. c a -> ItemM c (c' a))
-> c (n c tag text) -> ItemM c (c' (n c' tag text))
mapNodeListContainer forall a. c a -> ItemM c (c' a)
f = c (n c' tag text) -> ItemM c (c' (n c' tag text))
forall a. c a -> ItemM c (c' a)
f (c (n c' tag text) -> ItemM c (c' (n c' tag text)))
-> (c (n c tag text) -> c (n c' tag text))
-> c (n c tag text)
-> ItemM c (c' (n c' tag text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n c tag text -> ItemM c (n c' tag text))
-> c (n c tag text) -> c (n c' tag text)
forall (l :: * -> *) a b. List l => (a -> ItemM l b) -> l a -> l b
mapL ((forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
forall (c' :: * -> *) tag text.
List c' =>
(forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
(forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
mapNodeContainer c a -> ItemM c (c' a)
forall a. c a -> ItemM c (c' a)
f)
fromNodeContainer :: (NodeClass n c, List c') =>
n c tag text
-> ItemM c (n c' tag text)
fromNodeContainer :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
n c tag text -> ItemM c (n c' tag text)
fromNodeContainer = (forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
forall (c' :: * -> *) tag text.
List c' =>
(forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
(forall a. c a -> ItemM c (c' a))
-> n c tag text -> ItemM c (n c' tag text)
mapNodeContainer (\c a
l -> [a] -> c' a
forall (l :: * -> *) a. List l => [a] -> l a
fromList ([a] -> c' a) -> ItemM c [a] -> ItemM c (c' a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` c a -> ItemM c [a]
forall (l :: * -> *) a. List l => l a -> ItemM l [a]
toList c a
l)
fromNodeListContainer :: (NodeClass n c, List c') =>
c (n c tag text)
-> ItemM c (c' (n c' tag text))
fromNodeListContainer :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
c (n c tag text) -> ItemM c (c' (n c' tag text))
fromNodeListContainer = (forall a. c a -> ItemM c (c' a))
-> c (n c tag text) -> ItemM c (c' (n c' tag text))
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) (c' :: * -> *)
tag text.
(NodeClass n c, List c') =>
(forall a. c a -> ItemM c (c' a))
-> c (n c tag text) -> ItemM c (c' (n c' tag text))
mapNodeListContainer (\c a
l -> [a] -> c' a
forall (l :: * -> *) a. List l => [a] -> l a
fromList ([a] -> c' a) -> ItemM c [a] -> ItemM c (c' a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` c a -> ItemM c [a]
forall (l :: * -> *) a. List l => l a -> ItemM l [a]
toList c a
l)
class NodeClass n c => MkElementClass n c where
mkElement :: tag -> Attributes tag text -> c (n c tag text) -> n c tag text
getAttribute :: (NodeClass n c, GenericXMLString tag) => n c tag text -> tag -> Maybe text
getAttribute :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag) =>
n c tag text -> tag -> Maybe text
getAttribute n c tag text
n tag
t = tag -> [(tag, text)] -> Maybe text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup tag
t ([(tag, text)] -> Maybe text) -> [(tag, text)] -> Maybe text
forall a b. (a -> b) -> a -> b
$ n c tag text -> [(tag, text)]
forall tag text. n c tag text -> [(tag, text)]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> [(tag, text)]
getAttributes n c tag text
n
setAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> text -> n c tag text -> n c tag text
setAttribute :: forall tag (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(Eq tag, NodeClass n c, GenericXMLString tag) =>
tag -> text -> n c tag text -> n c tag text
setAttribute tag
t text
newValue = ([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
forall tag text.
([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
modifyAttributes [(tag, text)] -> [(tag, text)]
set
where
set :: [(tag, text)] -> [(tag, text)]
set [] = [(tag
t, text
newValue)]
set ((tag
name, text
_):[(tag, text)]
atts) | tag
name tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
== tag
t = (tag
name, text
newValue)(tag, text) -> [(tag, text)] -> [(tag, text)]
forall a. a -> [a] -> [a]
:[(tag, text)]
atts
set ((tag, text)
att:[(tag, text)]
atts) = (tag, text)
att(tag, text) -> [(tag, text)] -> [(tag, text)]
forall a. a -> [a] -> [a]
:[(tag, text)] -> [(tag, text)]
set [(tag, text)]
atts
deleteAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> n c tag text -> n c tag text
deleteAttribute :: forall tag (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(Eq tag, NodeClass n c, GenericXMLString tag) =>
tag -> n c tag text -> n c tag text
deleteAttribute tag
t = ([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
forall tag text.
([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
([(tag, text)] -> [(tag, text)]) -> n c tag text -> n c tag text
modifyAttributes [(tag, text)] -> [(tag, text)]
del
where
del :: [(tag, text)] -> [(tag, text)]
del [] = []
del ((tag
name, text
_):[(tag, text)]
atts) | tag
name tag -> tag -> Bool
forall a. Eq a => a -> a -> Bool
== tag
t = [(tag, text)]
atts
del ((tag, text)
att:[(tag, text)]
atts) = (tag, text)
att(tag, text) -> [(tag, text)] -> [(tag, text)]
forall a. a -> [a] -> [a]
:[(tag, text)] -> [(tag, text)]
del [(tag, text)]
atts
alterAttribute :: (Eq tag, NodeClass n c, GenericXMLString tag) => tag -> Maybe text -> n c tag text -> n c tag text
alterAttribute :: forall tag (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(Eq tag, NodeClass n c, GenericXMLString tag) =>
tag -> Maybe text -> n c tag text -> n c tag text
alterAttribute tag
t (Just text
newValue) = tag -> text -> n c tag text -> n c tag text
forall tag (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(Eq tag, NodeClass n c, GenericXMLString tag) =>
tag -> text -> n c tag text -> n c tag text
setAttribute tag
t text
newValue
alterAttribute tag
t Maybe text
Nothing = tag -> n c tag text -> n c tag text
forall tag (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(Eq tag, NodeClass n c, GenericXMLString tag) =>
tag -> n c tag text -> n c tag text
deleteAttribute tag
t
fromElement :: (NodeClass n c, MkElementClass n' c, Monoid tag, Monoid text) =>
n c tag text
-> n' c tag text
fromElement :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, MkElementClass n' c, Monoid tag, Monoid text) =>
n c tag text -> n' c tag text
fromElement = (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text -> n' c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text -> n' c tag text
fromElement_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
forall tag text.
tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
MkElementClass n c =>
tag -> Attributes tag text -> c (n c tag text) -> n c tag text
mkElement
fromElement_ :: (NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text
-> n' c tag text
fromElement_ :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text -> n' c tag text
fromElement_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement n c tag text
elt | 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
elt =
tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement (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
elt) (n c tag text -> Attributes tag text
forall tag text. n c tag text -> [(tag, text)]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> [(tag, text)]
getAttributes n c tag text
elt) ((tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement (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
elt)
fromElement_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
_ n c tag text
_ = [Char] -> n' c tag text
forall a. HasCallStack => [Char] -> a
error [Char]
"fromElement requires an Element"
fromNodes :: (NodeClass n c, MkElementClass n' c, Monoid tag, Monoid text) =>
c (n c tag text)
-> c (n' c tag text)
fromNodes :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, MkElementClass n' c, Monoid tag, Monoid text) =>
c (n c tag text) -> c (n' c tag text)
fromNodes = (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
forall tag text.
tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
MkElementClass n c =>
tag -> Attributes tag text -> c (n c tag text) -> n c tag text
mkElement
fromNodes_ :: (NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text)
-> c (n' c tag text)
fromNodes_ :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement c (n c tag text)
l = ItemM c (c (n' c tag text)) -> c (n' c tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c (n' c tag text)) -> c (n' c tag text))
-> ItemM c (c (n' c tag text)) -> c (n' c tag text)
forall a b. (a -> b) -> a -> b
$ do
ListItem c (n c tag text)
li <- c (n c tag text) -> ItemM c (ListItem c (n c tag text))
forall a. c a -> ItemM c (ListItem c a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList c (n c tag text)
l
c (n' c tag text) -> ItemM c (c (n' c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (n' c tag text) -> ItemM c (c (n' c tag text)))
-> c (n' c tag text) -> ItemM c (c (n' c tag text))
forall a b. (a -> b) -> a -> b
$ case ListItem c (n c tag text)
li of
ListItem c (n c tag text)
Nil -> c (n' c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Cons n c tag text
elt c (n c tag text)
l' | 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
elt -> (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text -> n' c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> n c tag text -> n' c tag text
fromElement_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement n c tag text
elt n' c tag text -> c (n' c tag text) -> c (n' c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement c (n c tag text)
l'
Cons n c tag text
txt c (n c tag text)
l' | 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 n c tag text
txt -> text -> n' c tag text
forall text tag. text -> n' c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
NodeClass n c =>
text -> n c tag text
mkText (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 n c tag text
txt) n' c tag text -> c (n' c tag text) -> c (n' c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
`cons` (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement c (n c tag text)
l'
Cons n c tag text
_ c (n c tag text)
l' -> (tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *)
(n' :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n c, NodeClass n' c, Monoid tag, Monoid text) =>
(tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text)
-> c (n c tag text) -> c (n' c tag text)
fromNodes_ tag -> Attributes tag text -> c (n' c tag text) -> n' c tag text
mkElement c (n c tag text)
l'