From 4dbdefdbb756ddac6213e0e544031523070ac1ee Mon Sep 17 00:00:00 2001
From: Robert Wright <robert.wright@ed.ac.uk>
Date: Wed, 22 Mar 2023 16:33:25 +0000
Subject: [PATCH] Support comments in document body

---
 README.md                                     |  7 +++--
 XML/Language/XML/Element.idr                  | 19 +++++++-----
 tests/XMLDocument/Element/Element.idr         | 29 ++++++++++---------
 tests/XMLDocument/Element/expected            |  3 ++
 tests/XMLDocument/Element/temp.ipkg           |  3 ++
 .../ReadmeExample/ReadmeExample.idr           |  7 +++--
 tests/XMLDocument/XMLDocument/XMLDocument.idr |  4 +--
 7 files changed, 43 insertions(+), 29 deletions(-)
 create mode 100644 tests/XMLDocument/Element/temp.ipkg

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}\
         </\{show name}>
         """
 
@@ -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 "</\{show name}" *> 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
                     """
                     <p class="article">
                         Lorem ipsum, dolor
                         <em>sit</em>
                         amet
+                        <!-- consectetur adipiscing elit -->
                     </p>
                     """
         | 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
     <em>sit</em>
     amet
+    <!-- consectetur adipiscing elit -->
 </p>
 
 
@@ -17,8 +18,10 @@ Just "https://www.w3.org/Icons/w3c_home"
 Just <em>sit</em>
 <p class="article">
     Lorem ipsum, dolor sit amet
+    <!-- consectetur adipiscing elit -->
 </p>
 Just <p class="article">
     Lorem ipsum, dolor sit amet
+    <!-- consectetur adipiscing elit -->
 </p>
 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