hw-xml 0.5.1.0 → 0.5.1.1
raw patch · 13 files changed
+180/−128 lines, 13 filesdep ~criteriondep ~doctestdep ~ghc-primPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: criterion, doctest, ghc-prim, hedgehog, hspec, optparse-applicative, text, transformers, vector
API changes (from Hackage documentation)
- HaskellWorks.Data.Xml.Value: attributes :: HasValue c_aJ8R => Traversal' c_aJ8R [(Text, Text)]
+ HaskellWorks.Data.Xml.Value: attributes :: HasValue c_ayjY => Traversal' c_ayjY [(Text, Text)]
- HaskellWorks.Data.Xml.Value: cdata :: HasValue c_aJ8R => Traversal' c_aJ8R Text
+ HaskellWorks.Data.Xml.Value: cdata :: HasValue c_ayjY => Traversal' c_ayjY Text
- HaskellWorks.Data.Xml.Value: childNodes :: HasValue c_aJ8R => Traversal' c_aJ8R [Value]
+ HaskellWorks.Data.Xml.Value: childNodes :: HasValue c_ayjY => Traversal' c_ayjY [Value]
- HaskellWorks.Data.Xml.Value: class HasValue c_aJ8R
+ HaskellWorks.Data.Xml.Value: class HasValue c_ayjY
- HaskellWorks.Data.Xml.Value: comment :: HasValue c_aJ8R => Traversal' c_aJ8R Text
+ HaskellWorks.Data.Xml.Value: comment :: HasValue c_ayjY => Traversal' c_ayjY Text
- HaskellWorks.Data.Xml.Value: errorMessage :: HasValue c_aJ8R => Traversal' c_aJ8R Text
+ HaskellWorks.Data.Xml.Value: errorMessage :: HasValue c_ayjY => Traversal' c_ayjY Text
- HaskellWorks.Data.Xml.Value: name :: HasValue c_aJ8R => Traversal' c_aJ8R Text
+ HaskellWorks.Data.Xml.Value: name :: HasValue c_ayjY => Traversal' c_ayjY Text
- HaskellWorks.Data.Xml.Value: textValue :: HasValue c_aJ8R => Traversal' c_aJ8R Text
+ HaskellWorks.Data.Xml.Value: textValue :: HasValue c_ayjY => Traversal' c_ayjY Text
- HaskellWorks.Data.Xml.Value: value :: HasValue c_aJ8R => Lens' c_aJ8R Value
+ HaskellWorks.Data.Xml.Value: value :: HasValue c_ayjY => Lens' c_ayjY Value
Files
- hw-xml.cabal +15/−14
- src/HaskellWorks/Data/Xml/DecodeResult.hs +0/−3
- src/HaskellWorks/Data/Xml/Internal/Blank.hs +12/−9
- src/HaskellWorks/Data/Xml/Type.hs +7/−7
- test/HaskellWorks/Data/Xml/Internal/BlankSpec.hs +2/−2
- test/HaskellWorks/Data/Xml/RawValueSpec.hs +3/−2
- test/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParensSpec.hs +4/−4
- test/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXmlSpec.hs +1/−1
- test/HaskellWorks/Data/Xml/Succinct/Cursor/InterestBitsSpec.hs +2/−2
- test/HaskellWorks/Data/Xml/Succinct/CursorSpec.hs +14/−80
- test/HaskellWorks/Data/Xml/Succinct/CursorSpec/Make.hs +116/−0
- test/HaskellWorks/Data/Xml/Token/TokenizeSpec.hs +1/−1
- test/HaskellWorks/Data/Xml/TypeSpec.hs +3/−3
hw-xml.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-xml-version: 0.5.1.0+version: 0.5.1.1 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@@ -10,11 +10,11 @@ author: John Ky, Alexey Raga maintainer: alexey.raga@gmail.com-copyright: 2016-2020 John Ky+copyright: 2016-2021 John Ky , 2016-2019 Alexey Raga license: BSD-3-Clause license-file: LICENSE-tested-with: GHC == 8.10.1, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4+tested-with: GHC == 9.2.2, GHC == 9.0.2, GHC == 8.10.7, GHC == 8.8.4, GHC == 8.6.5 build-type: Simple extra-source-files: README.md data-files: data/catalog.xml@@ -27,32 +27,32 @@ common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.9 && < 0.7 } common array { build-depends: array >= 0.5.2.0 && < 0.6 }-common attoparsec { build-depends: attoparsec >= 0.13.2.2 && < 0.14 }-common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.11 }+common attoparsec { build-depends: attoparsec >= 0.13.2.2 && < 0.15 }+common bytestring { build-depends: bytestring >= 0.10.8.2 && < 0.12 } common cereal { build-depends: cereal >= 0.5.8.1 && < 0.6 } common containers { build-depends: containers >= 0.5.10.2 && < 0.7 } common criterion { build-depends: criterion >= 1.5.5.0 && < 1.6 } common deepseq { build-depends: deepseq >= 1.4.3.0 && < 1.5 }-common doctest { build-depends: doctest >= 0.16.2 && < 0.17 }+common doctest { build-depends: doctest >= 0.16.2 && < 0.21 } common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 }-common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 1.3 }-common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.7 }-common hedgehog { build-depends: hedgehog >= 1.0 && < 1.1 }+common generic-lens { build-depends: generic-lens >= 2.2 && < 2.3 }+common ghc-prim { build-depends: ghc-prim >= 0.5 && < 0.9 }+common hedgehog { build-depends: hedgehog >= 1.0 && < 1.2 } common hspec { build-depends: hspec >= 2.5 && < 3.0 }-common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.1 && < 0.4 }+common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.1 && < 0.5 } common hw-bits { build-depends: hw-bits >= 0.7.0.9 && < 0.8 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 } common hw-parser { build-depends: hw-parser >= 0.1.0.1 && < 0.2 } common hw-prim { build-depends: hw-prim >= 0.6.2.39 && < 0.7 } common hw-rankselect { build-depends: hw-rankselect >= 0.13.2.0 && < 0.14 } common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 }-common lens { build-depends: lens >= 4.17.1 && < 5.0 }+common lens { build-depends: lens >= 4.17.1 && < 6 } common mmap { build-depends: mmap >= 0.5.9 && < 0.6 } common mtl { build-depends: mtl >= 2.2.2 && < 3 }-common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 && < 0.16 }+common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 && < 0.18 } common resourcet { build-depends: resourcet >= 1.2.2 && < 1.3 } common text { build-depends: text >= 1.2.3.2 && < 1.3 }-common transformers { build-depends: transformers >= 0.5 && < 0.6 }+common transformers { build-depends: transformers >= 0.5 && < 0.7 } common vector { build-depends: vector >= 0.12.0.3 && < 0.13 } common word8 { build-depends: word8 >= 0.1.3 && < 0.2 } @@ -190,6 +190,7 @@ HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXmlSpec HaskellWorks.Data.Xml.Succinct.Cursor.InterestBitsSpec+ HaskellWorks.Data.Xml.Succinct.CursorSpec.Make HaskellWorks.Data.Xml.Succinct.CursorSpec HaskellWorks.Data.Xml.Token.TokenizeSpec HaskellWorks.Data.Xml.TypeSpec@@ -216,7 +217,7 @@ , doctest-discover , hw-xml type: exitcode-stdio-1.0- ghc-options: -threaded+ ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: DoctestDriver.hs HS-Source-Dirs: doctest build-tool-depends: doctest-discover:doctest-discover
src/HaskellWorks/Data/Xml/DecodeResult.hs view
@@ -21,9 +21,6 @@ {-# INLINE (<*>) #-} instance Monad DecodeResult where- return = DecodeOk- {-# INLINE return #-}- (>>=) (DecodeOk a) f = f a (>>=) (DecodeFailed e) _ = DecodeFailed e {-# INLINE (>>=) #-}
src/HaskellWorks/Data/Xml/Internal/Blank.hs view
@@ -60,15 +60,18 @@ blankXmlRun :: Bool -> Word8 -> Word8 -> ByteString -> BlankState -> [ByteString] -> [ByteString] blankXmlRun done a b cs lastState is = do- let (!ds, Just (BlankData !nextState _ _ _)) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)- let (yy, zz) = case BS.unsnoc cs of- Just (ys, z) -> case BS.unsnoc ys of- Just (_, y) -> (y, z)- Nothing -> (b, z)- Nothing -> (a, b)- if done- then [ds]- else ds:blankXmlPlan2 yy zz nextState is+ let (!ds, mState) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)+ case mState of+ Just (BlankData !nextState _ _ _) -> do+ let (yy, zz) = case BS.unsnoc cs of+ Just (ys, z) -> case BS.unsnoc ys of+ Just (_, y) -> (y, z)+ Nothing -> (b, z)+ Nothing -> (a, b)+ if done+ then [ds]+ else ds:blankXmlPlan2 yy zz nextState is+ Nothing -> error "No state: blankXmlRun" mkNext :: Word8 -> BlankState -> Word8 -> ByteString -> Maybe (Word8, BlankData) mkNext w s a bs = case BS.uncons bs of
src/HaskellWorks/Data/Xml/Type.hs view
@@ -18,7 +18,7 @@ import qualified Data.ByteString as BS import qualified HaskellWorks.Data.BalancedParens as BP -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{- HLINT ignore "Reduce duplication" -} data XmlType = XmlTypeElement@@ -32,9 +32,9 @@ instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlTypeAt (XmlCursor String v w) where xmlTypeAtPosition p k = case drop (toCount p) (cursorText k) of- c:_ | fromIntegral (ord c) == _less -> Just XmlTypeElement- c:_ | W8.isSpace $ fromIntegral (ord c) -> Just XmlTypeAttrList- _ -> Just XmlTypeToken+ c:_ | fromIntegral (ord c) == _less -> Just XmlTypeElement+ c:_ | W8.isSpace $ fromIntegral (ord c) -> Just XmlTypeAttrList+ _ -> Just XmlTypeToken xmlTypeAt k = xmlTypeAtPosition p k where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))@@ -43,9 +43,9 @@ instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => XmlTypeAt (XmlCursor BS.ByteString v w) where xmlTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of- Just (c, _) | c == _less -> Just XmlTypeElement- Just (c, _) | W8.isSpace c -> Just XmlTypeAttrList- _ -> Just XmlTypeToken+ Just (c, _) | c == _less -> Just XmlTypeElement+ Just (c, _) | W8.isSpace c -> Just XmlTypeAttrList+ _ -> Just XmlTypeToken xmlTypeAt k = xmlTypeAtPosition p k where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))
test/HaskellWorks/Data/Xml/Internal/BlankSpec.hs view
@@ -14,8 +14,8 @@ import qualified Hedgehog.Gen as G import qualified Hedgehog.Range as R -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Reduce duplication" -} whenBlankedXmlShouldBe :: BS.ByteString -> BS.ByteString -> Spec whenBlankedXmlShouldBe original expected = do
test/HaskellWorks/Data/Xml/RawValueSpec.hs view
@@ -35,8 +35,9 @@ import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.TreeCursor as TC -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant return" -}+{- HLINT ignore "Reduce duplication" -} fc = TC.firstChild ns = TC.nextSibling
test/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParensSpec.hs view
@@ -18,7 +18,7 @@ import qualified Data.ByteString as BS -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{- HLINT ignore "Redundant do" -} spec :: Spec spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec" $ do@@ -52,7 +52,7 @@ annotate $ "Good: " <> show chunkedBlank bp === fromString "11101010 10001101 01010100" - it "Blanking XML should work 3" $ requireTest $do+ it "Blanking XML should work 3" $ requireTest $ do let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBadBlank)) annotate $ "Bad: " <> show chunkedBadBlank bp === fromString "11101010 10001101 01010100"@@ -62,10 +62,10 @@ let whole = mkBlank 4096 document let chunked = mkBlank 15 document - it "should BP the same with chanks" $ requireTest $do+ it "should BP the same with chanks" $ requireTest $ do BS.concat chunked === BS.concat whole - it "should produce same bits" $ requireTest $do+ it "should produce same bits" $ requireTest $ do BS.concat (mkBits chunked) === BS.concat (mkBits whole)
test/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXmlSpec.hs view
@@ -10,7 +10,7 @@ import Hedgehog import Test.Hspec -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{- HLINT ignore "Redundant do" -} spec :: Spec spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXmlSpec" $ do
test/HaskellWorks/Data/Xml/Succinct/Cursor/InterestBitsSpec.hs view
@@ -16,7 +16,7 @@ import qualified Data.ByteString as BS import qualified Data.Vector.Storable as DVS -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{- HLINT ignore "Redundant do" -} interestBitsOf :: FromBlankedXml (XmlInterestBits a) => BS.ByteString -> a interestBitsOf = getXmlInterestBits . fromBlankedXml . bsToBlankedXml@@ -33,7 +33,7 @@ (interestBitsOf " <e p='a'/> " :: BitShown (DVS.Vector Word8)) === fromString "01011010 00000000" (interestBitsOf " <!-- u -->" :: BitShown (DVS.Vector Word8)) === fromString "01000000 00000000" (interestBitsOf "<![CDATA[ x" :: BitShown (DVS.Vector Word8)) === fromString "10000000 00000000"- it "Can build interest bits across boundaries" $ requireTest $do+ it "Can build interest bits across boundaries" $ requireTest $ do let blanked = [ "< (a " , " v "
test/HaskellWorks/Data/Xml/Succinct/CursorSpec.hs view
@@ -24,6 +24,7 @@ import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.RankSelect.Poppy512 import HaskellWorks.Data.Xml.Succinct.Cursor as C+import HaskellWorks.Data.Xml.Succinct.CursorSpec.Make import HaskellWorks.Data.Xml.Token import HaskellWorks.Hspec.Hedgehog import Hedgehog@@ -37,9 +38,9 @@ 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) #-}-{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Reduce duplication" -} fc = TC.firstChild ns = TC.nextSibling@@ -49,16 +50,16 @@ spec :: Spec spec = describe "HaskellWorks.Data.Xml.Succinct.CursorSpec" $ do- 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+ make "DVS.Vector Word8" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word8 )) (SimpleBalancedParens (DVS.Vector Word8 )))+ make "DVS.Vector Word16" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))+ make "DVS.Vector Word32" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))+ make "DVS.Vector Word64" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ make "Poppy512" (BS.fromByteString :: BS.ByteString -> XmlCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))+ make "DVS.Vector Word8" CC.byteStringAsFastCursor+ make "DVS.Vector Word16" CC.byteStringAsFastCursor+ make "DVS.Vector Word32" CC.byteStringAsFastCursor+ make "DVS.Vector Word64" CC.byteStringAsFastCursor+ make "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))@@ -77,70 +78,3 @@ shouldBeginWith :: (Eq a, Show a) => [a] -> [a] -> PropertyT IO () shouldBeginWith as bs = take (length bs) as === bs--genSpec :: forall t u.- ( Select1 t- , Rank0 u- , Rank1 u- , BalancedParens u- , TestBit u- )- => String -> (BS.ByteString -> XmlCursor BS.ByteString t u) -> SpecWith ()-genSpec t mkCursor = do- describe ("Cursor for (" ++ t ++ ")") $ do- let forXml bs f = let cursor = mkCursor bs in describe (T.unpack ("of value " <> T.decodeUtf8 bs)) (f cursor)- forXml "[null]" $ \cursor -> do- 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- (fc >=> ns >=> cd) cursor === Just 2- xit "depth at first child of object at second child of array" $ requireTest $ do- (fc >=> ns >=> fc >=> cd) cursor === Just 3- xit "depth at first child of object at second child of array" $ requireTest $ do- (fc >=> ns >=> fc >=> ns >=> cd) cursor === Just 3-- describe "For sample XML" $ do- let cursor = mkCursor "<widget debug=\"on\"> \- \ <window name=\"main_window\"> \- \ <dimension>500</dimension> \- \ <dimension>600.01e-02</dimension> \- \ <dimension> false </dimension> \- \ </window> \- \</widget>" :: XmlCursor BS.ByteString t u- xit "can get token at cursor" $ requireTest $ do- (xmlTokenAt ) cursor === Just (XmlTokenBraceL )- (fc >=> xmlTokenAt) cursor === Just (XmlTokenString "widget" )- (fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL )- (fc >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "debug" )- (fc >=> ns >=> fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "on" )- (fc >=> ns >=> fc >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "window" )- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL )- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "name" )- (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 get subtree size" $ requireTest $ do- ( ss) cursor === Just 16- (fc >=> ss) cursor === Just 1- (fc >=> ns >=> ss) cursor === Just 14- (fc >=> ns >=> fc >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6
+ test/HaskellWorks/Data/Xml/Succinct/CursorSpec/Make.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Xml.Succinct.CursorSpec.Make+ ( make+ ) where++import Control.Monad+import Data.Word+import HaskellWorks.Data.BalancedParens.BalancedParens+import HaskellWorks.Data.BalancedParens.Simple+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.RankSelect.Base.Rank0+import HaskellWorks.Data.RankSelect.Base.Rank1+import HaskellWorks.Data.RankSelect.Base.Select1+import HaskellWorks.Data.RankSelect.Poppy512+import HaskellWorks.Data.Xml.Succinct.Cursor as C+import HaskellWorks.Data.Xml.Token+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec++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++{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Reduce duplication" -}++fc = TC.firstChild+ns = TC.nextSibling+pn = TC.parent+cd = TC.depth+ss = TC.subtreeSize++make :: forall t u.+ ( Select1 t+ , Rank0 u+ , Rank1 u+ , BalancedParens u+ , TestBit u+ )+ => String -> (BS.ByteString -> XmlCursor BS.ByteString t u) -> SpecWith ()+make t mkCursor = do+ describe ("Cursor for (" ++ t ++ ")") $ do+ let forXml bs f = let cursor = mkCursor bs in describe (T.unpack ("of value " <> T.decodeUtf8 bs)) (f cursor)+ forXml "[null]" $ \cursor -> do+ 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+ (fc >=> ns >=> cd) cursor === Just 2+ xit "depth at first child of object at second child of array" $ requireTest $ do+ (fc >=> ns >=> fc >=> cd) cursor === Just 3+ xit "depth at first child of object at second child of array" $ requireTest $ do+ (fc >=> ns >=> fc >=> ns >=> cd) cursor === Just 3++ describe "For sample XML" $ do+ let cursor = mkCursor "<widget debug=\"on\"> \+ \ <window name=\"main_window\"> \+ \ <dimension>500</dimension> \+ \ <dimension>600.01e-02</dimension> \+ \ <dimension> false </dimension> \+ \ </window> \+ \</widget>" :: XmlCursor BS.ByteString t u+ xit "can get token at cursor" $ requireTest $ do+ (xmlTokenAt ) cursor === Just (XmlTokenBraceL )+ (fc >=> xmlTokenAt) cursor === Just (XmlTokenString "widget" )+ (fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL )+ (fc >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "debug" )+ (fc >=> ns >=> fc >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "on" )+ (fc >=> ns >=> fc >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenString "window" )+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> xmlTokenAt) cursor === Just (XmlTokenBraceL )+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> xmlTokenAt) cursor === Just (XmlTokenString "name" )+ (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 get subtree size" $ requireTest $ do+ ( ss) cursor === Just 16+ (fc >=> ss) cursor === Just 1+ (fc >=> ns >=> ss) cursor === Just 14+ (fc >=> ns >=> fc >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6
test/HaskellWorks/Data/Xml/Token/TokenizeSpec.hs view
@@ -11,7 +11,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as BC import qualified Data.ByteString as BS -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{- HLINT ignore "Redundant do" -} parseXmlToken' :: ByteString -> Either String (XmlToken String Double) parseXmlToken' = BC.parseOnly parseXmlToken
test/HaskellWorks/Data/Xml/TypeSpec.hs view
@@ -33,9 +33,9 @@ import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.TreeCursor as TC -{-# ANN module ("HLint: ignore Redundant do" :: String) #-}-{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}-{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-}+{- HLINT ignore "Redundant do" -}+{- HLINT ignore "Redundant bracket" -}+{- HLINT ignore "Reduce duplication" -} fc = TC.firstChild ns = TC.nextSibling