diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,5 +1,9 @@ + 0.3.4 + * Fixed #14 and add test for #15 + * Fixed typos in the examples (unhammer) + 0.3.2 - Fixed DOM parsing from bystrings with non-zero offset (qrilka) + Fixed DOM parsing from bystrings with non-zero offset (#11, qrilka) 0.3 Fixed name parsing (for attributes and tags) so it conforms with the XML spec (qrilka) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -10,4 +10,6 @@ Kirill Zaborsky ( qrilka ) +Kevin Brubeck Unhammer ( unhammer ) + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -147,12 +147,12 @@ Folding over XML: ``` haskell -> fold const (\m _ _ -> m + 1) const const const 0 input -- Count elements. +> fold const (\m _ _ -> m + 1) const const const const 0 input -- Count attributes. Right 2 ``` ``` haskell -> fold (\m _ -> m + 1) (\m _ _ -> m) const const const 0 input -- Count attributes. +> fold (\m _ -> m + 1) (\m _ _ -> m) const const const const 0 input -- Count elements. Right 3 ``` diff --git a/src/Xeno/SAX.hs b/src/Xeno/SAX.hs --- a/src/Xeno/SAX.hs +++ b/src/Xeno/SAX.hs @@ -1,6 +1,5 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} @@ -29,6 +28,15 @@ -- Helpful interfaces to the parser -- | Parse the XML but return no result, process no events. +-- +-- N.B.: Only the lexical correctness of the input string is checked, not its XML semantics (e.g. only if tags are well formed, not whether tags are properly closed) +-- +-- > > :set -XOverloadedStrings +-- > > validate "" +-- > True +-- +-- > > validate " False validate :: ByteString -> Bool validate s = case spork diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -4,57 +4,58 @@ module Main where +import Data.Either (isRight) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Test.Hspec -import Xeno.SAX -import Xeno.DOM +import Xeno.SAX (validate) +import Xeno.DOM (Content(..), parse, name, contents, attributes, children) import Xeno.Types + main :: IO () main = hspec spec spec :: SpecWith () -spec = +spec = do + describe "Xeno.DOM tests" $ do + it "DOM from bytestring substring" $ do + let substr = BS.drop 5 "5<8& xml" + parsedRoot = fromRightE $ parse substr + name parsedRoot `shouldBe` "valid" + + it "Leading whitespace characters are accepted by parse" $ + isRight (parse "\n") `shouldBe` True + + let doc = + parse + "\n" + + it "children test" $ + map name (children $ fromRightE doc) `shouldBe` ["test", "test", "b", "test", "test"] + + it "attributes" $ + attributes (head (children $ fromRightE doc)) `shouldBe` [("id", "1"), ("extra", "2")] + + it "xml prologue test" $ do + let docWithPrologue = "\nHello, world!" + parsedRoot = fromRightE $ Xeno.DOM.parse docWithPrologue + name parsedRoot `shouldBe` "greeting" + describe "hexml tests" (do mapM_ - (\(v, i) -> it (show i) (shouldBe (Xeno.SAX.validate i) v)) + (\(v, i) -> it (show i) (shouldBe (validate i) v)) (hexml_examples_sax ++ extra_examples_sax) mapM_ - (\(v, i) -> it (show i) (shouldBe (either (Left . show) (Right . id) (contents <$> Xeno.DOM.parse i)) v)) + (\(v, i) -> it (show i) (shouldBe (either (Left . show) (Right . id) (contents <$> parse i)) v)) cdata_tests - let doc = - parse - "\n" - it - "children test" - (shouldBe - (map name (children $ fromRightE doc)) - ["test", "test", "b", "test", "test"]) - it - "attributes" - (shouldBe - (attributes (head (children $ fromRightE doc))) - [("id", "1"), ("extra", "2")]) - - it "xml prologue test" $ do - let docWithPrologue = "\nHello, world!" - parsedRoot = fromRightE $ Xeno.DOM.parse docWithPrologue - name parsedRoot `shouldBe` "greeting" - - it "DOM from bytestring substring" $ do - let substr = BS.drop 5 "5<8& xml" - parsedRoot = fromRightE $ Xeno.DOM.parse substr - name parsedRoot `shouldBe` "valid" - - -- If this works without crashing we're happy. + + -- If this works without crashing we're happy. let nsdoc = "Content." it - "namespaces" - (shouldBe - (Xeno.SAX.validate nsdoc) - True) + "namespaces" $ + validate nsdoc `shouldBe` True ) hexml_examples_sax :: [(Bool, ByteString)] @@ -89,4 +90,11 @@ -- | Horrible hack. Don't try this at home. fromRightE :: Either XenoException a -> a -fromRightE = either (error. show) id +fromRightE = either (error . show) id + + +mapLeft :: Applicative f => (a -> f b) -> Either a b -> f b +mapLeft f = either f pure + +mapRight :: Applicative f => (b -> f a) -> Either a b -> f a +mapRight = either pure diff --git a/xeno.cabal b/xeno.cabal --- a/xeno.cabal +++ b/xeno.cabal @@ -1,5 +1,5 @@ name: xeno -version: 0.3.3 +version: 0.3.4 synopsis: A fast event-based XML parser in pure Haskell description: A fast, low-memory use, event-based XML parser in pure Haskell. build-type: Simple @@ -10,7 +10,7 @@ license-file: LICENSE author: Christopher Done maintainer: Marco Zocca (zocca.marco gmail) -tested-with: GHC == 8.0.1 +tested-with: GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.2 extra-source-files: README.md CHANGELOG.markdown CONTRIBUTORS.md @@ -31,7 +31,8 @@ build-depends: base >= 4.7 && < 5 , bytestring, vector, deepseq, array, mutable-containers, mtl -- , exceptions - -- , hspec + -- | DEBUG + , hspec default-language: Haskell2010 test-suite xeno-test @@ -40,6 +41,8 @@ hs-source-dirs: test main-is: Main.hs build-depends: base, xeno, hexml, hspec, bytestring + -- | DEBUG + , hspec ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010