{- |
Module      :  ./Static/XSimplePath.hs
Description :  Simplification of XPath-Structure
Copyright   :  (c) Simon Ulbricht, DFKI GmbH 2011
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  tekknix@informatik.uni-bremen.de
Stability   :  provisional
Portability :  non-portable (DevGraph)

break down Common.XPath.Expr into a simpler path description and transfer
into cursor movement.
-}

module Static.XSimplePath where

import Common.ToXml (mkText)
import Common.XPath hiding (Text)
import Common.XUpdate
import Common.Utils

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

import Data.List
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set

import Static.DgUtils
import Static.XGraph

import Text.XML.Light hiding (findChild)
import Text.XML.Light.Cursor

data SimplePath = SimplePath { SimplePath -> [Finder]
steps :: [Finder]
                             , SimplePath -> ChangeData
changeData :: ChangeData }

{- | Finder stores predicate list to locate the element and an index, in case
multiple elements comply with the predicate -}
data Finder = FindBy QName [Attr] Int

-- change to be applied at the end of a path plus (maybe) attr-selection
data ChangeData = ChangeData ChangeSel (Maybe String)

-- | convert PathExpr into more simple Finder stucture
exprToSimplePath :: Fail.MonadFail m => Change -> m SimplePath
exprToSimplePath :: Change -> m SimplePath
exprToSimplePath (Change csel :: ChangeSel
csel e :: Expr
e) = case Expr
e of
  PathExpr Nothing (Path True stps :: [Step]
stps) -> do
    (fs :: [Finder]
fs, atS :: Maybe String
atS) <- (([Finder], Maybe String) -> Step -> m ([Finder], Maybe String))
-> ([Finder], Maybe String) -> [Step] -> m ([Finder], Maybe String)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ (fs' :: [Finder]
fs', atS' :: Maybe String
atS') stp :: Step
stp -> case Step
stp of
        Step Child (NameTest n :: String
n) exps :: [Expr]
exps -> do
          Finder
finder <- Finder -> [Expr] -> m Finder
forall (m :: * -> *). MonadFail m => Finder -> [Expr] -> m Finder
mkFinder (QName -> [Attr] -> Int -> Finder
FindBy (String -> QName
unqual String
n) [] 1) [Expr]
exps
          ([Finder], Maybe String) -> m ([Finder], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Finder
finder Finder -> [Finder] -> [Finder]
forall a. a -> [a] -> [a]
: [Finder]
fs', Maybe String
atS')
        -- should be last step only. return path so-far plus attribute selector
        Step Attribute (NameTest n :: String
n) [] -> ([Finder], Maybe String) -> m ([Finder], Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Finder]
fs', String -> Maybe String
forall a. a -> Maybe a
Just String
n)
        _ -> String -> m ([Finder], Maybe String)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ([Finder], Maybe String))
-> String -> m ([Finder], Maybe String)
forall a b. (a -> b) -> a -> b
$ "unexpected step: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Step -> String
forall a. Show a => a -> String
show Step
stp) ([], Maybe String
forall a. Maybe a
Nothing) [Step]
stps
    SimplePath -> m SimplePath
forall (m :: * -> *) a. Monad m => a -> m a
return (SimplePath -> m SimplePath) -> SimplePath -> m SimplePath
forall a b. (a -> b) -> a -> b
$ [Finder] -> ChangeData -> SimplePath
SimplePath ([Finder] -> [Finder]
forall a. [a] -> [a]
reverse [Finder]
fs) (ChangeData -> SimplePath) -> ChangeData -> SimplePath
forall a b. (a -> b) -> a -> b
$ ChangeSel -> Maybe String -> ChangeData
ChangeData ChangeSel
csel Maybe String
atS
  _ -> String -> m SimplePath
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m SimplePath) -> String -> m SimplePath
forall a b. (a -> b) -> a -> b
$ "not a valid path description: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
e

{- | built Finder by recursively following Expr-structure and adding data to
an initially empty Finder along the way -}
mkFinder :: Fail.MonadFail m => Finder -> [Expr] -> m Finder
mkFinder :: Finder -> [Expr] -> m Finder
mkFinder = (Finder -> Expr -> m Finder) -> Finder -> [Expr] -> m Finder
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Finder -> Expr -> m Finder
forall (m :: * -> *). MonadFail m => Finder -> Expr -> m Finder
mkFinderAux

mkFinderAux :: Fail.MonadFail m => Finder -> Expr -> m Finder
mkFinderAux :: Finder -> Expr -> m Finder
mkFinderAux f :: Finder
f@(FindBy qn :: QName
qn attrs :: [Attr]
attrs i :: Int
i) e :: Expr
e = case Expr
e of
    GenExpr True "and" es :: [Expr]
es -> Finder -> [Expr] -> m Finder
forall (m :: * -> *). MonadFail m => Finder -> [Expr] -> m Finder
mkFinder Finder
f [Expr]
es
    GenExpr True "=" es :: [Expr]
es -> do
      Attr
att <- [Expr] -> m Attr
forall (m :: * -> *). MonadFail m => [Expr] -> m Attr
mkAttr [Expr]
es
      Finder -> m Finder
forall (m :: * -> *) a. Monad m => a -> m a
return (Finder -> m Finder) -> Finder -> m Finder
forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> Int -> Finder
FindBy QName
qn (Attr
att Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: [Attr]
attrs) Int
i
    PrimExpr Number i' :: String
i' -> do
      Int
