diff --git a/README.md b/README.md
index 5760f40..eb308e8 100644
--- a/README.md
+++ b/README.md
@@ -58,13 +58,14 @@ main = do
(Elem
(MkQName Nothing (MkName "p"))
[MkAttribute (MkQName Nothing (MkName "class")) "article"]
- [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "])
+ [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet "])
[Comment " Yet another comment "]
deEmphasize : Element -> Element
deEmphasize = mapContent $ \content => Snd.do
- elem <- map deEmphasize content
+ Right elem <- map (map deEmphasize) content
+ | Left misc => pure $ Left misc
case show elem.name of
"em" => elem.content
- _ => pure elem
+ _ => pure $ Right elem
```
diff --git a/XML/Language/XML/Element.idr b/XML/Language/XML/Element.idr
index d54c395..6f976e5 100644
--- a/XML/Language/XML/Element.idr
+++ b/XML/Language/XML/Element.idr
@@ -1,5 +1,6 @@
module Language.XML.Element
+import Data.Either
import Data.List1
import public Data.List.Alternating
import Data.String
@@ -8,11 +9,12 @@ import Data.String.Parser
import public Language.XML.Attribute
import public Language.XML.CharData
+import public Language.XML.Misc
import public Language.XML.Name
public export
data Element = EmptyElem QName (List Attribute)
- | Elem QName (List Attribute) (Odd CharData Element)
+ | Elem QName (List Attribute) (Odd CharData $ Either Misc Element)
%name Element elem
@@ -27,7 +29,7 @@ public export
(Elem _ attrs _).attrs = attrs
public export
-(.content) : Element -> Odd CharData Element
+(.content) : Element -> Odd CharData (Either Misc Element)
(EmptyElem _ _).content = [""]
(Elem _ _ content).content = content
@@ -43,19 +45,20 @@ showNl (MkCharData preSpace c postSpace) = maybeNl preSpace ++ c ++ maybeNl post
public export
textContent : Element -> String
textContent (EmptyElem name attrs) = ""
-textContent (Elem name attrs content) = concat $ forget $ bimap showNl textContent content
+textContent (Elem name attrs content) = concat $ Odd.forget $
+ bimap showNl textContent $ content >>= either (const neutral) pure
public export
find : (Element -> Bool) -> Element -> Maybe Element
-find f elem = find f (evens elem.content)
+find f elem = find f (rights $ evens elem.content)
public export
-mapContent : (Odd CharData Element -> Odd CharData Element) -> Element -> Element
+mapContent : (Odd CharData (Either Misc Element) -> Odd CharData (Either Misc Element)) -> Element -> Element
mapContent f (EmptyElem name attrs) = EmptyElem name attrs
mapContent f (Elem name attrs content) = Elem name attrs (f content)
public export
-mapContentM : Monad m => (Odd CharData Element -> m (Odd CharData Element)) -> Element -> m Element
+mapContentM : Monad m => (Odd CharData (Either Misc Element) -> m (Odd CharData (Either Misc Element))) -> Element -> m Element
mapContentM f (EmptyElem name attrs) = pure $ EmptyElem name attrs
mapContentM f (Elem name attrs content) = pure $ Elem name attrs !(f content)
@@ -75,7 +78,7 @@ Show Element where
show (Elem name attrs content) =
"""
<\{show name}\{concat $ map (\attr => " " ++ show attr) attrs}>\
- \{indentTail $ concat $ forget $ assert_total $ bimap showNl show content}\
+ \{indentTail $ concat $ forget $ assert_total $ bimap showNl (either show show) content}\
"""
@@ -90,7 +93,7 @@ element = (do
| Just _ => pure $ EmptyElem name attrs
ignore $ string ">"
- content <- alternating charData element
+ content <- alternating charData $ map Left misc <|> map Right element
string " spaces <* string ">"
diff --git a/tests/XMLDocument/Element/Element.idr b/tests/XMLDocument/Element/Element.idr
index bdcecc3..225a845 100644
--- a/tests/XMLDocument/Element/Element.idr
+++ b/tests/XMLDocument/Element/Element.idr
@@ -8,8 +8,8 @@ main = do
printLn $ Elem (MkQName Nothing (MkName "br")) [] [""]
let img = EmptyElem (MkQName Nothing (MkName "img")) [MkAttribute (MkQName Nothing (MkName "align")) "left", MkAttribute (MkQName Nothing (MkName "src")) "https://www.w3.org/Icons/w3c_home"]
- let body = Elem (MkQName Nothing (MkName "body")) [] ["", EmptyElem (MkQName Nothing (MkName "hr")) [], ""]
- let p = Elem (MkQName Nothing (MkName "p")) [MkAttribute (MkQName Nothing (MkName "class")) "article"] [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "]
+ let body = Elem (MkQName Nothing (MkName "body")) [] ["", Right (EmptyElem (MkQName Nothing (MkName "hr")) []), ""]
+ let p = Elem (MkQName Nothing (MkName "p")) [MkAttribute (MkQName Nothing (MkName "class")) "article"] [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet ", Left (Comment " consectetur adipiscing elit "), " "]
printLn img
printLn body
@@ -43,7 +43,7 @@ main = do
Elem
(MkQName Nothing (MkName "body"))
[]
- ["", EmptyElem (MkQName Nothing (MkName "hr")) [], ""],
+ ["", Right (EmptyElem (MkQName Nothing (MkName "hr")) []), ""],
18
) = parse element
"""
@@ -55,14 +55,15 @@ main = do
Elem
(MkQName Nothing (MkName "p"))
[MkAttribute (MkQName Nothing (MkName "class")) "article"]
- [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "],
- 73
+ [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet ", Left (Comment " consectetur adipiscing elit "), " "],
+ 114
) = parse element
"""
Lorem ipsum, dolor
sit
amet
+
"""
| fail => putStrLn "Error parsing XML element, got \{show fail}"
@@ -71,17 +72,19 @@ main = do
where
deEmphasize : Element -> Element
deEmphasize = mapContent \content => Snd.do
- elem <- map deEmphasize content
+ Right elem <- map (map deEmphasize) content
+ | Left misc => pure $ Left misc
case show elem.name of
"em" => elem.content
- _ => pure elem
+ _ => pure $ Right elem
maybeDeEmphasize : Bool -> Element -> Maybe Element
maybeDeEmphasize ok = mapContentM \contents => (do
- Just elem <- Just $ map (maybeDeEmphasize ok) contents
- | Nothing => Nothing
+ Right (Just elem) <- Just $ map (map $ maybeDeEmphasize ok) contents
+ | Right Nothing => Nothing
+ | Left misc => Just $ pure $ Left misc
case (ok, show elem.name) of
- (False, "em") => Nothing
- (True, "em") => Just $ elem.content
- (_, _) => Just $ pure elem
- ) @{Compose @{(%search, SndMonad, %search)}}
+ (False, "em") => Nothing
+ (True, "em") => Just elem.content
+ (_, _) => Just $ pure $ Right elem
+ ) @{Compose @{%search} @{SndMonad}}
diff --git a/tests/XMLDocument/Element/expected b/tests/XMLDocument/Element/expected
index 47fa55f..77d8e66 100644
--- a/tests/XMLDocument/Element/expected
+++ b/tests/XMLDocument/Element/expected
@@ -6,6 +6,7 @@
Lorem ipsum, dolor
sit
amet
+
@@ -17,8 +18,10 @@ Just "https://www.w3.org/Icons/w3c_home"
Just sit
Lorem ipsum, dolor sit amet
+
Just
Lorem ipsum, dolor sit amet
+
Nothing
diff --git a/tests/XMLDocument/Element/temp.ipkg b/tests/XMLDocument/Element/temp.ipkg
new file mode 100644
index 0000000..666f34d
--- /dev/null
+++ b/tests/XMLDocument/Element/temp.ipkg
@@ -0,0 +1,3 @@
+package temp
+
+depends = xml
diff --git a/tests/XMLDocument/ReadmeExample/ReadmeExample.idr b/tests/XMLDocument/ReadmeExample/ReadmeExample.idr
index 4855366..0868090 100644
--- a/tests/XMLDocument/ReadmeExample/ReadmeExample.idr
+++ b/tests/XMLDocument/ReadmeExample/ReadmeExample.idr
@@ -39,12 +39,13 @@ main = do
(Elem
(MkQName Nothing (MkName "p"))
[MkAttribute (MkQName Nothing (MkName "class")) "article"]
- [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "])
+ [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet "])
[Comment " Yet another comment "]
deEmphasize : Element -> Element
deEmphasize = mapContent $ \content => Snd.do
- elem <- map deEmphasize content
+ Right elem <- map (map deEmphasize) content
+ | Left misc => pure $ Left misc
case show elem.name of
"em" => elem.content
- _ => pure elem
+ _ => pure $ Right elem
diff --git a/tests/XMLDocument/XMLDocument/XMLDocument.idr b/tests/XMLDocument/XMLDocument/XMLDocument.idr
index 5f70ed9..c8b5985 100644
--- a/tests/XMLDocument/XMLDocument/XMLDocument.idr
+++ b/tests/XMLDocument/XMLDocument/XMLDocument.idr
@@ -23,7 +23,7 @@ main = do
(Elem
(MkQName Nothing (MkName "p"))
[MkAttribute (MkQName Nothing (MkName "class")) "article"]
- [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "])
+ [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet "])
[Comment " Yet another comment "]
let Right (
@@ -48,7 +48,7 @@ main = do
(Elem
(MkQName Nothing (MkName "p"))
[MkAttribute (MkQName Nothing (MkName "class")) "article"]
- [" Lorem ipsum, dolor ", Elem (MkQName Nothing (MkName "em")) [] ["sit"], " amet "])
+ [" Lorem ipsum, dolor ", Right (Elem (MkQName Nothing (MkName "em")) [] ["sit"]), " amet "])
[Comment " Yet another comment "],
235
) = parse xmlDocument