{- |
Module      :  ./Common/XUpdate.hs
Description :  analyse xml update input
Copyright   :  (c) Christian Maeder, DFKI GmbH 2010
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

collect xupdate information
<http://xmldb-org.sourceforge.net/xupdate/xupdate-wd.html>
<http://www.xmldatabases.org/projects/XUpdate-UseCases/>
-}

module Common.XUpdate where

import Common.XPath
import Common.ToXml
import Common.Utils

import Text.XML.Light as XML

import Data.Char
import Data.List

import Control.Monad
import qualified Control.Monad.Fail as Fail

-- | possible insertions
data AddChange
  = AddElem Element
  | AddAttr Attr
  | AddText String
  | AddComment String
  | AddPI String String
  | ValueOf

instance Show AddChange where
  show :: AddChange -> String
show c :: AddChange
c = case AddChange
c of
    AddElem e :: Element
e -> Element -> String
showElement Element
e
    AddAttr a :: Attr
a -> Attr -> String
showAttr Attr
a
    AddText s :: String
s -> ShowS
forall a. Show a => a -> String
show String
s
    AddComment s :: String
s -> "<!--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-->"
    AddPI n :: String
n s :: String
s -> "<?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "?>"
    ValueOf -> String
valueOfS

valueOfS :: String
valueOfS :: String
valueOfS = "value-of"

data Insert = Before | After | Append deriving (Insert -> Insert -> Bool
(Insert -> Insert -> Bool)
-> (Insert -> Insert -> Bool) -> Eq Insert
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Insert -> Insert -> Bool
$c/= :: Insert -> Insert -> Bool
== :: Insert -> Insert -> Bool
$c== :: Insert -> Insert -> Bool
Eq, Int -> Insert -> ShowS
[Insert] -> ShowS
Insert -> String
(Int -> Insert -> ShowS)
-> (Insert -> String) -> ([Insert] -> ShowS) -> Show Insert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Insert] -> ShowS
$cshowList :: [Insert] -> ShowS
show :: Insert -> String
$cshow :: Insert -> String
showsPrec :: Int -> Insert -> ShowS
$cshowsPrec :: Int -> Insert -> ShowS
Show)

showInsert :: Insert -> String
showInsert :: Insert -> String
showInsert i :: Insert
i = let s :: String
s = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Insert -> String
forall a. Show a => a -> String
show Insert
i in case Insert
i of
  Append -> String
s
  _ -> "insert-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

data ChangeSel
  = Add Insert [AddChange]
  | Remove
  | Update String
  | Rename String
  | Variable String

instance Show ChangeSel where
  show :: ChangeSel -> String
show c :: ChangeSel
c = case ChangeSel
c of
    Add i :: Insert
