xml-syntax 0.1.0.0 → 0.1.0.1
raw patch · 5 files changed
+171/−156 lines, 5 filesdep ~bytestringsetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−2
- Setup.hs +1/−0
- src/Xml.hs +51/−47
- test/Main.hs +76/−78
- xml-syntax.cabal +37/−29
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for xml-syntax -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.0.1 -- 2024-01-31 -* First version. Released on an unsuspecting world.+* Updated package metadata.++## 0.1.0.0 -- 2021-10-11++* First version.
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
src/Xml.hs view
@@ -1,50 +1,52 @@-{-# language BangPatterns #-}-{-# language LambdaCase #-}-{-# language MagicHash #-}-{-# language NamedFieldPuns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-} module Xml- ( Node(..)- , Content(..)- , Attribute(..)+ ( Node (..)+ , Content (..)+ , Attribute (..) , decode ) where -import Data.Word (Word8)+import Data.Builder.ST (Builder) import Data.Bytes (Bytes)-import Data.Text.Short (ShortText)-import Data.Primitive (SmallArray) import Data.Bytes.Parser (Parser)-import GHC.Exts (Char(C#),Char#) import Data.Chunks (Chunks)-import Data.Builder.ST (Builder)+import Data.Primitive (SmallArray)+import Data.Text.Short (ShortText)+import Data.Word (Word8)+import GHC.Exts (Char (C#), Char#) -import qualified Data.Chunks as Chunks-import qualified Data.Text.Short as TS-import qualified Data.Text.Short.Unsafe as TS import qualified Data.Builder.ST as Builder import qualified Data.Bytes as Bytes import qualified Data.Bytes.Parser as Parser-import qualified Data.Bytes.Parser.Rebindable as R import qualified Data.Bytes.Parser.Latin as Latin+import qualified Data.Bytes.Parser.Rebindable as R import qualified Data.Bytes.Parser.Unsafe as Unsafe import qualified Data.Bytes.Parser.Utf8 as Utf8+import qualified Data.Chunks as Chunks+import qualified Data.Text.Short as TS+import qualified Data.Text.Short.Unsafe as TS data Node = Text !ShortText | Element {-# UNPACK #-} !Content- deriving (Show,Eq)+ deriving (Show, Eq) data Content = Content { tag :: !ShortText , attributes :: !(SmallArray Attribute) , children :: !(SmallArray Node)- } deriving (Show,Eq)+ }+ deriving (Show, Eq) data Attribute = Attribute { name :: !ShortText , value :: !ShortText- } deriving (Show,Eq)+ }+ deriving (Show, Eq) decode :: Bytes -> Maybe Node decode !b = Parser.parseBytesMaybe elementNodeParser b@@ -65,12 +67,12 @@ Latin.any () >>= \case '>' -> do nodes <- childrenParser tag- pure (Element Content{tag,attributes,children=Chunks.concat nodes})+ pure (Element Content {tag, attributes, children = Chunks.concat nodes}) '/' -> do Latin.char () '>'- pure (Element Content{tag,attributes,children=mempty})+ pure (Element Content {tag, attributes, children = mempty}) _ -> Parser.fail ()- + textNodeParser :: Parser () s Node textNodeParser = do raw <- Parser.takeWhile (\w -> w /= 0x3C)@@ -80,33 +82,35 @@ -- This eats the closing tag as well. childrenParser ::- ShortText -- opening tag name, looking for a closing tag that matches- -> Parser () s (Chunks Node)+ ShortText -> -- opening tag name, looking for a closing tag that matches+ Parser () s (Chunks Node) childrenParser !tag = do b0 <- Parser.effect Builder.new childrenParserLoop tag b0 childrenParserLoop ::- ShortText -- opening tag name, looking for a closing tag that matches- -> Builder s Node- -> Parser () s (Chunks Node)-childrenParserLoop !tag !b0 = Latin.any () >>= \case- '<' -> Latin.any () >>= \case- '/' -> do- Utf8.shortText () tag- Parser.skipWhile isXmlSpace- Latin.char () '>'- Parser.effect (Builder.freeze b0)+ ShortText -> -- opening tag name, looking for a closing tag that matches+ Builder s Node ->+ Parser () s (Chunks Node)+childrenParserLoop !tag !b0 =+ Latin.any () >>= \case+ '<' ->+ Latin.any () >>= \case+ '/' -> do+ Utf8.shortText () tag+ Parser.skipWhile isXmlSpace+ Latin.char () '>'+ Parser.effect (Builder.freeze b0)+ _ -> do+ Unsafe.unconsume 2+ node <- elementNodeParser+ b1 <- Parser.effect (Builder.push node b0)+ childrenParserLoop tag b1 _ -> do- Unsafe.unconsume 2- node <- elementNodeParser+ Unsafe.unconsume 1+ node <- textNodeParser b1 <- Parser.effect (Builder.push node b0) childrenParserLoop tag b1- _ -> do- Unsafe.unconsume 1- node <- textNodeParser- b1 <- Parser.effect (Builder.push node b0)- childrenParserLoop tag b1 isXmlSpace :: Word8 -> Bool isXmlSpace = \case@@ -147,7 +151,7 @@ Latin.char () '=' Parser.skipWhile isXmlSpace !value <- parserAttributeValue- pure Attribute{name,value}+ pure Attribute {name, value} -- TODO: This is woefully incomplete parserAttributeValue :: Parser () s ShortText@@ -166,14 +170,14 @@ Nothing -> Parser.fail () Just tval -> pure tval _ -> Parser.fail ()- + peekIsNameStartChar :: Parser () s Bool peekIsNameStartChar = Unsafe.cursor R.>>= \pos ->- Utf8.any# () R.>>= \c -> - Unsafe.jump pos R.>>= \_ ->- R.pure (isNameStartChar c)- + Utf8.any# () R.>>= \c ->+ Unsafe.jump pos R.>>= \_ ->+ R.pure (isNameStartChar c)+ isNameStartChar :: Char# -> Bool isNameStartChar c = case C# c of ':' -> True
test/Main.hs view
@@ -1,89 +1,87 @@-{-# language BangPatterns #-}-{-# language MultiWayIf #-}-{-# language NumDecimals #-}-{-# language OverloadedLists #-}-{-# language OverloadedStrings #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} import Xml -import Test.Tasty (defaultMain,testGroup,TestTree)-import Test.Tasty.HUnit ((@=?),testCase)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase, (@=?)) -import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Text.Ascii as Ascii main :: IO () main = defaultMain tests decodeString :: String -> Maybe Node-decodeString = Xml.decode . Bytes.fromAsciiString+decodeString = Xml.decode . Ascii.fromString tests :: TestTree-tests = testGroup "xml"- [ testCase "A" $- Just- ( Element Content- { tag = "foo"- , attributes = mempty- , children = [Text "hello"]- }- )- @=?- decodeString "<foo>hello</foo>"- , testCase "B" $- Just- ( Element Content- { tag = "foo"- , attributes = [Attribute "bar" "baz"]- , children = [Text "hi"]- }- )- @=?- decodeString "<foo bar='baz'>hi</foo>"- , testCase "C" $- Just- ( Element Content- { tag = "foo"- , attributes = [Attribute "bar" "baz"]- , children = [Text "hi"]- }- )- @=?- decodeString "<foo bar=\"baz\">hi</foo>"- , testCase "D" $- Just- ( Element Content- { tag = "foo"- , attributes = [Attribute "bar" "baz"]- , children = mempty- }- )- @=?- decodeString "<foo bar=\"baz\"/>"- , testCase "E" $- Just- ( Element Content- { tag = "foo"- , attributes = mempty- , children = [Text "hello"]- }- )- @=?- decodeString "<foo >hello</foo>"- , testCase "F" $- Just- ( Element Content- { tag = "foo"- , attributes = [Attribute "bar" "baz"]- , children =- [ Text " "- , Element Content{tag="hey",attributes=mempty,children=mempty}- , Text " "- , Element Content{tag="hi",attributes=mempty,children=mempty}- ]- }- )- @=?- decodeString "<foo bar=\"baz\"> <hey/> <hi></hi></foo>"- ]+tests =+ testGroup+ "xml"+ [ testCase "A" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = mempty+ , children = [Text "hello"]+ }+ )+ @=? decodeString "<foo>hello</foo>"+ , testCase "B" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = [Attribute "bar" "baz"]+ , children = [Text "hi"]+ }+ )+ @=? decodeString "<foo bar='baz'>hi</foo>"+ , testCase "C" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = [Attribute "bar" "baz"]+ , children = [Text "hi"]+ }+ )+ @=? decodeString "<foo bar=\"baz\">hi</foo>"+ , testCase "D" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = [Attribute "bar" "baz"]+ , children = mempty+ }+ )+ @=? decodeString "<foo bar=\"baz\"/>"+ , testCase "E" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = mempty+ , children = [Text "hello"]+ }+ )+ @=? decodeString "<foo >hello</foo>"+ , testCase "F" $+ Just+ ( Element+ Content+ { tag = "foo"+ , attributes = [Attribute "bar" "baz"]+ , children =+ [ Text " "+ , Element Content {tag = "hey", attributes = mempty, children = mempty}+ , Text " "+ , Element Content {tag = "hi", attributes = mempty, children = mempty}+ ]+ }+ )+ @=? decodeString "<foo bar=\"baz\"> <hey/> <hi></hi></foo>"+ ]
xml-syntax.cabal view
@@ -1,43 +1,51 @@-cabal-version: 2.4-name: xml-syntax-synopsis: Parse XML from bytes-version: 0.1.0.0-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2020 Andrew Martin-category: Data-build-type: Simple-extra-source-files: CHANGELOG.md+cabal-version: 2.4+name: xml-syntax+synopsis: Parse XML from bytes+description: Parse XML from bytes.+version: 0.1.0.1+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com+copyright: 2020 Andrew Martin+homepage: https://github.com/byteverse/xml-syntax+bug-reports: https://github.com/byteverse/xml-syntax/issues+category: Data+build-type: Simple+extra-doc-files: CHANGELOG.md library- exposed-modules: Xml+ exposed-modules: Xml build-depends:- , array-builder >=0.1 && <0.2- , array-chunks >=0.1.1 && <0.2- , base >=4.12 && <5- , bytebuild >=0.3.4 && <0.4- , byteslice >=0.2.6 && <0.3- , bytesmith >=0.3.8 && <0.4- , bytestring >=0.10.8 && <0.11- , primitive >=0.7 && <0.8- , text-short >=0.1.3 && <0.2- hs-source-dirs: src+ , array-builder >=0.1 && <0.2+ , array-chunks >=0.1.1 && <0.2+ , base >=4.12 && <5+ , bytebuild >=0.3.4 && <0.4+ , byteslice >=0.2.6 && <0.3+ , bytesmith >=0.3.8 && <0.4+ , bytestring >=0.10.8 && <0.12+ , primitive >=0.7 && <0.8+ , text-short >=0.1.3 && <0.2++ hs-source-dirs: src default-language: Haskell2010- ghc-options: -Wall -O2+ ghc-options: -Wall -O2 test-suite test default-language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Main.hs- ghc-options: -Wall -O2+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -Wall -O2 build-depends:- , base >=4.11.1 && <5+ , base >=4.11.1 && <5 , byteslice , bytestring , primitive , tasty , tasty-hunit , xml-syntax++source-repository head+ type: git+ location: git://github.com/byteverse/xml-syntax.git