-
Alice Brenon authored50dc0c6e
Namespace.hs 908 B
{-# LANGUAGE NamedFieldPuns #-}
module Text.InvisiXML.Namespace (
uRI
, prefix
, ixml
--, at
--, to
, addAttr
, setChildren
) where
--import Data.PositionTree (Position(..))
import Text.XML.Light (Attr(..), Content(..), Element(..), QName(..), add_attr)
uRI :: String
uRI = "https://gitlab.liris.cnrs.fr/abrenon/InvisiXML"
prefix :: String
prefix = "ixml"
ixml :: String -> QName
ixml qName = QName {qName, qURI = Just uRI, qPrefix = Just prefix}
{-
at :: Position -> Attr
at (Position p) = Attr (ixml "at") (show p)
to :: Position -> Attr
to (Position p) = Attr (ixml "to") (show p)
-}
onContent :: (Element -> Element) -> Content -> Content
onContent f (Elem e) = Elem (f e)
onContent _ x = x
addAttr :: Attr -> Content -> Content
addAttr = onContent . add_attr
setChildren :: [Content] -> Content -> Content
setChildren elContent = onContent $ \e -> e {elContent}