i cs :: [AddChange]
cs -> Insert -> String
showInsert Insert
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ (AddChange -> String) -> [AddChange] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (('\n' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (AddChange -> String) -> AddChange -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddChange -> String
forall a. Show a => a -> String
show) [AddChange]
cs
    Remove -> ""
    Update s :: String
s -> '=' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
    Rename s :: String
s -> String
s
    Variable s :: String
s -> '$' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s

data Change = Change ChangeSel Expr

instance Show Change where
  show :: Change -> String
show (Change c :: ChangeSel
c p :: Expr
p) =
    Expr -> String
forall a. Show a => a -> String
show Expr
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ChangeSel -> String
forall a. Show a => a -> String
show ChangeSel
c

anaXUpdates :: Fail.MonadFail m => String -> m [Change]
anaXUpdates :: String -> m [Change]
anaXUpdates input :: String
input = case String -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc String
input of
    Nothing -> String -> m [Change]
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "cannot parse xupdate file"
    Just e :: Element
e -> Element -> m [Change]
forall (m :: * -> *). MonadFail m => Element -> m [Change]
anaMods Element
e

anaMods :: Fail.MonadFail m => Element -> m [Change]
anaMods :: Element -> m [Change]
anaMods = (Element -> m Change) -> [Element] -> m [Change]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> m Change
forall (m :: * -> *). MonadFail m => Element -> m Change
anaXUpdate ([Element] -> m [Change])
-> (Element -> [Element]) -> Element -> m [Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Element]
elChildren

{- the input element is expected to be one of

 xupdate:insert-before
 xupdate:insert-after
 xupdate:append
 xupdate:remove
 xupdate:update
-}

xupdateS :: String
xupdateS :: String
xupdateS = "xupdate"

updateS :: String
updateS :: String
updateS = "update"

elementS :: String
elementS :: String
elementS = "element"

attributeS :: String
attributeS :: String
attributeS = "attribute"

textS :: String
textS :: String
textS = "text"

appendS :: String
appendS :: String
appendS = "append"

removeS :: String
removeS :: String
removeS = "remove"

selectS :: String
selectS :: String
selectS = "select"

isXUpdateQN :: QName -> Bool
isXUpdateQN :: QName -> Bool
isXUpdateQN = (String -> Maybe String
forall a. a -> Maybe a
Just String
xupdateS Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe String -> Bool) -> (QName -> Maybe String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Maybe String
qPrefix

hasLocalQN :: String -> QName -> Bool
hasLocalQN :: String -> QName -> Bool
hasLocalQN s :: String
s = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName

isElementQN :: QName -> Bool
isElementQN :: QName -> Bool
isElementQN = String -> QName -> Bool
hasLocalQN String
elementS

isAttributeQN :: QName -> Bool
isAttributeQN :: QName -> Bool
isAttributeQN = String -> QName -> Bool
hasLocalQN String
attributeS

isTextQN :: QName -> Bool
isTextQN :: QName -> Bool
isTextQN = String -> QName -> Bool
hasLocalQN String
textS

isAddQN :: QName -> Bool
isAddQN :: QName -> Bool
isAddQN q :: QName
q = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ QName -> String
qName QName
q) ["insert", String
appendS]

isRemoveQN :: QName -> Bool
isRemoveQN :: QName -> Bool
isRemoveQN = String -> QName -> Bool
hasLocalQN String
removeS

-- | extract the non-empty attribute value
getAttrVal :: Fail.MonadFail m => String -> Element -> m String
getAttrVal :: String -> Element -> m String
getAttrVal n :: String
n e :: Element
e = case QName -> Element -> Maybe String
findAttr (String -> QName
unqual String
n) Element
e of
  Nothing -> String -> QName -> m String
forall (m :: * -> *) a. MonadFail m => String -> QName -> m a
failX ("missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ " attribute") (QName -> m String) -> QName -> m String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
e
  Just s :: String
s -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

-- | apply a read operation to the extracted value
readAttrVal :: (Read a, Fail.MonadFail m) => String -> String -> Element -> m a
readAttrVal :: String -> String -> Element -> m a
readAttrVal err :: String
err attr :: String
attr = (m String -> (String -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe a -> m a
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF String
err (Maybe a -> m a) -> (String -> Maybe a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe) (m String -> m a) -> (Element -> m String) -> Element -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> m String
forall (m :: * -> *). MonadFail m => String -> Element -> m String
getAttrVal String
attr

maybeF :: Fail.MonadFail m => String -> Maybe a -> m a
maybeF :: String -> Maybe a -> m a
maybeF err :: String
err = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

getSelectAttr :: Fail.MonadFail m => Element -> m String
getSelectAttr :: Element -> m String
getSelectAttr = String -> Element -> m String
forall (m :: * -> *). MonadFail m => String -> Element -> m String
getAttrVal String
selectS

getNameAttr :: Fail.MonadFail m => Element -> m String
getNameAttr :: Element -> m String
getNameAttr = String -> Element -> m String
forall (m :: * -> *). MonadFail m => String -> Element -> m String
getAttrVal "name"

-- | convert a string to a qualified name by splitting at the colon
str2QName :: String -> QName
str2QName :: String -> QName
str2QName str :: String
str = let (ft :: String
ft, rt :: String
rt) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ':') String
str in
  case String
rt of
    _ : l :: String
l@(_ : _) -> (String -> QName
unqual String
l) { qPrefix :: Maybe String
qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
ft }
    _ -> String -> QName
unqual String
str

-- | extract text and check for no other children
getText :: Fail.MonadFail m => Element -> m String
getText :: Element -> m String
getText e :: Element
e = let s :: String
s = ShowS
trim ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Element -> String
strContent Element
e in
  case Element -> [Element]
elChildren Element
e of
    [] -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
    c :: Element
c : _ -> String -> QName -> m String
forall (m :: * -> *) a. MonadFail m => String -> QName -> m a
failX "unexpected child" (QName -> m String) -> QName -> m String
forall a b. (a -> b) -> a -> b
$ Element -> QName
elName Element
c

getXUpdateText :: Fail.MonadFail m => Element -> m String
getXUpdateText :: Element -> m String
getXUpdateText e :: Element
e = let
    msg :: m a
msg = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "expected single <xupdate:text> element"
    in case Element -> [Element]
elChildren Element
e of
  [] -> Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
e
  [s :: Element
s] -> let
      q :: QName
q = Element -> QName
elName Element
s
      u :: String
u = QName -> String
qName QName
q
      in if QName -> Bool
isXUpdateQN QName
q Bool -> Bool -> Bool
&& String
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "text" then Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
s else m String
forall a. m a
msg
  _ -> m String
forall a. m a
msg

anaXUpdate :: Fail.MonadFail m => Element -> m Change
anaXUpdate :: Element -> m Change
anaXUpdate e :: Element
e = let
  q :: QName
q = Element -> QName
elName Element
e
  u :: String
u = QName -> String
qName QName
q in
  if QName -> Bool
isXUpdateQN QName
q then do
    String
sel <- Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getSelectAttr Element
e
    case String -> Either String Expr
parseExpr String
sel of
      Left _ -> String -> m Change
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m Change) -> String -> m Change
forall a b. (a -> b) -> a -> b
$ "unparsable xpath: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sel
      Right p :: Expr
p -> case () of
        _ | QName -> Bool
isRemoveQN QName
q -> Element -> Change -> m Change
forall (m :: * -> *) a. MonadFail m => Element -> a -> m a
noContent Element
e (Change -> m Change) -> Change -> m Change
forall a b. (a -> b) -> a -> b
$ ChangeSel -> Expr -> Change
Change ChangeSel
Remove Expr
p
          | String -> QName -> Bool
hasLocalQN "variable" QName
q -> do
              String
vn <- Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getNameAttr Element
e
              Element -> Change -> m Change
forall (m :: * -> *) a. MonadFail m => Element -> a -> m a
noContent Element
e (Change -> m Change) -> Change -> m Change
forall a b. (a -> b) -> a -> b
$ ChangeSel -> Expr -> Change
Change (String -> ChangeSel
Variable String
vn) Expr
p
        _ -> case String
-> [(String, String -> ChangeSel)] -> Maybe (String -> ChangeSel)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
u [(String
updateS, String -> ChangeSel
Update), ("rename", String -> ChangeSel
Rename)] of
          Just c :: String -> ChangeSel
c -> do
            String
s <- Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getXUpdateText Element
e
            Change -> m Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> m Change) -> Change -> m Change
forall a b. (a -> b) -> a -> b
$ ChangeSel -> Expr -> Change
Change (String -> ChangeSel
c String
s) Expr
p
          Nothing -> case String -> [(String, Insert)] -> Maybe Insert
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
u ([(String, Insert)] -> Maybe Insert)
-> [(String, Insert)] -> Maybe Insert
forall a b. (a -> b) -> a -> b
$ (Insert -> (String, Insert)) -> [Insert] -> [(String, Insert)]
forall a b. (a -> b) -> [a] -> [b]
map (\ i :: Insert
i -> (Insert -> String
showInsert Insert
i, Insert
i))
                     [Insert
Before, Insert
After, Insert
Append] of
            Just i :: Insert
i -> do
              [AddChange]
cs <- (Element -> m AddChange) -> [Element] -> m [AddChange]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> m AddChange
forall (m :: * -> *). MonadFail m => Element -> m AddChange
addXElem ([Element] -> m [AddChange]) -> [Element] -> m [AddChange]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e
              Change -> m Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> m Change) -> Change -> m Change