v <- String -> Maybe Int -> m Int
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF ("illegal number: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i') (Maybe Int -> m Int) -> Maybe Int -> m Int
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
i'
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "XPATH number already set differently"
      Finder -> m Finder
forall (m :: * -> *) a. Monad m => a -> m a
return (Finder -> m Finder) -> Finder -> m Finder
forall a b. (a -> b) -> a -> b
$ QName -> [Attr] -> Int -> Finder
FindBy QName
qn [Attr]
attrs Int
v
    _ -> String -> m Finder
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "unexpected (2)"

{- | create attribute to locate the element with from expr-data. Note: this
method will fail for many illegal expr-types! -}
mkAttr :: Fail.MonadFail m => [Expr] -> m Attr
mkAttr :: [Expr] -> m Attr
mkAttr l :: [Expr]
l = case [Expr]
l of
  [ PathExpr Nothing (Path False [Step Attribute (NameTest nm :: String
nm) []])
    , PrimExpr Literal val :: String
val] -> Attr -> m Attr
forall (m :: * -> *) a. Monad m => a -> m a
return (Attr -> m Attr) -> Attr -> m Attr
forall a b. (a -> b) -> a -> b
$ QName -> String -> Attr
Attr (String -> QName
unqual String
nm) String
val
  _ -> String -> m Attr
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m Attr) -> String -> m Attr
forall a b. (a -> b) -> a -> b
$ "XPATH unexpected attr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Expr] -> String
forall a. Show a => a -> String
show [Expr]
l

-- | Describes the minimal change-effect of a .diff upon a DGraph.
data ChangeList = ChangeList
  { ChangeList -> Set NodeName
deleteNodes :: Set.Set NodeName
  , ChangeList -> Set XLink
deleteLinks :: Set.Set XLink -- ^ stores additional information
  , ChangeList -> Map NodeName ChangeAction
changeNodes :: Map.Map NodeName ChangeAction
  , ChangeList -> Map EdgeId ChangeAction
changeLinks :: Map.Map EdgeId ChangeAction } deriving (ChangeList -> ChangeList -> Bool
(ChangeList -> ChangeList -> Bool)
-> (ChangeList -> ChangeList -> Bool) -> Eq ChangeList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeList -> ChangeList -> Bool
$c/= :: ChangeList -> ChangeList -> Bool
== :: ChangeList -> ChangeList -> Bool
$c== :: ChangeList -> ChangeList -> Bool
Eq, Int -> ChangeList -> String -> String
[ChangeList] -> String -> String
ChangeList -> String
(Int -> ChangeList -> String -> String)
-> (ChangeList -> String)
-> ([ChangeList] -> String -> String)
-> Show ChangeList
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChangeList] -> String -> String
$cshowList :: [ChangeList] -> String -> String
show :: ChangeList -> String
$cshow :: ChangeList -> String
showsPrec :: Int -> ChangeList -> String -> String
$cshowsPrec :: Int -> ChangeList -> String -> String
Show)

data ChangeAction = MkUpdate NodeMod | MkInsert deriving (ChangeAction -> ChangeAction -> Bool
(ChangeAction -> ChangeAction -> Bool)
-> (ChangeAction -> ChangeAction -> Bool) -> Eq ChangeAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeAction -> ChangeAction -> Bool
$c/= :: ChangeAction -> ChangeAction -> Bool
== :: ChangeAction -> ChangeAction -> Bool
$c== :: ChangeAction -> ChangeAction -> Bool
Eq, Int -> ChangeAction -> String -> String
[ChangeAction] -> String -> String
ChangeAction -> String
(Int -> ChangeAction -> String -> String)
-> (ChangeAction -> String)
-> ([ChangeAction] -> String -> String)
-> Show ChangeAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChangeAction] -> String -> String
$cshowList :: [ChangeAction] -> String -> String
show :: ChangeAction -> String
$cshow :: ChangeAction -> String
showsPrec :: Int -> ChangeAction -> String -> String
$cshowsPrec :: Int -> ChangeAction -> String -> String
Show)

updateNodeChange :: ChangeAction -> NodeName -> ChangeList -> ChangeList
updateNodeChange :: ChangeAction -> NodeName -> ChangeList -> ChangeList
updateNodeChange chA :: ChangeAction
chA nm :: NodeName
nm chL :: ChangeList
chL = ChangeList
chL { changeNodes :: Map NodeName ChangeAction
changeNodes =
  (ChangeAction -> ChangeAction -> ChangeAction)
-> NodeName
-> ChangeAction
-> Map NodeName ChangeAction
-> Map NodeName ChangeAction
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ChangeAction -> ChangeAction -> ChangeAction
mergeChA NodeName
nm ChangeAction
chA (Map NodeName ChangeAction -> Map NodeName ChangeAction)
-> Map NodeName ChangeAction -> Map NodeName ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map NodeName ChangeAction
changeNodes ChangeList
chL }

retrieveNodeChange :: NodeName -> ChangeList
                   -> Maybe (ChangeAction, ChangeList)
retrieveNodeChange :: NodeName -> ChangeList -> Maybe (ChangeAction, ChangeList)
retrieveNodeChange nm :: NodeName
nm chL :: ChangeList
chL = do
  ChangeAction
nmod <- NodeName -> Map NodeName ChangeAction -> Maybe ChangeAction
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeName
nm (Map NodeName ChangeAction -> Maybe ChangeAction)
-> Map NodeName ChangeAction -> Maybe ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map NodeName ChangeAction
changeNodes ChangeList
chL
  (ChangeAction, ChangeList) -> Maybe (ChangeAction, ChangeList)
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeAction
nmod, ChangeList
chL { changeNodes :: Map NodeName ChangeAction
changeNodes = NodeName -> Map NodeName ChangeAction -> Map NodeName ChangeAction
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NodeName
nm (Map NodeName ChangeAction -> Map NodeName ChangeAction)
-> Map NodeName ChangeAction -> Map NodeName ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map NodeName ChangeAction
changeNodes ChangeList
chL })

