Skip to content

Commit 14513fb

Browse files
newhoggynewhoggy
committed
Remove conduit remnants
1 parent 1d17918 commit 14513fb

File tree

15 files changed

+113
-106
lines changed

15 files changed

+113
-106
lines changed

‎bench/Main.hs‎

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,14 @@
44
module Main where
55

66
import Criterion.Main
7+
import Data.ByteString (ByteString)
78
import Data.Word
89
import Foreign
910
import HaskellWorks.Data.BalancedParens.Simple
1011
import HaskellWorks.Data.Bits.BitShown
1112
import HaskellWorks.Data.FromByteString
12-
import HaskellWorks.Data.Xml.Conduit
13-
import HaskellWorks.Data.Xml.Conduit.Blank
13+
import HaskellWorks.Data.Xml.Internal.Blank
14+
import HaskellWorks.Data.Xml.Internal.List
1415
import HaskellWorks.Data.Xml.Internal.Tables
1516
import HaskellWorks.Data.Xml.Succinct.Cursor
1617
import System.IO.MMap
@@ -19,23 +20,23 @@ import qualified Data.ByteString as BS
1920
import qualified Data.ByteString.Internal as BSI
2021
import qualified Data.Vector.Storable as DVS
2122

22-
setupEnvXml :: FilePath -> IO BS.ByteString
23+
setupEnvXml :: FilePath -> IO ByteString
2324
setupEnvXml filepath = do
2425
(fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing
2526
let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size
2627
return bs
2728

28-
loadXml :: BS.ByteString -> XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))
29-
loadXml bs = fromByteString bs :: XmlCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))
29+
loadXml :: ByteString -> XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))
30+
loadXml bs = fromByteString bs :: XmlCursor ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))
3031

31-
xmlToInterestBits3 :: [BS.ByteString] -> [BS.ByteString]
32+
xmlToInterestBits3 :: [ByteString] -> [ByteString]
3233
xmlToInterestBits3 = blankedXmlToInterestBits . blankXml
3334

34-
runCon :: ([i] -> [BS.ByteString]) -> i -> BS.ByteString
35+
runCon :: ([i] -> [ByteString]) -> i -> ByteString
3536
runCon con bs = BS.concat $ con [bs]
3637