forall a b. (a -> b) -> a -> b
$ ChangeSel -> Expr -> Change
Change (Insert -> [AddChange] -> ChangeSel
Add Insert
i [AddChange]
cs) Expr
p
            Nothing -> String -> QName -> m Change
forall (m :: * -> *) a. MonadFail m => String -> QName -> m a
failX "no xupdate modification" QName
q
  else String -> QName -> m Change
forall (m :: * -> *) a. MonadFail m => String -> QName -> m a
failX "no xupdate qualified element" QName
q

-- | partitions additions and ignores comments, pi, and value-of
partitionAddChanges :: [AddChange] -> ([Attr], [Content])
partitionAddChanges :: [AddChange] -> ([Attr], [Content])
partitionAddChanges = (AddChange -> ([Attr], [Content]) -> ([Attr], [Content]))
-> ([Attr], [Content]) -> [AddChange] -> ([Attr], [Content])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ c :: AddChange
c (as :: [Attr]
as, cs :: [Content]
cs) -> case AddChange
c of
      AddAttr a :: Attr
a -> (Attr
a Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: [Attr]
as, [Content]
cs)
      AddElem e :: Element
e -> ([Attr]
as, Element -> Content
Elem Element
e Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
cs)
      AddText s :: String
s -> ([Attr]
as, String -> Content
mkText String
s Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
cs)
      _ -> ([Attr]
as, [Content]
cs)) ([], [])