updateLinkChange :: ChangeAction -> EdgeId -> ChangeList -> ChangeList
updateLinkChange :: ChangeAction -> EdgeId -> ChangeList -> ChangeList
updateLinkChange chA :: ChangeAction
chA ei :: EdgeId
ei chL :: ChangeList
chL = ChangeList
chL { changeLinks :: Map EdgeId ChangeAction
changeLinks =
  (ChangeAction -> ChangeAction -> ChangeAction)
-> EdgeId
-> ChangeAction
-> Map EdgeId ChangeAction
-> Map EdgeId ChangeAction
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ChangeAction -> ChangeAction -> ChangeAction
mergeChA EdgeId
ei ChangeAction
chA (Map EdgeId ChangeAction -> Map EdgeId ChangeAction)
-> Map EdgeId ChangeAction -> Map EdgeId ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map EdgeId ChangeAction
changeLinks ChangeList
chL }

retrieveLinkChange :: EdgeId -> ChangeList -> Maybe (ChangeAction, ChangeList)
retrieveLinkChange :: EdgeId -> ChangeList -> Maybe (ChangeAction, ChangeList)
retrieveLinkChange ei :: EdgeId
ei chL :: ChangeList
chL = do
  ChangeAction
nmod <- EdgeId -> Map EdgeId ChangeAction -> Maybe ChangeAction
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EdgeId
ei (Map EdgeId ChangeAction -> Maybe ChangeAction)
-> Map EdgeId ChangeAction -> Maybe ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map EdgeId ChangeAction
changeLinks ChangeList
chL
  (ChangeAction, ChangeList) -> Maybe (ChangeAction, ChangeList)
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeAction
nmod, ChangeList
chL { changeLinks :: Map EdgeId ChangeAction
changeLinks = EdgeId -> Map EdgeId ChangeAction -> Map EdgeId ChangeAction
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete EdgeId
ei (Map EdgeId ChangeAction -> Map EdgeId ChangeAction)
-> Map EdgeId ChangeAction -> Map EdgeId ChangeAction
forall a b. (a -> b) -> a -> b
$ ChangeList -> Map EdgeId ChangeAction
changeLinks ChangeList
chL })

mergeChA :: ChangeAction -> ChangeAction -> ChangeAction
mergeChA :: ChangeAction -> ChangeAction -> ChangeAction
mergeChA (MkUpdate md1 :: NodeMod
md1) (MkUpdate md2 :: NodeMod
md2) = NodeMod -> ChangeAction
MkUpdate (NodeMod -> ChangeAction) -> NodeMod -> ChangeAction
forall a b. (a -> b) -> a -> b
$ NodeMod -> NodeMod -> NodeMod
mergeNodeMod NodeMod
md1 NodeMod
md2
mergeChA _ _ = ChangeAction
MkInsert

emptyChangeList :: ChangeList
emptyChangeList :: ChangeList
emptyChangeList =
  Set NodeName
-> Set XLink
-> Map NodeName ChangeAction
-> Map EdgeId ChangeAction
-> ChangeList
ChangeList Set NodeName
forall a. Set a
Set.empty Set XLink
forall a. Set a
Set.empty Map NodeName ChangeAction
forall k a. Map k a
Map.empty Map EdgeId ChangeAction
forall k a. Map k a
Map.empty

-- | iterate Xml in multiple directions
data Direction = Vertical
               | Horizontal
               | TopElem

changeXml :: Fail.MonadFail m => Element -> String -> m (Element, ChangeList)
changeXml :: Element -> String -> m (Element, ChangeList)
changeXml el :: Element
el input :: String
input = case String -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc String
input of
    Nothing -> String -> m (Element, ChangeList)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "changeXml: cannot parse xupdate file"
    Just diff :: Element
diff -> Element -> Element -> m (Element, ChangeList)
forall (m :: * -> *).
MonadFail m =>
Element -> Element -> m (Element, ChangeList)
changeXmlMod (Element -> Element
cleanUpElem Element
el) Element
diff

{- | apply a diff to an xml-document. returns the result xml and a list of
changes that affect the original DGraph -}
changeXmlMod :: Fail.MonadFail m => Element -> Element -> m (Element, ChangeList)
changeXmlMod :: Element -> Element -> m (Element, ChangeList)
changeXmlMod el :: Element
el diff :: Element
diff = let cr :: Cursor
cr = Element -> Cursor
fromElement Element
el in do
  [Change]
cs <- Element -> m [Change]
forall (m :: * -> *). MonadFail m => Element -> m [Change]
anaMods Element
diff
  [SimplePath]
pths <- (Change -> m SimplePath) -> [Change] -> m [SimplePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Change -> m SimplePath
forall (m :: * -> *). MonadFail m => Change -> m SimplePath
exprToSimplePath [Change]
cs
  (cr' :: Cursor
cr', chL :: ChangeList
chL) <- Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
forall (m :: * -> *).
MonadFail m =>
Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
iterateXml Direction
TopElem [SimplePath]
pths Cursor
cr ChangeList
emptyChangeList
  case Cursor -> Content
current Cursor
cr' of
     Elem e :: Element
e -> (Element, ChangeList) -> m (Element, ChangeList)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
e, ChangeList
chL)
     _ -> String -> m (Element, ChangeList)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "unexpected content within top element"

{- | follow the Xml-structure and apply Changes. The Change is only applied
after the recursive call to simulate parallel application. Resulting DgChanges
are collected along the way. -}
iterateXml :: Fail.MonadFail m => Direction -> [SimplePath] -> Cursor
           -> ChangeList -> m (Cursor, ChangeList)
iterateXml :: Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
iterateXml _ [] cr :: Cursor
cr chL :: ChangeList
chL = (Cursor, ChangeList) -> m (Cursor, ChangeList)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursor
cr, ChangeList
chL)
iterateXml dir :: Direction
dir pths :: [SimplePath]
pths cr0 :: Cursor
cr0 chL :: ChangeList
chL = do
  -- initially, the cursor movement has to be applied
  Cursor