37-
benchRankXmlCatalogConduits :: [Benchmark]
38-
benchRankXmlCatalogConduits =
38+
benchRankXmlCatalogLists :: [Benchmark]
39+
benchRankXmlCatalogLists =
3940
[ env (setupEnvXml "data/catalog.xml") $ \bs -> bgroup "catalog.xml"
4041
[ bench "Run blankXml" (whnf (runCon blankXml ) bs)
4142
, bench "Run xmlToInterestBits3" (whnf (runCon xmlToInterestBits3) bs)
@@ -58,5 +59,5 @@ benchIsInterestingWord8 =
5859
main :: IO ()
5960
main = defaultMain $ concat
6061
[ benchIsInterestingWord8
61-
, benchRankXmlCatalogConduits
62+
, benchRankXmlCatalogLists
6263
]

‎hw-xml.cabal‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -85,18 +85,18 @@ library
8585
HaskellWorks.Data.Xml
8686
HaskellWorks.Data.Xml.Blank
8787
HaskellWorks.Data.Xml.CharLike
88-
HaskellWorks.Data.Xml.Conduit
89-
HaskellWorks.Data.Xml.Conduit.Blank
90-
HaskellWorks.Data.Xml.Conduit.Words
9188
HaskellWorks.Data.Xml.Decode
9289
HaskellWorks.Data.Xml.DecodeError
9390
HaskellWorks.Data.Xml.DecodeResult
9491
HaskellWorks.Data.Xml.Grammar
9592
HaskellWorks.Data.Xml.Index
9693
HaskellWorks.Data.Xml.Internal.BalancedParens
9794
HaskellWorks.Data.Xml.Internal.ByteString
95+
HaskellWorks.Data.Xml.Internal.Blank
96+
HaskellWorks.Data.Xml.Internal.List
9897
HaskellWorks.Data.Xml.Internal.Tables
9998
HaskellWorks.Data.Xml.Internal.ToIbBp64
99+
HaskellWorks.Data.Xml.Internal.Words
100100
HaskellWorks.Data.Xml.Lens
101101
HaskellWorks.Data.Xml.Succinct
102102
HaskellWorks.Data.Xml.Succinct.Cursor
@@ -181,7 +181,7 @@ test-suite hw-xml-test
181181
build-tool-depends: hspec-discover:hspec-discover
182182
autogen-modules: Paths_hw_xml
183183
other-modules:
184-
HaskellWorks.Data.Xml.Conduit.BlankSpec
184+
HaskellWorks.Data.Xml.Internal.BlankSpec
185185
HaskellWorks.Data.Xml.RawValueSpec
186186
HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec
187187
HaskellWorks.Data.Xml.Succinct.Cursor.InterestBitsSpec

‎src/HaskellWorks/Data/Xml/Blank.hs‎

Lines changed: 67 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,13 @@ module HaskellWorks.Data.Xml.Blank
55
( blankXml
66
) where
77

8-
import Data.ByteString as BS
8+
import Data.ByteString (ByteString)
99
import Data.Word
1010
import Data.Word8
11-
import HaskellWorks.Data.Xml.Conduit.Words
12-
import Prelude as P
11+
import HaskellWorks.Data.Xml.Internal.Words
12+
import Prelude
13+
14+
import qualified Data.ByteString as BS
1315

1416
type ExpectedChar = Word8
1517

@@ -35,66 +37,66 @@ blankXml :: BS.ByteString -> BS.ByteString
3537
blankXml as = fst (BS.unfoldrN (BS.length as) go (InXml, as))
3638
where go :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString))
3739
go (InXml, bs) = case BS.uncons bs of
38-
Just (!c, !cs) | isMetaStart c cs -> Just (_bracketleft , (InMeta , cs))
39-
Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs))
40-
Just (!c, !cs) | isTextStart c -> Just (_t , (InText , cs))
41-
Just (!c, !cs) | c == _less -> Just (_less , (InTag , cs))
42-
Just (!c, !cs) | isSpace c -> Just (c , (InXml , cs))
43-
Just ( _, !cs) -> Just (_space , (InXml , cs))
44-
Nothing -> Nothing
40+
Just (!c, !cs) | isMetaStart c cs -> Just (_bracketleft , (InMeta , cs))
41+
Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs))
42+
Just (!c, !cs) | isTextStart c -> Just (_t , (InText , cs))
43+
Just (!c, !cs) | c == _less -> Just (_less , (InTag , cs))
44+
Just (!c, !cs) | isSpace c -> Just (c , (InXml , cs))
45+
Just ( _, !cs) -> Just (_space , (InXml , cs))
46+
Nothing -> Nothing
4547
go (InTag, bs) = case BS.uncons bs of
46-
Just (!c, !cs) | isSpace c -> Just (_parenleft , (InAttrList , cs))
47-
Just (!c, !cs) | isTagClose c cs -> Just (_space , (InClose , cs))
48-
Just (!c, !cs) | c == _greater -> Just (_space , (InXml , cs))
49-
Just (!c, !cs) | isSpace c -> Just (c , (InTag , cs))
50-
Just ( _, !cs) -> Just (_space , (InTag , cs))
51-
Nothing -> Nothing
48+
Just (!c, !cs) | isSpace c -> Just (_parenleft , (InAttrList , cs))
49+
Just (!c, !cs) | isTagClose c cs -> Just (_space , (InClose , cs))
50+
Just (!c, !cs) | c == _greater -> Just (_space , (InXml , cs))
51+
Just (!c, !cs) | isSpace c -> Just (c , (InTag , cs))
52+
Just ( _, !cs) -> Just (_space , (InTag , cs))
53+
Nothing -> Nothing
5254
go (InCloseTag, bs) = case BS.uncons bs of
53-
Just (!c, !cs) | c == _greater -> Just (_greater , (InXml , cs))
54-
Just ( _, !cs) -> Just (_space , (InCloseTag , cs))
55-
Nothing -> Nothing
55+
Just (!c, !cs) | c == _greater -> Just (_greater , (InXml , cs))
56+
Just ( _, !cs) -> Just (_space , (InCloseTag , cs))
57+
Nothing -> Nothing
5658
go (InAttrList, bs) = case BS.uncons bs of
57-
Just (!c, !cs) | c == _greater -> Just (_parenright , (InXml , cs))
58-
Just (!c, !cs) | isTagClose c cs -> Just (_parenright , (InClose , cs))
59-
Just (!c, !cs) | isNameStartChar c -> Just (_a , (InIdent , cs))
60-
Just (!c, !cs) | isQuote c -> Just (_v , (InString c , cs))
61-
Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs))
62-
Just ( _, !cs) -> Just (_space , (InAttrList , cs))
63-
Nothing -> Nothing
59+
Just (!c, !cs) | c == _greater -> Just (_parenright , (InXml , cs))
60+
Just (!c, !cs) | isTagClose c cs -> Just (_parenright , (InClose , cs))
61+
Just (!c, !cs) | isNameStartChar c -> Just (_a , (InIdent , cs))
62+
Just (!c, !cs) | isQuote c -> Just (_v , (InString c , cs))
63+
Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs))
64+
Just ( _, !cs) -> Just (_space , (InAttrList , cs))
65+
Nothing -> Nothing
6466
go (InClose, bs) = case BS.uncons bs of
65-
Just (_, !cs) -> Just (_greater , (InXml , cs))
66-
Nothing -> Nothing
67+
Just (_, !cs) -> Just (_greater , (InXml , cs))
68+
Nothing -> Nothing
6769
go (InIdent, bs) = case BS.uncons bs of
68-
Just (!c, !cs) | isNameChar c -> Just (_space , (InIdent , cs))
69-
Just (!c, !cs) | isSpace c -> Just (_space , (InAttrList , cs))
70-
Just (!c, !cs) | c == _equal -> Just (_space , (InAttrList , cs))
71-
Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs))
72-
Just ( _, !cs) -> Just (_space , (InAttrList , cs))
73-
Nothing -> Nothing
70+
Just (!c, !cs) | isNameChar c -> Just (_space , (InIdent , cs))
71+
Just (!c, !cs) | isSpace c -> Just (_space , (InAttrList , cs))
72+
Just (!c, !cs) | c == _equal -> Just (_space , (InAttrList , cs))
73+
Just (!c, !cs) | isSpace c -> Just (c , (InAttrList , cs))
74+
Just ( _, !cs) -> Just (_space , (InAttrList , cs))
75+
Nothing -> Nothing
7476
go (InString q, bs) = case BS.uncons bs of
75-
Just (!c, !cs) | c == q -> Just (_space , (InAttrList , cs))
76-
Just (!c, !cs) | isSpace c -> Just (c , (InString q , cs))
77-
Just ( _, !cs) -> Just (_space , (InString q , cs))
78-
Nothing -> Nothing
77+
Just (!c, !cs) | c == q -> Just (_space , (InAttrList , cs))
78+
Just (!c, !cs) | isSpace c -> Just (c , (InString q , cs))
79+
Just ( _, !cs) -> Just (_space , (InString q , cs))
80+
Nothing -> Nothing
7981
go (InText, bs) = case BS.uncons bs of
80-
Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs))
81-
Just ( _, !cs) | headIs (== _less) cs -> Just (_space , (InXml , cs))
82-
Just (!c, !cs) | isSpace c -> Just (c , (InText , cs))
83-
Just ( _, !cs) -> Just (_space , (InText , cs))
84-
Nothing -> Nothing
82+
Just (!c, !cs) | isEndTag c cs -> Just (_space , (InCloseTag , cs))
83+
Just ( _, !cs) | headIs (== _less) cs -> Just (_space , (InXml , cs))
84+
Just (!c, !cs) | isSpace c -> Just (c , (InText , cs))
85+
Just ( _, !cs) -> Just (_space , (InText , cs))
86+
Nothing -> Nothing
8587
go (InMeta, bs) = case BS.uncons bs of
86-
Just (!c, !cs) | c == _exclam -> Just (_space , (InMeta , cs))
87-
Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem 0 , cs))
88-
Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdataTag , cs))
89-
Just (!c, !cs) | c == _greater -> Just (_bracketright, (InXml , cs))
90-
Just (!c, !cs) | isSpace c -> Just (c , (InBang 1 , cs))
91-
Just ( _, !cs) -> Just (_space , (InBang 1 , cs))
92-
Nothing -> Nothing
88+
Just (!c, !cs) | c == _exclam -> Just (_space , (InMeta , cs))
89+
Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem 0 , cs))
90+
Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdataTag , cs))
91+
Just (!c, !cs) | c == _greater -> Just (_bracketright, (InXml , cs))
92+
Just (!c, !cs) | isSpace c -> Just (c , (InBang 1 , cs))
93+
Just ( _, !cs) -> Just (_space , (InBang 1 , cs))
94+
Nothing -> Nothing
9395
go (InCdataTag, bs) = case BS.uncons bs of
94-
Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdata 0 , cs))
95-
Just (!c, !cs) | isSpace c -> Just (c , (InCdataTag , cs))
96-
Just ( _, !cs) -> Just (_space , (InCdataTag , cs))
97-
Nothing -> Nothing
96+
Just (!c, !cs) | c == _bracketleft -> Just (_space , (InCdata 0 , cs))
97+
Just (!c, !cs) | isSpace c -> Just (c , (InCdataTag , cs))
98+
Just ( _, !cs) -> Just (_space , (InCdataTag , cs))
99+
Nothing -> Nothing
98100
go (InCdata n, bs) = case BS.uncons bs of
99101
Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml , cs))
100102
Just (!c, !cs) | isCdataEnd c cs && n > 0 -> Just (_space , (InCdata (n+1), cs))
@@ -103,18 +105,18 @@ blankXml as = fst (BS.unfoldrN (BS.length as) go (InXml, as))
103105
Just ( _, !cs) -> Just (_space , (InCdata 0 , cs))
104106
Nothing -> Nothing
105107
go (InRem n, bs) = case BS.uncons bs of
106-
Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml , cs))
107-
Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem (n+1) , cs))
108-
Just (!c, !cs) | isSpace c -> Just (c , (InRem 0 , cs))
109-
Just ( _, !cs) -> Just (_space , (InRem 0 , cs))
110-
Nothing -> Nothing
108+
Just (!c, !cs) | c == _greater && n >= 2 -> Just (_bracketright, (InXml , cs))
109+
Just (!c, !cs) | c == _hyphen -> Just (_space , (InRem (n+1) , cs))
110+
Just (!c, !cs) | isSpace c -> Just (c , (InRem 0 , cs))
111+
Just ( _, !cs) -> Just (_space , (InRem 0 , cs))
112+
Nothing -> Nothing
111113
go (InBang n, bs) = case BS.uncons bs of
112-
Just (!c, !cs) | c == _less -> Just (_bracketleft , (InBang (n+1) , cs))
113-
Just (!c, !cs) | c == _greater && n == 1 -> Just (_bracketright, (InXml , cs))
114-
Just (!c, !cs) | c == _greater -> Just (_bracketright, (InBang (n-1) , cs))
115-
Just (!c, !cs) | isSpace c -> Just (c , (InBang n , cs))
116-
Just ( _, !cs) -> Just (_space , (InBang n , cs))
117-
Nothing -> Nothing
114+
Just (!c, !cs) | c == _less -> Just (_bracketleft , (InBang (n+1) , cs))
115+
Just (!c, !cs) | c == _greater && n == 1 -> Just (_bracketright, (InXml , cs))
116+
Just (!c, !cs) | c == _greater -> Just (_bracketright, (InBang (n-1) , cs))
117+
Just (!c, !cs) | isSpace c -> Just (c , (InBang n , cs))
118+
Just ( _, !cs) -> Just (_space , (InBang n , cs))
119+
Nothing -> Nothing
118120