failX :: Fail.MonadFail m => String -> QName -> m a
failX :: String -> QName -> m a
failX str :: String
str q :: QName
q = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QName -> String
showQName QName
q

-- | check if the element contains no other content
noContent :: Fail.MonadFail m => Element -> a -> m a
noContent :: Element -> a -> m a
noContent e :: Element
e a :: a
a = case Element -> [Content]
elContent Element
e of
  [] -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  c :: Content
c : _ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "unexpected content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
showContent Content
c

addXElem :: Fail.MonadFail m => Element -> m AddChange
addXElem :: Element -> m AddChange
addXElem e :: Element
e = let q :: QName
q = Element -> QName
elName Element
e in
  if QName -> Bool
isXUpdateQN QName
q then case () of
      _ | QName -> Bool
isTextQN QName
q -> (String -> AddChange) -> m String -> m AddChange
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> AddChange
AddText (m String -> m AddChange) -> m String -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
e
        | String -> QName -> Bool
hasLocalQN "comment" QName
q -> (String -> AddChange) -> m String -> m AddChange
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> AddChange
AddComment (m String -> m AddChange) -> m String -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
e
        | String -> QName -> Bool
hasLocalQN String
valueOfS QName
q -> Element -> AddChange -> m AddChange
forall (m :: * -> *) a. MonadFail m => Element -> a -> m a
noContent Element
e AddChange
ValueOf
      _ -> do
        String
n <- Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getNameAttr Element
e
        let qn :: QName
qn = String -> QName
str2QName String
n
        case () of
          _ | QName -> Bool
isAttributeQN QName
q ->
               (String -> AddChange) -> m String -> m AddChange
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Attr -> AddChange
AddAttr (Attr -> AddChange) -> (String -> Attr) -> String -> AddChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String -> Attr
Attr QName
qn) (m String -> m AddChange) -> m String -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
e
            | QName -> Bool
isElementQN QName
q -> do
              [AddChange]
es <- (Element -> m AddChange) -> [Element] -> m [AddChange]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> m AddChange
forall (m :: * -> *). MonadFail m => Element -> m AddChange
addXElem ([Element] -> m [AddChange]) -> [Element] -> m [AddChange]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
e
              let (as :: [Attr]
as, cs :: [Content]
cs) = [AddChange] -> ([Attr], [Content])
partitionAddChanges [AddChange]
es
              AddChange -> m AddChange
forall (m :: * -> *) a. Monad m => a -> m a
return (AddChange -> m AddChange) -> AddChange -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> AddChange
AddElem (Element -> AddChange) -> Element -> AddChange
forall a b. (a -> b) -> a -> b
$ [Attr] -> Element -> Element
add_attrs [Attr]
as (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ QName -> [Content] -> Element
forall t. Node t => QName -> t -> Element
node QName
qn [Content]
cs
            | String -> QName -> Bool
hasLocalQN String
pIS QName
q -> (String -> AddChange) -> m String -> m AddChange
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String -> String -> AddChange
AddPI String
n) (m String -> m AddChange) -> m String -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> m String
forall (m :: * -> *). MonadFail m => Element -> m String
getText Element
e
          _ -> String -> QName -> m AddChange
forall (m :: * -> *) a. MonadFail m => String -> QName -> m a
failX "unknown change" QName
q
  else AddChange -> m AddChange
forall (m :: * -> *) a. Monad m => a -> m a
return (AddChange -> m AddChange) -> AddChange -> m AddChange
forall a b. (a -> b) -> a -> b
$ Element -> AddChange
AddElem Element
e

{-
xupdate:element
xupdate:attribute
xupdate:text

xupdate:element may contain xupdate:attribute elements and further
xupdate:element or xupdate:text elements.
-}

emptyCData :: CData -> Bool
emptyCData :: CData -> Bool
emptyCData = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace (String -> Bool) -> (CData -> String) -> CData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CData -> String
cdData

validContent :: Content -> Bool
validContent :: Content -> Bool
validContent c :: Content
c = case Content
c of
  XML.Text t :: CData
t | CData -> Bool
emptyCData CData
t -> Bool
False
  _ -> Bool
True

cleanUpElem :: Element -> Element
cleanUpElem :: Element -> Element
cleanUpElem e :: Element
e = Element
e
  { elContent :: [Content]
elContent = (Content -> Content) -> [Content] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (\ c :: Content
c -> case Content
c of
      Elem m :: Element
m -> Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element -> Element
cleanUpElem Element
m
      _ -> Content
c) ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
filter Content -> Bool
validContent ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e }