cr1 <- Direction -> Cursor -> m Cursor
forall (m :: * -> *).
MonadFail m =>
Direction -> Cursor -> m Cursor
moveDown Direction
dir Cursor
cr0
  (curChg :: [ChangeData]
curChg, toRight :: [SimplePath]
toRight, toChildren :: [SimplePath]
toChildren) <- Cursor
-> [SimplePath] -> m ([ChangeData], [SimplePath], [SimplePath])
forall (m :: * -> *).
MonadFail m =>
Cursor
-> [SimplePath] -> m ([ChangeData], [SimplePath], [SimplePath])
propagatePaths Cursor
cr1 [SimplePath]
pths
  (cr2 :: Cursor
cr2, chL' :: ChangeList
chL') <- Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
forall (m :: * -> *).
MonadFail m =>
Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
iterateXml Direction
Vertical [SimplePath]
toChildren Cursor
cr1 ChangeList
chL
  (cr3 :: Cursor
cr3, chL'' :: ChangeList
chL'') <- Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
forall (m :: * -> *).
MonadFail m =>
Direction
-> [SimplePath] -> Cursor -> ChangeList -> m (Cursor, ChangeList)
iterateXml Direction
Horizontal [SimplePath]
toRight Cursor
cr2 ChangeList
chL'
  -- after the call to children and rights, the current cursor is modified
  [ChangeData]
-> Cursor -> Direction -> ChangeList -> m (Cursor, ChangeList)
forall (m :: * -> *).
MonadFail m =>
[ChangeData]
-> Cursor -> Direction -> ChangeList -> m (Cursor, ChangeList)
applyChanges [ChangeData]
curChg Cursor
cr3 Direction
dir ChangeList
chL''

-- Remove-changes must be treated differently
data ChangeRes = ChangeCr Cursor
               | RemoveCr

{- | a list of Changes is applied to a current Cursor. The resulting DgUpdates
are added to the ChangeList. -}
applyChanges :: Fail.MonadFail m => [ChangeData] -> Cursor -> Direction -> ChangeList
             -> m (Cursor, ChangeList)
applyChanges :: [ChangeData]
-> Cursor -> Direction -> ChangeList -> m (Cursor, ChangeList)
applyChanges changes :: [ChangeData]
changes cr :: Cursor
cr dir :: Direction
dir chL :: ChangeList
chL = do
  -- to know the resulting DgUpdates, the Changes need not to be applied
  ChangeList
chL' <- (ChangeList -> ChangeData -> m ChangeList)
-> ChangeList -> [ChangeData] -> m ChangeList
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Cursor -> ChangeList -> ChangeData -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
Cursor -> ChangeList -> ChangeData -> m ChangeList
updateChangeList Cursor
cr) ChangeList
chL [ChangeData]
changes
  -- because cursor position will change, certain addChanges are appended
  let (chAppend :: [ChangeData]
chAppend, chNow :: [ChangeData]
chNow) = (ChangeData -> Bool)
-> [ChangeData] -> ([ChangeData], [ChangeData])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ cd :: ChangeData
cd -> case ChangeData
cd of
          ChangeData (Add Before _) _ -> Bool
True
          _ -> Bool
False ) [ChangeData]
changes
  ChangeRes
cres1 <- (ChangeRes -> ChangeData -> m ChangeRes)
-> ChangeRes -> [ChangeData] -> m ChangeRes
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ChangeRes -> ChangeData -> m ChangeRes
forall (m :: * -> *).
MonadFail m =>
ChangeRes -> ChangeData -> m ChangeRes
applyChange (Cursor -> ChangeRes
ChangeCr Cursor
cr) [ChangeData]
chNow
  ChangeRes
cres2 <- (ChangeRes -> ChangeData -> m ChangeRes)
-> ChangeRes -> [ChangeData] -> m ChangeRes
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ChangeRes -> ChangeData -> m ChangeRes
forall (m :: * -> *).
MonadFail m =>
ChangeRes -> ChangeData -> m ChangeRes
applyChange ChangeRes
cres1 [ChangeData]
chAppend
  -- after application of the changes, the Cursor movement takes place
  Cursor
cr' <- case ChangeRes
cres2 of
      ChangeCr cr' :: Cursor
cr' -> Direction -> Cursor -> m Cursor
forall (m :: * -> *).
MonadFail m =>
Direction -> Cursor -> m Cursor
moveUp Direction
dir Cursor
cr'
      RemoveCr -> case Direction
