diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,20 @@ +0.1.1 +=== + +- fixed escape bug +- bumped tasty & text upper bounds + +0.1.0 +=== + +- Added RenderStyle +- rename: Warn <== Result +- refactored Markup structure +- created OpenTagType +- rename: NameTag <== TagName +- Element type synonym for Tree Token +- suffixed parsers with a 'P' + 0.0.0 === diff --git a/markup-parse.cabal b/markup-parse.cabal --- a/markup-parse.cabal +++ b/markup-parse.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: markup-parse -version: 0.1.0.1 +version: 0.1.1 license: BSD-3-Clause license-file: LICENSE copyright: Copyright, Tony Day, 2023- @@ -106,7 +106,7 @@ , deepseq >=1.4.4 && <1.6 , flatparse >=0.3.5 && <0.6 , string-interpolate >=0.3 && <0.4 - , tasty >=1.2 && <1.5 + , tasty >=1.2 && <1.6 , tasty-golden >=2.3.1.1 && <2.4 , these >=1.1 && <1.3 , tree-diff >=0.3 && <0.4 @@ -145,6 +145,6 @@ , markup-parse , optparse-applicative >=0.17 && <0.19 , perf >=0.12 && <0.13 - , text >=1.2 && <2.1 + , text >=1.2 && <2.2 ghc-options: -O2 type: exitcode-stdio-1.0 diff --git a/other/line_.html b/other/line_.html deleted file mode 100644 --- a/other/line_.html +++ /dev/null @@ -1,48 +0,0 @@ - - - - - 0.00.51.01.52.02.53.03.54.04.55.00.00.51.01.52.02.53.0Line ChartMade with love and chart-svgpalette1 2palette1 1palette1 0 diff --git a/other/line_.svg b/other/line_.svg deleted file mode 100644 --- a/other/line_.svg +++ /dev/null @@ -1,52 +0,0 @@ - - - - - - - - - - 0.00.51.01.52.02.53.03.54.04.55.00.00.51.01.52.02.53.0Line ChartMade with love and chart-svgpalette1 2palette1 1palette1 0 diff --git a/readme.org b/readme.org --- a/readme.org +++ b/readme.org @@ -3,11 +3,11 @@ [[https://hackage.haskell.org/package/markup-parse][https://img.shields.io/hackage/v/markup-parse.svg]] [[https://github.com/tonyday567/markup-parse/actions?query=workflow%3Ahaskell-ci][https://github.com/tonyday567/markup-parse/workflows/haskell-ci/badge.svg]] -~markup-parse~ parses and prints a subset of common XML & HTML data. +~markup-parse~ parses and prints a subset of common XML & HTML structured data, from and to strict bytestrings * Development -#+begin_src haskell :results output +#+begin_src haskell :results output :exports both :r :set prompt "> " :set -Wno-type-defaults @@ -18,51 +18,55 @@ import Control.Monad import MarkupParse import MarkupParse.FlatParse -import Data.Map.Strict qualified as Map import MarkupParse.Patch import Data.ByteString qualified as B import Data.ByteString.Char8 qualified as C +import Data.Map.Strict qualified as Map import Data.Function import FlatParse.Basic hiding (take) import Data.String.Interpolate import Data.TreeDiff import Control.Monad --- import Perf bs <- B.readFile "other/line.svg" C.length bs #+end_src #+RESULTS: +: Preprocessing library for markup-parse-0.1.1.. +: GHCi, version 9.6.2: https://www.haskell.org/ghc/ :? for help +: [1 of 3] Compiling MarkupParse.FlatParse ( src/MarkupParse/FlatParse.hs, interpreted ) +: [2 of 3] Compiling MarkupParse ( src/MarkupParse.hs, interpreted ) +: [3 of 3] Compiling MarkupParse.Patch ( src/MarkupParse/Patch.hs, interpreted ) : Ok, three modules loaded. -: > -: > +: g +: Ok, three modules loaded. : 7554 -* Main Pipeline +* Main Pipeline types -#+begin_src haskell :results output +#+begin_src haskell :results output :exports both :t tokenize Html :t gather Html -:t Markup Html :t normalize -:t tokenize Html >=> gather Html >>> fmap (Markup Html >>> normalize) >=> degather >>> fmap (fmap (detokenize Html) >>> mconcat) +:t degather :t detokenize Html +:t tokenize Html >=> gather Html >=> (normalize >>> pure) >=> degather Html >=> (fmap (detokenize Html) >>> pure) #+end_src #+RESULTS: -: tokenize Html :: ByteString -> These [MarkupWarning] [Token] -: gather Html :: [Token] -> These [MarkupWarning] [Tree Token] -: Markup Html :: [Tree Token] -> Markup +: tokenize Html :: ByteString -> Warn [Token] +: gather Html :: [Token] -> Warn Markup : normalize :: Markup -> Markup -: tokenize Html >=> gather Html >>> fmap (Markup Html >>> normalize) >=> degather >>> fmap (fmap (detokenize Html) >>> mconcat) -: :: ByteString -> These [MarkupWarning] ByteString +: degather :: Standard -> Markup -> Warn [Token] : detokenize Html :: Token -> ByteString +: tokenize Html >=> gather Html >=> (normalize >>> pure) >=> degather Html >=> (fmap (detokenize Html) >>> pure) +: :: ByteString -> These [MarkupWarning] [ByteString] Round trip equality -#+begin_src haskell :results output +#+begin_src haskell :results output :exports both m = markup_ Xml bs -m == (markup_ Xml $ markdown Compact m) +m == (markup_ Xml $ markdown_ Compact Xml m) #+end_src #+RESULTS: @@ -70,73 +74,74 @@ * MarkupParse.Patch -Obviously doesn't belong here long-term but has been very useful in testing and development. +Obviously, patch doesn't belong here long-term but has been very useful in testing and development. -#+begin_src haskell :results output -show $ ansiWlEditExpr <$> patch [1, 2, 3, 5] [0, 1, 2, 4, 6] +#+begin_src haskell :results output :exports both +showPatch $ patch [1, 2, 3, 5] [0, 1, 2, 4, 6] #+end_src #+RESULTS: -: Just [+0, -3, +4, -5, +6] +: [+0, -3, +4, -5, +6] * wiki diff test debug -#+begin_src haskell :results output +#+begin_src haskell :results output :exports both bs <- B.readFile "other/Parsing - Wikipedia.html" m = markup_ Html bs -m == (markup_ Html $ markdown Compact m) +m == (markup_ Html $ markdown_ Compact Html m) #+end_src #+RESULTS: : True * Reference -** Html Standards -[[https://html.spec.whatwg.org/multipage/syntax.html#elements-2:void-elements-2][HTML Standard]] - -[[https://developer.mozilla.org/en-US/docs/Glossary/Void_element#self-closing_tags][void elements]] +[[https://html.spec.whatwg.org/#toc-syntax][HTML Standard]] -[[https://stackoverflow.com/questions/3558119/are-non-void-self-closing-tags-valid-in-html5][html - Are (non-void) self-closing tags valid in HTML5? - Stack Overflow]] +[[https://stackoverflow.com/questions/3558119/are-non-void-self-closing-tags-valid-in-html5][Are (non-void) self-closing tags valid in HTML5? - Stack Overflow]] -[[https://www.w3.org/TR/2017/REC-html52-20171214/syntax.html#tree-construction][HTML 5.2: 8. The HTML syntax]] +[[https://www.w3.org/TR/xml/][Extensible Markup Language (XML) 1.0 (Fifth Edition)]] ** Prior Art -attoparsec-based -https://hackage.haskell.org/package/html-parse +[[https://hackage.haskell.org/package/html-parse][html-parse]] is an attoparsec-based parser for HTML. The HTML parsing here has referenced this parsing logic for HTML elements. -event-based -https://hackage.haskell.org/package/xeno +[[https://hackage.haskell.org/package/blaze-markup][blaze-markup]] & [[https://hackage.haskell.org/package/lucid][lucid]] are HTML DSLs and printers, but not parsers. -parsec-based -https://hackage.haskell.org/package/XMLParser +[[https://hackage.haskell.org/package/xeno][xeno]] is an "event-based" XML parser with a more complicated base markup type. -https://hackage.haskell.org/package/hexml +[[https://hackage.haskell.org/package/XMLParser][XMLParser]] & [[https://hackage.haskell.org/package/hexml][hexml]] are parsec-based parsers. * Performance -Most testing has been via app/speed.hs - -#+begin_src elisp -(setq haskell-process-args-cabal-repl '("markup-parse:bench:markup-parse-speed")) -#+end_src - -#+RESULTS: -| markup-parse:bench:markup-parse-speed | +The [[https://hackage.haskell.org/package/perf][perf]] library has been used to measure performance of the library. -** Benchmarks +`cabal bench` runs the default benchmarking: -#+begin_src sh :results output -cabal run markup-parser-speed +#+begin_src sh :results output :exports both +cabal bench #+end_src #+RESULTS: - +#+begin_example +Running 1 benchmarks... +Benchmark markup-parse-speed: RUNNING... +label1 label2 old result new result change +gather time 9.33e4 7.73e4 improvement +html-parse tokenstime 1.21e6 1.17e6 +html-parse tree time 6.61e4 7.59e4 slightly-degraded +markdown time 3.75e5 3.92e5 +markup time 4.72e5 5.20e5 slightly-degraded +normalize time 2.80e5 3.04e5 slightly-degraded +tokenize time 8.59e5 8.67e5 +Benchmark markup-parse-speed: FINISH +#+end_example ** Profiling +Profiling is used to aid library development: + #+begin_src sh :results output cabal configure --enable-library-profiling --enable-executable-profiling -fprof-auto -fprof --write-ghc-environment-files=always --enable-benchmarks -O2 #+end_src @@ -151,8 +156,7 @@ executable-profiling: True #+end_example - -Profiling slowed the main functions significantly: +Profiling slow the main functions significantly: #+begin_example ./app/speed -n 1000 --best -c +RTS -s -p -hc -l -RTS diff --git a/src/MarkupParse.hs b/src/MarkupParse.hs --- a/src/MarkupParse.hs +++ b/src/MarkupParse.hs @@ -33,7 +33,7 @@ warnEither, warnMaybe, - -- * element creation + -- * Element Element, element, element_, @@ -45,12 +45,12 @@ -- * Token components NameTag, selfClosers, - addAttrs, doctypeHtml, doctypeXml, AttrName, AttrValue, Attr (..), + addAttrs, attrsP, nameP, @@ -129,7 +129,7 @@ -- -- @'markdown_' . 'markup_'@ is an isomorphic round trip from 'Markup' to 'ByteString' to 'Markup': -- --- - This is subject to the Markup being 'wellFormed'. +-- - This is subject to the 'Markup' being 'wellFormed'. -- -- - The round-trip @'markup_' . 'markdown_'@ is not isomorphic as parsing forgets whitespace within tags, comments and declarations. -- @@ -149,7 +149,7 @@ -- -- - 'normalize' concatenates content, and normalizes attributes, -- --- > degather >=> +-- > degather Html >=> -- -- - 'degather' turns the markup tree back into a token list. Finally, -- @@ -157,7 +157,7 @@ -- -- - 'detokenize' turns a token back into a bytestring. -- --- Along the way, the kleisi fishies and compose forward usage accumulates any warnings via the 'These' monad instance. +-- Along the way, the kleisi fishies and compose forward usage accumulates any warnings via the 'These' monad instance, which is wrapped into a type synonym named 'Warn'. -- | From a parsing pov, Html & Xml (& Svg) are close enough that they share a lot of parsing logic, so that parsing and printing just need some tweaking. -- @@ -187,7 +187,7 @@ TagMismatch NameTag NameTag | -- | An EndTag with no corresponding StartTag. UnmatchedEndTag - | -- | An EndTag with corresponding StartTag. + | -- | An StartTag with no corresponding EndTag. UnclosedTag | -- | An EndTag should never appear in 'Markup' EndTagInTree @@ -235,7 +235,7 @@ markup :: Standard -> ByteString -> Warn Markup markup s bs = bs & (tokenize s >=> gather s) --- | markup but errors on warnings. +-- | 'markup' but errors on warnings. markup_ :: Standard -> ByteString -> Markup markup_ s bs = markup s bs & warnError @@ -278,8 +278,16 @@ -- | Whether an opening tag is a start tag or an empty element tag. data OpenTagType = StartTag | EmptyElemTag deriving (Show, Ord, Eq, Generic, NFData, ToExpr) --- | A Markup token +-- | A Markup token. The term is borrowed from standards but is used across 'Html' and 'Xml' in this library. -- +-- Note that the 'Token' type is used in two slightly different contexts: +-- +-- - As an intermediary representation of markup between 'ByteString' and 'Markup'. +-- +-- - As the primitives of 'Markup' 'Element's +-- +-- Specifically, an 'EndTag' will occur in a list of tokens, but not as a primitive in 'Markup'. It may turn out to be better to have two different types for these two uses and future iterations of this library may head in this direction. +-- -- >>> runParser_ (many (tokenP Html)) [i|content|] -- [OpenTag StartTag "foo" [],Content "content",EndTag "foo"] -- @@ -320,21 +328,31 @@ -- | Escape a single character. escapeChar :: Char -> ByteString -escapeChar '<' = "<" -escapeChar '>' = ">" -escapeChar '&' = "&" -escapeChar '\'' = "&apos" -escapeChar '"' = """ +escapeChar '<' = "<" +escapeChar '>' = ">" +escapeChar '&' = "&" +escapeChar '\'' = "'" +escapeChar '"' = """ escapeChar x = B.singleton x --- | Escape Content +-- | Escape the following predefined character entity references: -- +-- @ +-- escapeChar \'<\' = "<" +-- escapeChar \'>\' = ">" +-- escapeChar \'&\' = "&" +-- escapeChar '\'' = "'" +-- escapeChar '"' = """ +-- @ +-- +-- No attempt is made to meet the +-- -- >>> escape [i||] --- "<foo class="a" bar=&aposb&apos>" +-- "<foo class="a" bar='b'>" escape :: ByteString -> ByteString escape bs = B.concatMap escapeChar bs --- | Append attributes to the existing Token attribute list. +-- | Append attributes to an existing Token attribute list. Returns Nothing for tokens that do not have attributes. addAttrs :: [Attr] -> Token -> Maybe Token addAttrs as (OpenTag t n as') = Just $ OpenTag t n (as <> as') addAttrs _ _ = Nothing @@ -395,41 +413,41 @@ "wbr" ] --- | Most functions return a 'Markup' rather than an 'Element' because it is more ergonimc to use the free monoid wrap (aka a list) in preference to returning a 'Maybe Element', say. +-- | Most functions return a 'Markup' rather than an 'Element' because it is often more ergonomic to use the free monoid (aka a list) in preference to returning a 'Maybe' 'Element' (say). type Element = Tree Token --- | Create a Markup element from a NameTag and attributes that wraps some other Markup. +-- | Create 'Markup' from a name tag and attributes that wraps some other markup. -- -- >>> element "div" [] (element_ "br" []) -- Markup {elements = [Node {rootLabel = OpenTag StartTag "div" [], subForest = [Node {rootLabel = OpenTag StartTag "br" [], subForest = []}]}]} element :: NameTag -> [Attr] -> Markup -> Markup element n as (Markup xs) = Markup [Node (OpenTag StartTag n as) xs] --- | Create a Markup element from a NameTag and attributes that doesn't wrap some other Markup. OpenTagType is StartTag. Use 'emptyElem' if you want to create a EmptyElemTag. +-- | Create 'Markup' from a name tag and attributes that doesn't wrap some other markup. The 'OpenTagType' used is 'StartTag'. Use 'emptyElem' if you want to create 'EmptyElemTag' based markup. -- -- >>> (element_ "br" []) -- Markup {elements = [Node {rootLabel = OpenTag StartTag "br" [], subForest = []}]} element_ :: NameTag -> [Attr] -> Markup element_ n as = Markup [Node (OpenTag StartTag n as) []] --- | Create a Markup element from a NameTag and attributes using EmptyElemTag, that doesn't wrap some other Markup. No checks are made on whether this creates well-formed Markup. +-- | Create 'Markup' from a name tag and attributes using 'EmptyElemTag', that doesn't wrap some other markup. No checks are made on whether this creates well-formed markup. -- -- >>> emptyElem "br" [] -- Markup {elements = [Node {rootLabel = OpenTag EmptyElemTag "br" [], subForest = []}]} emptyElem :: NameTag -> [Attr] -> Markup emptyElem n as = Markup [Node (OpenTag EmptyElemTag n as) []] --- | Create a Markup element from a NameTag and attributes that wraps some 'Content'. No escaping is performed. +-- | Create 'Markup' from a name tag and attributes that wraps some 'Content'. No escaping is performed. -- -- >>> elementc "div" [] "content" -- Markup {elements = [Node {rootLabel = OpenTag StartTag "div" [], subForest = [Node {rootLabel = Content "content", subForest = []}]}]} elementc :: NameTag -> [Attr] -> ByteString -> Markup elementc n as bs = element n as (contentRaw bs) --- | Create a Markup element from a bytestring, escaping the usual characters. +-- | Create 'Markup' 'Content' from a bytestring, escaping the usual characters. -- -- >>> content "" --- Markup {elements = [Node {rootLabel = Content "<content>", subForest = []}]} +-- Markup {elements = [Node {rootLabel = Content "<content>", subForest = []}]} content :: ByteString -> Markup content bs = Markup [pure $ Content (escape bs)] @@ -519,7 +537,7 @@ (Doctype t) -> [i||] (Decl t as) -> bool [i||] [i||] (s == Html) --- | Indented 0 puts newlines in between the tags. +-- | @Indented 0@ puts newlines in between the tags. data RenderStyle = Compact | Indented Int deriving (Eq, Show, Generic) indentChildren :: RenderStyle -> [ByteString] -> [ByteString] @@ -589,7 +607,7 @@ (Cursor finalSibs finalParents, warnings) = foldl' (\(c, xs) t -> incCursor s t c & second (maybeToList >>> (<> xs))) (Cursor [] [], []) ts --- | gather but errors on warnings. +-- | 'gather' but errors on warnings. gather_ :: Standard -> [Token] -> Markup gather_ s ts = gather s ts & warnError @@ -632,7 +650,7 @@ degather :: Standard -> Markup -> Warn [Token] degather s (Markup tree) = concatWarns $ foldTree (addCloseTags s) <$> tree --- | degather but errors on warning +-- | 'degather' but errors on warning degather_ :: Standard -> Markup -> [Token] degather_ s m = degather s m & warnError @@ -785,13 +803,13 @@ ) <* $(char '>') --- | Xml production [32] +-- | xml production [32] xmlStandaloneP :: Parser e ByteString xmlStandaloneP = byteStringOf $ ws_ *> $(string "standalone") *> eq *> xmlYesNoP --- | Xml yes/no +-- | xml yes/no xmlYesNoP :: Parser e ByteString xmlYesNoP = wrappedQNoGuard (byteStringOf $ $(string "yes") <|> $(string "no")) diff --git a/src/MarkupParse/FlatParse.hs b/src/MarkupParse/FlatParse.hs --- a/src/MarkupParse/FlatParse.hs +++ b/src/MarkupParse/FlatParse.hs @@ -3,21 +3,21 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} --- | Various flatparse helpers and combinators. +-- | Various helpers and combinators. module MarkupParse.FlatParse - ( -- * parsing + ( -- * Parsing ParserWarning (..), runParserMaybe, runParserEither, runParserWarn, runParser_, - -- * flatparse re-exports + -- * Flatparse re-exports runParser, Parser, Result (..), - -- * parsers + -- * Parsers isWhitespace, ws_, ws, @@ -60,7 +60,7 @@ -- >>> import MarkupParse.FlatParse -- >>> import FlatParse.Basic --- | run a Parser, throwing away leftovers. Nothing on 'Fail' or 'Err'. +-- | Run a Parser, throwing away leftovers. Nothing on 'Fail' or 'Err'. -- -- >>> runParserMaybe ws "x" -- Nothing @@ -73,7 +73,7 @@ Fail -> Nothing Err _ -> Nothing --- | run a Parser, throwing away leftovers. Returns Left on 'Fail' or 'Err'. +-- | Run a Parser, throwing away leftovers. Returns Left on 'Fail' or 'Err'. -- -- >>> runParserEither ws " x" -- Right ' ' @@ -175,14 +175,14 @@ wss :: Parser e ByteString wss = byteStringOf $ some ws --- | single quote +-- | Single quote -- -- >>> runParserMaybe sq "'" -- Just () sq :: ParserT st e () sq = $(char '\'') --- | double quote +-- | Double quote -- -- >>> runParserMaybe dq "\"" -- Just () @@ -256,14 +256,14 @@ eq = ws_ *> $(char '=') <* ws_ {-# INLINE eq #-} --- | some with a separator +-- | Some with a separator. -- -- >>> runParser (sep ws (many (satisfy (/= ' ')))) "a b c" -- OK ["a","b","c"] "" sep :: Parser e s -> Parser e a -> Parser e [a] sep s p = (:) <$> p <*> many (s *> p) --- | parser bracketed by two other parsers +-- | Parser bracketed by two other parsers. -- -- >>> runParser (bracketed ($(char '[')) ($(char ']')) (many (satisfy (/= ']')))) "[bracketed]" -- OK "bracketed" "" @@ -271,14 +271,14 @@ bracketed o c p = o *> p <* c {-# INLINE bracketed #-} --- | Bracketed by square brackets. +-- | Parser bracketed by square brackets. -- -- >>> runParser bracketedSB "[bracketed]" -- OK "bracketed" "" bracketedSB :: Parser e [Char] bracketedSB = bracketed $(char '[') $(char ']') (many (satisfy (/= ']'))) --- | parser wrapped by another parser +-- | Parser wrapped by another parser. -- -- >>> runParser (wrapped ($(char '"')) (many (satisfy (/= '"')))) "\"wrapped\"" -- OK "wrapped" "" @@ -288,12 +288,12 @@ -- | A single digit -- --- runParserMaybe digit "5" +-- >>> runParserMaybe digit "5" -- Just 5 digit :: Parser e Int digit = (\c -> ord c - ord '0') <$> satisfyAscii isDigit --- | (unsigned) Int parser +-- | An (unsigned) 'Int' parser -- -- >>> runParserMaybe int "567" -- Just 567 @@ -307,7 +307,8 @@ digits :: Parser e (Int, Int) digits = chainr (\n (!place, !acc) -> (place * 10, acc + place * n)) digit (pure (1, 0)) --- | +-- | A 'Double' parser. +-- -- >>> runParser double "1.234x" -- OK 1.234 "x" -- @@ -341,6 +342,7 @@ minus = $(char '-') -- | Parser for a signed prefix to a number. +-- -- >>> runParser (signed double) "-1.234x" -- OK (-1.234) "x" signed :: (Num b) => Parser e b -> Parser e b @@ -350,6 +352,9 @@ Nothing -> p Just () -> negate <$> p --- | comma parser +-- | Comma parser +-- +-- >>> runParserMaybe comma "," +-- Just () comma :: Parser e () comma = $(char ',') diff --git a/src/MarkupParse/Patch.hs b/src/MarkupParse/Patch.hs --- a/src/MarkupParse/Patch.hs +++ b/src/MarkupParse/Patch.hs @@ -21,7 +21,7 @@ -- >>> :set -XOverloadedStrings -- >>> import MarkupParse.Patch --- | compare a markup file with a round-trip transformation. +-- | Compare a file with a round-trip transformation. goldenPatch :: (ToExpr a) => (FilePath -> IO a) -> (a -> a) -> FilePath -> TestTree goldenPatch f testf fp = goldenTest