Skip to content

Commit

Permalink
Support comments in document body
Browse files Browse the repository at this point in the history
@madman-bob
madman-bob committed Mar 22, 2023
1 parent 1292ccf commit 4dbdefd
Showing 7 changed files with 43 additions and 29 deletions.
7 changes: 4 additions & 3 deletions README.md
View file
Original file line number Diff line number Diff line change
@@ -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
```
19 changes: 11 additions & 8 deletions XML/Language/XML/Element.idr
View file
Original file line number Diff line number Diff line change
@@ -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 ">"

29 changes: 16 additions & 13 deletions tests/XMLDocument/Element/Element.idr
View file
Original file line number Diff line number Diff line change
@@ -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}}
3 changes: 3 additions & 0 deletions tests/XMLDocument/Element/expected
View file
Original file line number Diff line number Diff line change
@@ -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
3 changes: 3 additions & 0 deletions tests/XMLDocument/Element/temp.ipkg
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
package temp

depends = xml
7 changes: 4 additions & 3 deletions tests/XMLDocument/ReadmeExample/ReadmeExample.idr
View file
Original file line number Diff line number Diff line change
@@ -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
4 changes: 2 additions & 2 deletions tests/XMLDocument/XMLDocument/XMLDocument.idr
View file
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 4dbdefd

Please sign in to comment.