dir of
        Vertical -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "missing parent (Remove)" (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ Cursor -> Maybe Cursor
removeGoUp Cursor
cr
        Horizontal -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "missing left sibling (Remove)"
          (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> Bool) -> Cursor -> Maybe Cursor
removeFindLeft Cursor -> Bool
isElem Cursor
cr
        TopElem -> String -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "Top Element cannot be removed!"
  (Cursor, ChangeList) -> m (Cursor, ChangeList)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursor
cr', ChangeList
chL')

removeFindLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
removeFindLeft :: (Cursor -> Bool) -> Cursor -> Maybe Cursor
removeFindLeft p :: Cursor -> Bool
p = Maybe Cursor
-> (Cursor -> Maybe Cursor) -> Maybe Cursor -> Maybe Cursor
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Cursor
forall a. Maybe a
Nothing (\ cr :: Cursor
cr ->
  if Cursor -> Bool
p Cursor
cr then Cursor -> Maybe Cursor
forall a. a -> Maybe a
Just Cursor
cr else (Cursor -> Bool) -> Cursor -> Maybe Cursor
findLeft Cursor -> Bool
p Cursor
cr) (Maybe Cursor -> Maybe Cursor)
-> (Cursor -> Maybe Cursor) -> Cursor -> Maybe Cursor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Maybe Cursor
removeGoLeft

moveDown :: Fail.MonadFail m => Direction -> Cursor -> m Cursor
moveDown :: Direction -> Cursor -> m Cursor
moveDown dir :: Direction
dir cr :: Cursor
cr = case Direction
dir of
    Vertical -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "no more children" (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> Bool) -> Cursor -> Maybe Cursor
findChild Cursor -> Bool
isElem Cursor
cr
    Horizontal -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "no more right siblings" (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> Bool) -> Cursor -> Maybe Cursor
findRight Cursor -> Bool
isElem Cursor
cr
    TopElem -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
cr

moveUp :: Fail.MonadFail m => Direction -> Cursor -> m Cursor
moveUp :: Direction -> Cursor -> m Cursor
moveUp dir :: Direction
dir cr :: Cursor
cr = case Direction
dir of
    Vertical -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "missing parent" (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ Cursor -> Maybe Cursor
parent Cursor
cr
    Horizontal -> String -> Maybe Cursor -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> Maybe a -> m a
maybeF "missing left sibling" (Maybe Cursor -> m Cursor) -> Maybe Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ (Cursor -> Bool) -> Cursor -> Maybe Cursor
findLeft Cursor -> Bool
isElem Cursor
cr
    TopElem -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
cr

-- help function for movement; filter out (Text CData)-Contents
isElem :: Cursor -> Bool
isElem :: Cursor -> Bool
isElem cr :: Cursor
cr = case Cursor -> Content
current Cursor
cr of
  Elem _ -> Bool
True
  _ -> Bool
False

-- | sequentially built up resulting Cursor one Change at a time
applyChange :: Fail.MonadFail m => ChangeRes -> ChangeData -> m ChangeRes
applyChange :: ChangeRes -> ChangeData -> m ChangeRes
applyChange (ChangeRes
RemoveCr) _ = ChangeRes -> m ChangeRes
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeRes
RemoveCr
applyChange (ChangeCr cr :: Cursor
cr) (ChangeData csel :: ChangeSel
csel attrSel :: Maybe String
attrSel) = case (ChangeSel
csel, Maybe String
attrSel) of
  -- Case#1: full element removal
  (Remove, Nothing) -> ChangeRes -> m ChangeRes
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeRes
RemoveCr
  -- Case#2: attribute removal
  (Remove, Just atS :: String
atS) -> Maybe String -> Cursor -> String -> m ChangeRes
forall (m :: * -> *).
MonadFail m =>
Maybe String -> Cursor -> String -> m ChangeRes
removeOrChangeAttr Maybe String
forall a. Maybe a
Nothing Cursor
cr String
atS
  -- Case#3: addChanges, either attr-/ or element-insertion
  (Add pos :: Insert
pos addCs :: [AddChange]
addCs, _) -> (Cursor -> ChangeRes) -> m Cursor -> m ChangeRes
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Cursor -> ChangeRes
ChangeCr (m Cursor -> m ChangeRes) -> m Cursor -> m ChangeRes
forall a b. (a -> b) -> a -> b
$ (Cursor -> AddChange -> m Cursor)
-> Cursor -> [AddChange] -> m Cursor
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Insert -> Cursor -> AddChange -> m Cursor
forall (m :: * -> *).
MonadFail m =>
Insert -> Cursor -> AddChange -> m Cursor
applyAddOp Insert
pos) Cursor
cr [AddChange]
addCs
  -- Case#4: set attribute value
  (Update s :: String
s, Just atS :: String
atS) -> Maybe String -> Cursor -> String -> m ChangeRes
forall (m :: * -> *).
MonadFail m =>
Maybe String -> Cursor -> String -> m ChangeRes
removeOrChangeAttr (String -> Maybe String
forall a. a -> Maybe a
Just String
s) Cursor
cr String
atS
  -- Case#5: update text-content
  (Update s :: String
s, Nothing) -> String -> Cursor -> m ChangeRes
forall (m :: * -> *).
MonadFail m =>
String -> Cursor -> m ChangeRes
changeText String
s Cursor
cr
  -- OTHER CASES ARE NOT IMPLEMENTED!
  _ -> String -> m ChangeRes
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ChangeRes) -> String -> m ChangeRes
forall a b. (a -> b) -> a -> b
$ "no implementation for :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ChangeSel -> String
forall a. Show a => a -> String
show ChangeSel
csel

-- | change the text-content of an element
changeText :: Fail.MonadFail m => String -> Cursor -> m ChangeRes
changeText :: String -> Cursor -> m ChangeRes
changeText t :: String
t cr :: Cursor
cr = case Cursor -> Content
current Cursor
cr of
  Elem e :: Element
e | [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Element] -> Bool) -> [Element] -> Bool
forall a b. (a -> b) -> a -> b
$ [Content] -> [Element]
onlyElems ([Content] -> [Element]) -> [Content] -> [Element]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e -> ChangeRes -> m ChangeRes
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeRes -> m ChangeRes) -> ChangeRes -> m ChangeRes
forall a b. (a -> b) -> a -> b
$ Cursor -> ChangeRes
ChangeCr Cursor
cr
    { current :: Content
current = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element
e
      { elContent :: [Content]
elContent = [String -> Content
mkText String
t] }}
  _ -> String -> m ChangeRes
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "current cursor is no element with text only"

-- | change or remove one of the elements attributes
removeOrChangeAttr :: Fail.MonadFail m => Maybe String -- ^ optional update value
  -> Cursor -> String -- ^ attribute key
  -> m ChangeRes