119121
isEndTag :: Word8 -> ByteString -> Bool
120122
isEndTag c cs = c == _less && headIs (== _slash) cs

‎src/HaskellWorks/Data/Xml/Conduit/Blank.hs‎ renamed to ‎src/HaskellWorks/Data/Xml/Internal/Blank.hs‎

Lines changed: 13 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,19 @@
22
{-# LANGUAGE BangPatterns #-}
33
{-# LANGUAGE OverloadedStrings #-}
44

5-
module HaskellWorks.Data.Xml.Conduit.Blank
5+
module HaskellWorks.Data.Xml.Internal.Blank
66
( blankXml
77
, BlankData(..)
88
) where
99

10-
import Data.ByteString as BS
11-
import Data.Monoid ((<>))
10+
import Data.ByteString (ByteString)
11+
import Data.Monoid ((<>))
1212
import Data.Word
1313
import Data.Word8
14-
import HaskellWorks.Data.Xml.Conduit.Words
15-
import Prelude as P
14+
import HaskellWorks.Data.Xml.Internal.Words
15+
import Prelude
16+
17+
import qualified Data.ByteString as BS
1618

1719
type ExpectedChar = Word8
1820

@@ -38,10 +40,10 @@ data BlankData = BlankData
3840
, blankC :: !ByteString
3941
}
4042

41-
blankXml :: [BS.ByteString] -> [BS.ByteString]
43+
blankXml :: [ByteString] -> [ByteString]
4244
blankXml = blankXmlPlan1 BS.empty InXml
4345

44-
blankXmlPlan1 :: BS.ByteString -> BlankState -> [BS.ByteString] -> [BS.ByteString]
46+
blankXmlPlan1 :: ByteString -> BlankState -> [ByteString] -> [ByteString]
4547
blankXmlPlan1 as lastState is = case is of
4648
(bs:bss) -> do
4749
let cs = as <> bs
@@ -52,14 +54,14 @@ blankXmlPlan1 as lastState is = case is of
5254
Nothing -> blankXmlPlan1 cs lastState bss
5355
[] -> [BS.map (const _space) as]
5456

55-
blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [BS.ByteString] -> [BS.ByteString]
57+
blankXmlPlan2 :: Word8 -> Word8 -> BlankState -> [ByteString] -> [ByteString]
5658
blankXmlPlan2 a b lastState is = case is of
5759
(cs:css) -> blankXmlRun False a b cs lastState css
5860
[] -> blankXmlRun True a b (BS.pack [_space, _space]) lastState []
5961

60-
blankXmlRun :: Bool -> Word8 -> Word8 -> BS.ByteString -> BlankState -> [BS.ByteString] -> [BS.ByteString]
62+
blankXmlRun :: Bool -> Word8 -> Word8 -> ByteString -> BlankState -> [ByteString] -> [ByteString]
6163
blankXmlRun done a b cs lastState is = do
62-
let (!ds, Just (BlankData !nextState _ _ _)) = unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)
64+
let (!ds, Just (BlankData !nextState _ _ _)) = BS.unfoldrN (BS.length cs) blankByteString (BlankData lastState a b cs)
6365
let (yy, zz) = case BS.unsnoc cs of
6466
Just (ys, z) -> case BS.unsnoc ys of
6567
Just (_, y) -> (y, z)
@@ -69,7 +71,7 @@ blankXmlRun done a b cs lastState is = do
6971
then [ds]
7072
else ds:blankXmlPlan2 yy zz nextState is
7173

