6320N/A{- |

6320N/AModule : $Header$

6320N/ADescription : compute xml diffs

6320N/ACopyright : (c) Christian Maeder, DFKI GmbH 2011

6320N/ALicense : GPLv2 or higher, see LICENSE.txt

6320N/AMaintainer : Christian.Maeder@dfki.de

6320N/AStability : provisional

6320N/APortability : portable

6320N/A

6320N/A-}

6320N/A

6320N/Amodule Common.XmlDiff where

6320N/A

6320N/Aimport Common.ToXml

6320N/Aimport Common.Utils as Utils

6320N/Aimport Common.XPath

6320N/Aimport Common.XUpdate

6320N/A

6320N/Aimport Common.Lib.MapSet (setToMap)

6320N/A

6320N/Aimport Data.Char

6320N/Aimport Data.List

6320N/Aimport qualified Data.Set as Set

6320N/Aimport qualified Data.Map as Map

6320N/A

6320N/Aimport Text.XML.Light as XML

6320N/A

6320N/A{- for elements, whose order does not matter, use the given attribute keys to

6320N/Adetermine their equality. -}

6320N/Atype UnordTags = Map.Map QName (Set.Set QName)

6320N/A

6320N/AxmlDiff :: UnordTags -> [Step] -> Int -> [Content] -> [Content] -> [Change]

6320N/AxmlDiff m pth i old new = let

6320N/A np = addPathNumber (i + 1) pth

6320N/A pe = pathToExpr np

6320N/A in case (old, filter validContent new) of

6320N/A ([], []) -> []

6320N/A ([], ns) ->

6320N/A [Change (Add Append $ map contentToAddChange ns) pe]

6320N/A (os, []) -> map

6320N/A (\ (_, j) -> Change Remove $ pathToExpr $ addPathNumber (i + j) pth)

6320N/A $ Utils.number os

6320N/A (o : os, ns@(n : rt)) -> let

6320N/A restDiffs = xmlDiff m pth (i + 1) os

6320N/A rmO = Change Remove pe : restDiffs ns

6320N/A in if validContent o then

6320N/A case o of

6320N/A Elem e ->

6320N/A let en = elName e

6320N/A atts = elAttribs e

6320N/A cs = elContent e

6320N/A nPath = extendPath en np

6320N/A in case Map.lookup en m of

6320N/A Nothing -> case n of

6320N/A Elem e2 | elName e2 == en ->

6320N/A xmlElemDiff m nPath atts cs e2

6320N/A ++ restDiffs rt

6320N/A _ -> rmO

6320N/A Just ats -> let

6320N/A (mns, rns) = partition (matchElems en $

6320N/A Map.intersection (attrMap atts) $ setToMap ats) ns

6320N/A in case mns of

6320N/A Elem mn : rm -> xmlElemDiff m nPath atts cs mn

6320N/A ++ restDiffs (rm ++ rns)

6320N/A _ -> rmO

6320N/A XML.Text cd -> case n of

6320N/A XML.Text cd2 | trim (cdData cd) == trim nText

6320N/A -> restDiffs rt

6320N/A | otherwise -> Change (Update nText) pe : restDiffs rt

6320N/A where nText = cdData cd2

6320N/A _ -> rmO

6320N/A _ -> rmO

6320N/A else restDiffs ns

6320N/A

6320N/AattrMap :: [Attr] -> Map.Map QName String

6320N/AattrMap = Map.fromList . map (\ a -> (attrKey a, attrVal a))

6320N/A

6320N/AmatchElems :: QName -> Map.Map QName String -> Content -> Bool

6320N/AmatchElems en atts c = case c of

6320N/A Elem e | elName e == en

6320N/A && Map.isSubmapOfBy (==) atts (attrMap $ elAttribs e) -> True

6320N/A _ -> False

6320N/A

6320N/AxmlElemDiff :: UnordTags -> [Step] -> [Attr] -> [Content] -> Element -> [Change]

6320N/AxmlElemDiff m nPath atts cs e2 = xmlAttrDiff nPath atts (elAttribs e2)

6320N/A ++ xmlDiff m nPath 0 cs (elContent e2)

6320N/A

6320N/AxmlAttrDiff :: [Step] -> [Attr] -> [Attr] -> [Change]

6320N/AxmlAttrDiff p a1 a2 = let

6320N/A m1 = attrMap a1

6320N/A m2 = attrMap a2

6320N/A rms = Map.toList $ Map.difference m1 m2

6320N/A ins = Map.toList $ Map.difference m2 m1

6320N/A inter = Map.toList $ Map.filter (uncurry (/=))

6320N/A $ Map.intersectionWith (,) m1 m2

6320N/A addAttrStep a = pathToExpr $ Step Attribute (NameTest $ qName a) [] : p

6320N/A in map (Change Remove . addAttrStep . fst) rms

6320N/A ++ map (\ (a, (_, v)) -> Change (Update v) $ addAttrStep a) inter

6320N/A ++ if null ins then [] else

6320N/A [Change (Add Append $ map (AddAttr . uncurry Attr) ins) $ pathToExpr p]

6320N/A

6320N/ApathToExpr :: [Step] -> Expr

6320N/ApathToExpr = PathExpr Nothing . Path True . reverse

6320N/A

6320N/AextendPath :: QName -> [Step] -> [Step]

6320N/AextendPath q = (Step Child (NameTest $ qName q) [] :)

6320N/A

6320N/A-- steps and predicates are reversed!

6320N/AaddPathNumber :: Int -> [Step] -> [Step]

6320N/AaddPathNumber i stps =

6320N/A let e = PrimExpr Number $ show i

6320N/A in case stps of

6320N/A [] -> []

6320N/A Step a n es : rs -> Step a n (e : es) : rs

6320N/A

6320N/AvalidContent :: Content -> Bool

6320N/AvalidContent c = case c of

6320N/A XML.Text t | all isSpace $ cdData t -> False

6320N/A CRef _ -> False -- we cannot handle this

6320N/A _ -> True

6320N/A

6320N/AcontentToAddChange :: Content -> AddChange

6320N/AcontentToAddChange c = case c of

6320N/A Elem e -> AddElem e

6320N/A XML.Text t -> AddText $ cdData t

6320N/A CRef s -> AddText s

6320N/A

6320N/AmkXQName :: String -> QName

6320N/AmkXQName s = (unqual s) { qPrefix = Just xupdateS }

6320N/A

6320N/AchangeToXml :: Change -> Element

6320N/AchangeToXml (Change csel pth) = let

6320N/A sel = add_attr (mkAttr selectS $ show pth)

6320N/A in case csel of

6320N/A Add _ as -> sel

6320N/A . node (mkXQName appendS) $ map addsToXml as

6320N/A Remove -> sel $ node (mkXQName removeS) ()

6320N/A Update s -> sel $ node (mkXQName updateS) s

6320N/A _ -> error "changeToXml"

6320N/A

6320N/AaddsToXml :: AddChange -> Content

6320N/AaddsToXml a = case a of

6320N/A AddElem e -> Elem e

6320N/A AddAttr (Attr k v) -> Elem

6320N/A . add_attr (mkNameAttr $ qName k) $ node (mkXQName attributeS) v

6320N/A AddText s -> mkText s

6320N/A _ -> error "addsToXml"

6320N/A

6320N/AmkMods :: [Change] -> Element

6320N/AmkMods = node (mkXQName "modifications") . map changeToXml

6320N/A