removeOrChangeAttr :: Maybe String -> Cursor -> String -> m ChangeRes
removeOrChangeAttr csel :: Maybe String
csel cr :: Cursor
cr atS :: String
atS =
  let failMsg :: String -> m a
failMsg msg :: String
msg = 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
$ "removeOrChangeAttr '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
atS String -> String -> String
forall a. [a] -> [a] -> [a]
++ "': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
  in case Cursor -> Content
current Cursor
cr of
  Elem e :: Element
e ->
    let (match :: [Attr]
match, restAts :: [Attr]
restAts) =
          (Attr -> Bool) -> [Attr] -> ([Attr], [Attr])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
atS) (String -> Bool) -> (Attr -> String) -> Attr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qName (QName -> String) -> (Attr -> QName) -> Attr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attr -> QName
attrKey) ([Attr] -> ([Attr], [Attr])) -> [Attr] -> ([Attr], [Attr])
forall a b. (a -> b) -> a -> b
$ Element -> [Attr]
elAttribs Element
e
    in case [Attr]
match of
      [at :: Attr
at] -> ChangeRes -> m ChangeRes
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeRes -> m ChangeRes) -> ChangeRes -> m ChangeRes
forall a b. (a -> b) -> a -> b
$ Cursor -> ChangeRes
ChangeCr Cursor
cr { current :: Content
current = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element
e
          { elAttribs :: [Attr]
elAttribs = [Attr] -> (String -> [Attr]) -> Maybe String -> [Attr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ s :: String
s -> [Attr
at { attrVal :: String
attrVal = String
s }]) Maybe String
csel
              [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++ [Attr]
restAts } }
      [] -> String -> m ChangeRes
forall (m :: * -> *) a. MonadFail m => String -> m a
failMsg "attribute not found"
      _ -> String -> m ChangeRes
forall (m :: * -> *) a. MonadFail m => String -> m a
failMsg "ambiguous attribute"
  _ -> String -> m ChangeRes
forall (m :: * -> *) a. MonadFail m => String -> m a
failMsg "current cursor is no element"

-- | add new elements or attributes
applyAddOp :: Fail.MonadFail m => Insert -> Cursor -> AddChange -> m Cursor
applyAddOp :: Insert -> Cursor -> AddChange -> m Cursor
applyAddOp pos :: Insert
pos cr :: Cursor
cr addCh :: AddChange
addCh = case (Insert
pos, AddChange
addCh) of
        (Before, AddElem e :: Element
e) -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursor -> m Cursor) -> Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ Content -> Cursor -> Cursor
insertGoLeft (Element -> Content
Elem Element
e) Cursor
cr
        (After, AddElem e :: Element
e) -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursor -> m Cursor) -> Cursor -> m Cursor
forall a b. (a -> b) -> a -> b
$ Content -> Cursor -> Cursor
insertRight (Element -> Content
Elem Element
e) Cursor
cr
        (Append, AddElem e :: Element
e) -> case Cursor -> Content
current Cursor
cr of
            Elem e' :: Element
e' -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
cr { current :: Content
current = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element
e' {
                         elContent :: [Content]
elContent = Element -> [Content]
elContent Element
e' [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
e] } }
            _ -> String -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "applyAddOp: unexpected content(1)"
        (Append, AddAttr at :: Attr
at) -> case Cursor -> Content
current Cursor
cr of
            Elem e :: Element
e -> Cursor -> m Cursor
forall (m :: * -> *) a. Monad m => a -> m a
return Cursor
cr { current :: Content
current = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Attr -> Element -> Element
add_attr Attr
at Element
e }
            _ -> String -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "applyAddOp: unexpected content(2)"
        _ -> String -> m Cursor
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "applyAddOp: illegal addChange-data!"

{- | given the remaining PathElements, determine for which Paths the current
Cursor is relevant (else -> toRight) and then gather from those the changes
regarding the current object (PathEnds; else -> toChildren). -}
propagatePaths :: Fail.MonadFail m => Cursor -> [SimplePath]
               -> m ([ChangeData], [SimplePath], [SimplePath])
propagatePaths :: Cursor
-> [SimplePath] -> m ([ChangeData], [SimplePath], [SimplePath])
propagatePaths cr :: Cursor
cr pths :: [SimplePath]
pths = case Cursor -> Content
current Cursor
cr of
  Elem e :: Element
e -> let
    checkAttr :: Attr -> Bool
