Add time benchmark for SAX parsers

Author: 4e6

README.md

@@ -12,12 +12,17 @@ stack exec generate
 
 ## Time
 
-Conversion from `ByteString` to DOM
+Columns:
+
+- Name - name of the package on Hackage
+- Language - pure Haskell or a C binding
 
 ``` bash
 stack bench
 ```
 
+Conversion from `ByteString` to DOM
+
 | Name | Language | Time |
 |------|----------|------|
 | hexml | C | 1.787 ms |
@@ -26,6 +31,15 @@ stack bench
 | hexpat | C | 133.4 ms |
 | xml-conduit | Haskell | 173.7 ms |
 
+Conversion from `ByteString` to a list of SAX events
+
+| Name | Language | Time |
+|------|----------|------|
+| xeno | Haskell | 31.24 ms |
+| sax | Haskell | 34.69 ms |
+| hexpat | C | 74.84 ms |
+| conduit | Haskell | 196.1 ms |
+
 ## Space
 
 ``` bash

Time.hs

@@ -1,37 +1,104 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Main (main) where
 
+import           Control.DeepSeq
 import           Criterion.Main
 import           Criterion.Types
 import           Data.Book
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy
+import qualified Data.Conduit
+import qualified Data.Conduit.List
 import           Data.Default
 import           Data.FileEmbed
+import           GHC.Generics (Generic)
+import qualified SAX
+import qualified SAX.Streaming
+import qualified Streaming.Prelude
 import qualified Text.XML
 import qualified Text.XML.DOM.Parser
+import qualified Text.XML.Expat.SAX
 import qualified Text.XML.Expat.Tree
 import qualified Text.XML.Hexml
+import qualified Text.XML.Stream.Parse
 import qualified Xeno.DOM
+import qualified Xeno.SAX
 import qualified Xmlbf
 import qualified Xmlbf.Xeno
 #ifdef LIBXML
 import qualified Text.XML.LibXML
 #endif
 
+data XenoEvent
+  = OpenTag ByteString
+  | EndOpenTag ByteString
+  | CloseTag ByteString
+  | Attribute ByteString ByteString
+  | Text ByteString
+  | CDATA ByteString
+  deriving (Generic)
+
+instance NFData XenoEvent
+
 main :: IO ()
 main = defaultMainWith
   defaultConfig { csvFile = Just "out.csv" }
-  [ bgroup "dom" (dom inputBs)
-  -- , bgroup "struct" (struct inputBs)
+  [ bgroup "sax" (sax inputBs)
+  , bgroup "dom" (dom inputBs)
+  , bgroup "struct" (struct inputBs)
   ]
 
--- | Conversion from 'Data.ByteString.ByteString' to DOM
-dom :: Data.ByteString.ByteString -> [Benchmark]
+-- | Conversion from 'ByteString' to a list of SAX events
+sax :: ByteString -> [Benchmark]
+sax bs =
+  [ bench "xeno fold list" $ nf
+    ( Xeno.SAX.fold
+      (\v   -> (:v) . OpenTag)
+      (\v k -> (:v) . Attribute k)
+      (\v   -> (:v) . EndOpenTag)
+      (\v   -> (:v) . Text)
+      (\v   -> (:v) . CloseTag)
+      (\v   -> (:v) . CDATA)
+      mempty )
+    bs
+  , bench "xeno process conduit" $ nf
+    ( \input ->
+        let
+          parseBs = Xeno.SAX.process
+            (Data.Conduit.yield . OpenTag)
+            (\k -> Data.Conduit.yield . Attribute k)
+            (Data.Conduit.yield . EndOpenTag)
+            (Data.Conduit.yield . Text)
+            (Data.Conduit.yield . CloseTag)
+            (Data.Conduit.yield . CDATA)
+            input
+        in case Data.Conduit.connect parseBs Data.Conduit.List.consume of
+          Nothing -> error "Unexpected parse error"
+          Just v  -> v )
+    bs
+  , bench "sax" $ nf
+    ( \input -> case Streaming.Prelude.toList_ (SAX.Streaming.streamXml input) of
+        Left _  -> error "Unexpected parse error"
+        Right v -> v )
+    bs
+  , bench "hexpat" $ nf
+    ( Text.XML.Expat.SAX.parse @ByteString @ByteString Text.XML.Expat.SAX.defaultParseOptions )
+    ( Data.ByteString.Lazy.fromStrict bs )
+  , bench "conduit" $ nf
+    ( \input -> case Data.Conduit.connect (Text.XML.Stream.Parse.parseLBS def input) Data.Conduit.List.consume of
+        Nothing -> error "Unexpected parse error"
+        Just v  -> v )
+    ( Data.ByteString.Lazy.fromStrict bs )
+  ]
+
+-- | Conversion from 'ByteString' to DOM
+dom :: ByteString -> [Benchmark]
 dom bs =
   [ bench "hexml" $ whnf
     ( \input -> case Text.XML.Hexml.parse input of
@@ -59,13 +126,7 @@ dom bs =
 -- | Conversion from DOM to data type
 struct :: ByteString -> [Benchmark]
 struct bs =
-  [ bench "dom-parser" $ nf
-    ( \doc -> case Text.XML.DOM.Parser.runDomParser doc (Text.XML.DOM.Parser.fromDom @Catalog) of
-        Left _  -> error "Unexpected conversion error"
-        Right v -> v )
-    ( Text.XML.parseLBS_ def (Data.ByteString.Lazy.fromStrict bs) )
-  -- TODO: https://gitlab.com/k0001/xmlbf/issues/6
-  , bench "xmlbf-xeno" $ nf
+  [ bench "xmlbf-xeno" $ nf
     ( \case
         Left _  -> error "Unexpected parse error"
         Right n -> case Xmlbf.Xeno.element n of
@@ -74,7 +135,22 @@ struct bs =
             Left e  -> error e
             Right v -> v )
     ( Xeno.DOM.parse inputBs )
+  -- TODO: Fix @SAX.Fail "fail handler"@ error
+  -- , bench "sax" $ nf
+  --   ( \stream -> case SAX.parseSax rootSaxParser stream of
+  --       SAX.Partial _ _ _ -> error "Unexpected conversion error: Partial"
+  --       SAX.Done r        -> r
+  --       SAX.Fail e        -> error $ "Unexpected conversion error: Fail " ++ e )
+  --   ( SAX.Streaming.streamXml bs )
+  , bench "dom-parser" $ nf
+    ( \doc -> case Text.XML.DOM.Parser.runDomParser doc (Text.XML.DOM.Parser.fromDom @Catalog) of
+        Left _  -> error "Unexpected conversion error"
+        Right v -> v )
+    ( Text.XML.parseLBS_ def (Data.ByteString.Lazy.fromStrict bs) )
   ]
 
 inputBs :: ByteString
 inputBs = $(embedFile "in.xml")
+
+-- Assuming that SAX representation is strict (NF=WHNF)
+instance NFData SAX.Streaming.SaxEvent where rnf = rwhnf

haskell-perf-xml.cabal

@@ -8,20 +8,21 @@ cabal-version:       >=1.10
 
 flag libxml
   description: Enable libxml benchmarks
-  default:    False
+  default:     False
 
 library
   exposed-modules:  Data.Book
   build-depends:    base
                   , QuickCheck
+                  , bytestring
                   , deepseq
                   , dom-parser
+                  , sax
                   , text
                   , time
                   , xml-conduit-writer
                   , xmlbf
                   , xmlbf-xeno
-                  , bytestring
   hs-source-dirs:   src
   default-language: Haskell2010
   ghc-options:      -Wall
@@ -64,13 +65,17 @@ benchmark time
   main-is:          Time.hs
   build-depends:    base
                   , bytestring
+                  , conduit
                   , criterion
                   , data-default
+                  , deepseq
                   , dom-parser
                   , file-embed
                   , haskell-perf-xml
                   , hexml
                   , hexpat
+                  , sax
+                  , streaming
                   , xeno
                   , xml-conduit
                   , xmlbf

src/Data/Book.hs

@@ -10,8 +10,10 @@ import           Data.Char
 import           Data.Fixed
 import           Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import           Data.Time
 import           GHC.Generics (Generic)
+import qualified SAX
 import           Test.QuickCheck
 import qualified Text.XML.DOM.Parser as XDP
 import qualified Text.XML.Writer as XW
@@ -86,6 +88,17 @@ instance Xmlbf.FromXml Book where
     <*> Xmlbf.pElement "publish_date" (Xmlbf.pText >>= parseTimeM True defaultTimeLocale "%F" . T.unpack)
     <*> Xmlbf.pElement "description" Xmlbf.pText
 
+bookSaxParser :: SAX.SaxParser Book
+bookSaxParser = SAX.withTag "book" $ Book
+  <$> SAX.withTag "author" saxText
+  <*> SAX.withTag "title" saxText
+  <*> SAX.withTag "genre" saxText
+  <*> SAX.withTag "price" (read . T.unpack <$> saxText)
+  <*> SAX.withTag "publish_date" (saxText >>= parseTimeM True defaultTimeLocale "%F" . T.unpack)
+  <*> SAX.withTag "description" saxText
+  where
+    saxText = T.decodeUtf8 <$> SAX.bytes
+
 newtype Catalog = Catalog [Book]
   deriving (Generic, NFData)
 
@@ -102,9 +115,17 @@ instance Xmlbf.FromXml Catalog where
   fromXml = Xmlbf.pElement "catalog" $ Catalog
     <$> many Xmlbf.fromXml
 
+catalogSaxParser :: SAX.SaxParser Catalog
+catalogSaxParser = SAX.withTag "catalog" $ Catalog
+  <$> many bookSaxParser
+
 newtype Root = Root Catalog
   deriving (Generic, NFData)
 
 instance Xmlbf.FromXml Root where
   fromXml = Xmlbf.pElement "root" $ Root
     <$> Xmlbf.fromXml
+
+rootSaxParser :: SAX.SaxParser Root
+rootSaxParser = SAX.withTag "root" $ Root
+  <$> catalogSaxParser

stack.yaml

@@ -2,5 +2,7 @@ resolver: lts-11.1
 extra-deps:
   - html-entities-1.1.4.2
   - libxml-0.1.1
-  - xmlbf-0.3
+  - xmlbf-0.4
   - xmlbf-xeno-0.1.1
+  - git: https://github.com/dredozubov/sax-parser.git
+    commit: 4eb65a8b20878311eae25a16583d4790a66400b9