72-
mkNext :: Word8 -> BlankState -> Word8 -> BS.ByteString -> Maybe (Word8, BlankData)
74+
mkNext :: Word8 -> BlankState -> Word8 -> ByteString -> Maybe (Word8, BlankData)
7375
mkNext w s a bs = case BS.uncons bs of
7476
Just (b, cs) -> Just (w, BlankData s a b cs)
7577
Nothing -> error "This should never happen"

‎src/HaskellWorks/Data/Xml/Conduit.hs‎ renamed to ‎src/HaskellWorks/Data/Xml/Internal/List.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{-# LANGUAGE OverloadedStrings #-}
22
{-# LANGUAGE RankNTypes #-}
33

4-
module HaskellWorks.Data.Xml.Conduit
4+
module HaskellWorks.Data.Xml.Internal.List
55
( blankedXmlToInterestBits
66
, byteStringToBits
77
, compressWordAsBit

‎src/HaskellWorks/Data/Xml/Internal/ToIbBp64.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@ module HaskellWorks.Data.Xml.Internal.ToIbBp64
1313

1414
import Control.Applicative
1515
import Data.Word
16-
import HaskellWorks.Data.Xml.Conduit
1716
import HaskellWorks.Data.Xml.Internal.BalancedParens
17+
import HaskellWorks.Data.Xml.Internal.List
1818
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml (BlankedXml (..))
1919
import HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits (blankedXmlToInterestBits, genInterestForever)
2020

‎src/HaskellWorks/Data/Xml/Conduit/Words.hs‎ renamed to ‎src/HaskellWorks/Data/Xml/Internal/Words.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module HaskellWorks.Data.Xml.Conduit.Words where
1+
module HaskellWorks.Data.Xml.Internal.Words where
22

33
import Data.Word
44
import Data.Word8

‎src/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParens.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParens
1111
import Control.Applicative
1212
import Data.Word
1313
import HaskellWorks.Data.BalancedParens as BP
14-
import HaskellWorks.Data.Xml.Conduit
1514
import HaskellWorks.Data.Xml.Internal.BalancedParens
15+
import HaskellWorks.Data.Xml.Internal.List
1616
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
1717

1818
import qualified Data.ByteString as BS

0 commit comments

Comments
 (0)