checkAttr at :: Attr
at = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Attr -> String
attrVal Attr
at) (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe String
findAttr (Attr -> QName
attrKey Attr
at) Element
e
    maybeDecrease :: SimplePath -> SimplePath
maybeDecrease sp :: SimplePath
sp = case SimplePath -> [Finder]
steps SimplePath
sp of
          FindBy nm :: QName
nm atL :: [Attr]
atL i :: Int
i : r :: [Finder]
r | Element -> QName
elName Element
e QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
nm Bool -> Bool -> Bool
&& (Attr -> Bool) -> [Attr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Attr -> Bool
checkAttr [Attr]
atL
              -> SimplePath
sp { steps :: [Finder]
steps = QName -> [Attr] -> Int -> Finder
FindBy QName
nm [Attr]
atL (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Finder -> [Finder] -> [Finder]
forall a. a -> [a] -> [a]
: [Finder]
r }
          _ -> SimplePath
sp
    (cur :: [SimplePath]
cur, toRight :: [SimplePath]
toRight) = (SimplePath -> Bool)
-> [SimplePath] -> ([SimplePath], [SimplePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition SimplePath -> Bool
isAtZero ([SimplePath] -> ([SimplePath], [SimplePath]))
-> [SimplePath] -> ([SimplePath], [SimplePath])
forall a b. (a -> b) -> a -> b
$ (SimplePath -> SimplePath) -> [SimplePath] -> [SimplePath]
forall a b. (a -> b) -> [a] -> [b]
map SimplePath -> SimplePath
maybeDecrease [SimplePath]
pths
            where isAtZero :: SimplePath -> Bool
isAtZero (SimplePath (FindBy _ _ 0 : _) _) = Bool
True
                  isAtZero _ = Bool
False
    in do
      -- crop current heads and extract immediate changes
      (changes :: [ChangeData]
changes, toChildren :: [SimplePath]
toChildren) <- (([ChangeData], [SimplePath])
 -> SimplePath -> m ([ChangeData], [SimplePath]))
-> ([ChangeData], [SimplePath])
-> [SimplePath]
-> m ([ChangeData], [SimplePath])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ (r1 :: [ChangeData]
r1, r2 :: [SimplePath]
r2) sp :: SimplePath
sp -> case SimplePath
sp of
          SimplePath [_] cd :: ChangeData
cd -> ([ChangeData], [SimplePath]) -> m ([ChangeData], [SimplePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeData
cd ChangeData -> [ChangeData] -> [ChangeData]
forall a. a -> [a] -> [a]
: [ChangeData]
r1, [SimplePath]
r2)
          SimplePath (_ : r :: [Finder]
r) cd :: ChangeData
cd -> ([ChangeData], [SimplePath]) -> m ([ChangeData], [SimplePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([ChangeData]
r1, [Finder] -> ChangeData -> SimplePath
SimplePath [Finder]
r ChangeData
cd SimplePath -> [SimplePath] -> [SimplePath]
forall a. a -> [a] -> [a]
: [SimplePath]
r2)
          _ -> String -> m ([ChangeData], [SimplePath])
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail "propagatePaths: unexpected PathEnd!") ([], []) [SimplePath]
cur
      ([ChangeData], [SimplePath], [SimplePath])
-> m ([ChangeData], [SimplePath], [SimplePath])
forall (m :: * -> *) a. Monad m => a -> m a
return ([ChangeData]
changes, [SimplePath]
toRight, [SimplePath]
toChildren)
  c :: Content
c -> String -> m ([ChangeData], [SimplePath], [SimplePath])
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m ([ChangeData], [SimplePath], [SimplePath]))
-> String -> m ([ChangeData], [SimplePath], [SimplePath])
forall a b. (a -> b) -> a -> b
$ "propagatePaths: unexpected Cursor Content: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
c

{- | determine the required DgUpdates from a Change operation.
NOTE: some changes (like most attribute changes) will be ignored! -}
updateChangeList :: Fail.MonadFail m => Cursor -> ChangeList -> ChangeData
                 -> m ChangeList
updateChangeList :: Cursor -> ChangeList -> ChangeData -> m ChangeList
updateChangeList cr :: Cursor
cr chL :: ChangeList
chL (ChangeData csel :: ChangeSel
csel atS :: Maybe String
atS) = case ChangeSel
csel of
  Add _ addCs :: [AddChange]
addCs -> (ChangeList -> AddChange -> m ChangeList)
-> ChangeList -> [AddChange] -> m ChangeList
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Cursor -> ChangeList -> AddChange -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
Cursor -> ChangeList -> AddChange -> m ChangeList
mkAddChange Cursor
cr) ChangeList
chL [AddChange]
addCs
  Remove | Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
atS -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
ChangeList -> Cursor -> m ChangeList
mkRemoveChange ChangeList
chL Cursor
cr
  Update _ | Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
atS -> case Cursor -> Content
current Cursor
cr of
    Elem e :: Element
e | Element -> Bool
isSentenceType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
senMod ChangeList
chL Cursor
cr
    Elem e :: Element
e | Element -> Bool
isSymbolType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
symMod ChangeList
chL Cursor
cr
    {- TODO: cases above have been considered and tested.
    Cases below will only receive update-information for reasons of fault-
    resistancy. They might be refined or even removed! -}
    _ -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
symMod ChangeList
chL Cursor
cr
  _ -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
symMod ChangeList
chL Cursor
cr

{- | split a list of AddChanges and write all Node and Link insertions into the
ChangeList. -}
mkAddChange :: Fail.MonadFail m => Cursor -> ChangeList -> AddChange -> m ChangeList
mkAddChange :: Cursor -> ChangeList -> AddChange -> m ChangeList
mkAddChange cr :: Cursor
cr chL :: ChangeList
chL addCh :: AddChange
addCh = case AddChange
addCh of
    AddElem e :: Element
e | Element -> Bool
isDgNodeElem Element
e -> do
      NodeName
nm <- Element -> m NodeName
forall (m :: * -> *). MonadFail m => Element -> m NodeName
extractNodeName Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeList -> m ChangeList) -> ChangeList -> m ChangeList
forall a b. (a -> b) -> a -> b
$ ChangeAction -> NodeName -> ChangeList -> ChangeList
updateNodeChange ChangeAction
MkInsert NodeName
nm ChangeList
chL
    AddElem e :: Element
e | Element -> Bool
isDgLinkElem Element
e -> do
      EdgeId
ei <- Element -> m EdgeId
forall (m :: * -> *). MonadFail m => Element -> m EdgeId
extractEdgeId Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeList -> m ChangeList) -> ChangeList -> m ChangeList
forall a b. (a -> b) -> a -> b
$ ChangeAction -> EdgeId -> ChangeList -> ChangeList
updateLinkChange ChangeAction
MkInsert EdgeId
ei ChangeList
chL
    AddElem e :: Element
e | Element -> Bool
isSymbolType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
addSymMod ChangeList
chL Cursor
cr
    AddElem e :: Element
e | Element -> Bool
isSentenceType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
addSenMod ChangeList
chL Cursor
cr
    -- other cases as the above will be ignored
    _ -> ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeList
chL

-- | go upwards until an updatable element is found
mkUpdateChange :: Fail.MonadFail m => NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange :: NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange nmod :: NodeMod
nmod chL :: ChangeList
chL cr :: Cursor
cr = case Cursor -> Content
current Cursor
cr of
  Elem e :: Element
e | Element -> Bool
isDgNodeElem Element
e -> do
      NodeName
nm <- Element -> m NodeName
forall (m :: * -> *). MonadFail m => Element -> m NodeName
extractNodeName Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeList -> m ChangeList) -> ChangeList -> m ChangeList
forall a b. (a -> b) -> a -> b
$ ChangeAction -> NodeName -> ChangeList -> ChangeList
updateNodeChange (NodeMod -> ChangeAction
MkUpdate NodeMod
nmod) NodeName
nm ChangeList
chL
  Elem e :: Element
e | Element -> Bool
isDgLinkElem Element
e -> do
      EdgeId
ei <- Element -> m EdgeId
forall (m :: * -> *). MonadFail m => Element -> m EdgeId
extractEdgeId Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return (ChangeList -> m ChangeList) -> ChangeList -> m ChangeList
forall a b. (a -> b) -> a -> b
$ ChangeAction -> EdgeId -> ChangeList -> ChangeList
updateLinkChange (NodeMod -> ChangeAction
MkUpdate NodeMod
nmod) EdgeId
ei ChangeList
chL
  -- if no updateable element is found, the change is ignored
  _ -> m ChangeList
-> (Cursor -> m ChangeList) -> Maybe Cursor -> m ChangeList
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeList
chL) (NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
nmod ChangeList
chL) (Maybe Cursor -> m ChangeList) -> Maybe Cursor -> m ChangeList
forall a b. (a -> b) -> a -> b
$ Cursor -> Maybe Cursor
parent Cursor
cr

{- | if node or link is removed, add this to ChangeList. otherwise create
update-change -}
mkRemoveChange :: Fail.MonadFail m => ChangeList -> Cursor -> m ChangeList
mkRemoveChange :: ChangeList -> Cursor -> m ChangeList
mkRemoveChange chL :: ChangeList
chL cr :: Cursor
cr = case Cursor -> Content
current Cursor
cr of
  Elem e :: Element
e | Element -> Bool
isDgNodeElem Element
e -> do
      NodeName
nm <- Element -> m NodeName
forall (m :: * -> *). MonadFail m => Element -> m NodeName
extractNodeName Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeList
chL { deleteNodes :: Set NodeName
deleteNodes = NodeName -> Set NodeName -> Set NodeName
forall a. Ord a => a -> Set a -> Set a
Set.insert NodeName
nm (Set NodeName -> Set NodeName) -> Set NodeName -> Set NodeName
forall a b. (a -> b) -> a -> b
$ ChangeList -> Set NodeName
deleteNodes ChangeList
chL }
  Elem e :: Element
e | Element -> Bool
isDgLinkElem Element
e -> do
      XLink
xl <- Element -> m XLink
forall (m :: * -> *). MonadFail m => Element -> m XLink
mkXLink Element
e
      ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeList
chL { deleteLinks :: Set XLink
deleteLinks = XLink -> Set XLink -> Set XLink
forall a. Ord a => a -> Set a -> Set a
Set.insert XLink
xl (Set XLink -> Set XLink) -> Set XLink -> Set XLink
forall a b. (a -> b) -> a -> b
$ ChangeList -> Set XLink
deleteLinks ChangeList
chL }
  Elem e :: Element
e | Element -> Bool
isSymbolType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
delSymMod ChangeList
chL Cursor
cr
  Elem e :: Element
e | Element -> Bool
isAxiomType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
delAxMod ChangeList
chL Cursor
cr
  Elem e :: Element
e | Element -> Bool
isTheoremType Element
e -> NodeMod -> ChangeList -> Cursor -> m ChangeList
forall (m :: * -> *).
MonadFail m =>
NodeMod -> ChangeList -> Cursor -> m ChangeList
mkUpdateChange NodeMod
delThMod ChangeList
chL Cursor
cr
  -- other cases as the above will be ignored
  _ -> ChangeList -> m ChangeList
forall (m :: * -> *) a. Monad m => a -> m a
return ChangeList
chL

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

isSymbolType :: Element -> Bool
isSymbolType :: Element -> Bool
isSymbolType e :: Element
e = String -> Element -> Bool
nameStringIs "Symbol" Element
e Bool -> Bool -> Bool
|| String -> Element -> Bool
nameStringIs "Declarations" Element
e
  Bool -> Bool -> Bool
|| String -> Element -> Bool
nameStringIs "Hidden" Element
e

isSentenceType :: Element -> Bool
isSentenceType :: Element -> Bool
isSentenceType e :: Element
e = Element -> Bool
isAxiomType Element
e Bool -> Bool -> Bool
|| Element -> Bool
isTheoremType Element
e

isAxiomType :: Element -> Bool
isAxiomType :: Element -> Bool
isAxiomType e :: Element
e = String -> Element -> Bool
nameStringIs "Axiom" Element
e Bool -> Bool -> Bool
|| String -> Element -> Bool
nameStringIs "Axioms" Element
e

isTheoremType :: Element -> Bool
isTheoremType :: Element -> Bool
isTheoremType e :: Element
e = String -> Element -> Bool
nameStringIs "Theorem" Element
e Bool -> Bool -> Bool
|| String -> Element -> Bool
nameStringIs "Theorems" Element
e

isDgNodeElem :: Element -> Bool
isDgNodeElem :: Element -> Bool
isDgNodeElem = String -> Element -> Bool
nameStringIs "DGNode"

isDgLinkElem :: Element -> Bool
isDgLinkElem :: Element -> Bool
isDgLinkElem = String -> Element -> Bool
nameStringIs "DGLink"