hw-xml 0.4.0.2 → 0.4.0.3

raw patch · 4 files changed

+74/−38 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hw-xml.cabal +3/−1
• src/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXml.hs +4/−5
• test/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXmlSpec.hs +30/−0
• test/HaskellWorks/Data/Xml/Succinct/CursorSpec.hs +37/−32

@@ -1,7 +1,7 @@ cabal-version: 2.2  name:                 hw-xml-version:              0.4.0.2+version:              0.4.0.3 synopsis:             XML parser based on succinct data structures. description:          XML parser based on succinct data structures. Please see README.md category:             Data, XML, Succinct Data Structures, Data Structures@@ -174,6 +174,7 @@                     , hw-xml                     , hw-rankselect                     , hw-rankselect-base+                    , text                     , vector   type:               exitcode-stdio-1.0   main-is:            Spec.hs@@ -185,6 +186,7 @@   other-modules:      HaskellWorks.Data.Xml.Internal.BlankSpec                       HaskellWorks.Data.Xml.RawValueSpec                       HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec+                      HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXmlSpec                       HaskellWorks.Data.Xml.Succinct.Cursor.InterestBitsSpec                       HaskellWorks.Data.Xml.Succinct.CursorSpec                       HaskellWorks.Data.Xml.Token.TokenizeSpec

@@ -11,9 +11,8 @@ import GHC.Generics import HaskellWorks.Data.Xml.Internal.Blank -import qualified Data.ByteString              as BS-import qualified Data.ByteString.Lazy         as LBS-import qualified HaskellWorks.Data.ByteString as BS+import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as LBS  newtype BlankedXml = BlankedXml   { unblankedXml :: [BS.ByteString]@@ -26,7 +25,7 @@   fromBlankedXml :: BlankedXml -> a  bsToBlankedXml :: BS.ByteString -> BlankedXml-bsToBlankedXml bs = BlankedXml (blankXml (BS.chunkedBy 4064 bs))+bsToBlankedXml bs = BlankedXml (blankXml [bs])  lbsToBlankedXml :: LBS.ByteString -> BlankedXml-lbsToBlankedXml lbs = BlankedXml (blankXml (BS.resegmentPadded 4096 (LBS.toChunks lbs)))+lbsToBlankedXml lbs = BlankedXml (blankXml (LBS.toChunks lbs))

@@ -0,0 +1,30 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}++module HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXmlSpec+  ( spec+  ) where++import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++{-# ANN module ("HLint: Ignore Redundant do"        :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXmlSpec" $ do+  describe "Blanking XML should work" $ do+    it "on strict bytestrings" $ requireTest $ do+      let input       = "<attack><instances/></attack>"+      let expected    = "<       <          >        >"+      let blankedXml  = bsToBlankedXml input++      mconcat (unblankedXml blankedXml) === expected++    it "on lazy bytestrings" $ requireTest $ do+      let input       = "<attack><instances/></attack>"+      let expected    = "<       <          >        >"+      let blankedXml  = lbsToBlankedXml input++      mconcat (unblankedXml blankedXml) === expected

@@ -6,13 +6,14 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings         #-} {-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}  {-# OPTIONS_GHC -fno-warn-missing-signatures #-}  module HaskellWorks.Data.Xml.Succinct.CursorSpec(spec) where  import Control.Monad-import Data.String+import Data.Semigroup                                  ((<>)) import Data.Word import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.BalancedParens.Simple@@ -29,9 +30,13 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString              as BS-import qualified Data.Vector.Storable         as DVS-import qualified HaskellWorks.Data.TreeCursor as TC+import qualified Data.ByteString                              as BS+import qualified Data.Text                                    as T+import qualified Data.Text.Encoding                           as T+import qualified Data.Vector.Storable                         as DVS+import qualified HaskellWorks.Data.FromByteString             as BS+import qualified HaskellWorks.Data.TreeCursor                 as TC+import qualified HaskellWorks.Data.Xml.Succinct.Cursor.Create as CC  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}@@ -45,11 +50,16 @@  spec :: Spec spec = describe "HaskellWorks.Data.Xml.Succinct.CursorSpec" $ do-  genSpec "DVS.Vector Word8"  (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))-  genSpec "DVS.Vector Word16" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))-  genSpec "DVS.Vector Word32" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))-  genSpec "DVS.Vector Word64" (undefined :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))-  genSpec "Poppy512"          (undefined :: XmlCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "DVS.Vector Word8"  (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word8 )) (SimpleBalancedParens (DVS.Vector Word8 )))+  genSpec "DVS.Vector Word16" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))+  genSpec "DVS.Vector Word32" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))+  genSpec "DVS.Vector Word64" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "Poppy512"          (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString  Poppy512                      (SimpleBalancedParens (DVS.Vector Word64)))+  genSpec "DVS.Vector Word8"  CC.byteStringAsFastCursor+  genSpec "DVS.Vector Word16" CC.byteStringAsFastCursor+  genSpec "DVS.Vector Word32" CC.byteStringAsFastCursor+  genSpec "DVS.Vector Word64" CC.byteStringAsFastCursor+  genSpec "Poppy512"          CC.byteStringAsFastCursor   it "Loads same Xml consistentally from different backing vectors" $ requireTest $ do     let cursor8   = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))     let cursor16  = "{\n    \"widget\": {\n        \"debug\": \"on\"  } }" :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))@@ -70,23 +80,18 @@ shouldBeginWith as bs = take (length bs) as === bs  genSpec :: forall t u.-  ( Eq                t-  , Show              t-  , Select1           t-  , Eq                u-  , Show              u+  ( Select1           t   , Rank0             u   , Rank1             u   , BalancedParens    u   , TestBit           u-  , IsString          (XmlCursor BS.ByteString t u)   )-  => String -> XmlCursor BS.ByteString t u -> SpecWith ()-genSpec t _ = do+  => String -> (BS.ByteString -> XmlCursor BS.ByteString t u) -> SpecWith ()+genSpec t mkCursor = do   describe ("Cursor for (" ++ t ++ ")") $ do-    let forXml (cursor :: XmlCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)+    let forXml bs f = let cursor = mkCursor bs in describe (T.unpack ("of value " <> T.decodeUtf8 bs)) (f cursor)     forXml "[null]" $ \cursor -> do-      it "depth at top"                   $ requireTest $ cd          cursor === Just 1+      xit "depth at top"                  $ requireTest $ cd          cursor === Just 1       xit "depth at first child of array" $ requireTest $ (fc >=> cd) cursor === Just 2     forXml "[null, {\"field\": 1}]" $ \cursor -> do       xit "depth at second child of array" $ requireTest $do@@ -97,7 +102,7 @@         (fc >=> ns >=> fc >=> ns >=> cd) cursor === Just 3      describe "For sample XML" $ do-      let cursor =  "<widget debug=\"on\"> \+      let cursor = mkCursor "<widget debug=\"on\"> \                     \  <window name=\"main_window\"> \                     \    <dimension>500</dimension> \                     \    <dimension>600.01e-02</dimension> \@@ -116,18 +121,18 @@         (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> xmlTokenAt) cursor === Just (XmlTokenString   "main_window" )         (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> xmlTokenAt) cursor === Just (XmlTokenString   "dimensions"  )         (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBracketL               )-      xit "can navigate up" $ requireTest $ do-        (                                                                      pn) cursor === Nothing-        (fc                                                                >=> pn) cursor ===                                    Just cursor-        (fc >=> ns                                                         >=> pn) cursor ===                                    Just cursor-        (fc >=> ns >=> fc                                                  >=> pn) cursor === (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns                                           >=> pn) cursor === (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns                                    >=> pn) cursor === (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> pn) cursor === (fc >=> ns                            ) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor-        (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+      -- xit "can navigate up" $ requireTest $ do+      --   (                                                                      pn) cursor === Nothing+      --   (fc                                                                >=> pn) cursor ===                                    Just cursor+      --   (fc >=> ns                                                         >=> pn) cursor ===                                    Just cursor+      --   (fc >=> ns >=> fc                                                  >=> pn) cursor === (fc >=> ns                            ) cursor+      --   (fc >=> ns >=> fc >=> ns                                           >=> pn) cursor === (fc >=> ns                            ) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns                                    >=> pn) cursor === (fc >=> ns                            ) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns >=> ns                             >=> pn) cursor === (fc >=> ns                            ) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc                      >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns               >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns        >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor+      --   (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor       xit "can get subtree size" $ requireTest $ do         (                                                                      ss) cursor === Just 16         (fc                                                                >=> ss) cursor === Just 1