Skip to content

Commit e0d878b

Browse files
newhoggynewhoggy
authored
Merge pull request #77 from haskell-works/move-blankedXmlToBalancedParens2-to-internal-module-as-blankedXmlToBalancedParens
Move blankedXmlToBalancedParens2 to internal module as blankedXmlToBa…
2 parents 1253161 + 925be62 commit e0d878b

File tree

6 files changed

+60
-45
lines changed

6 files changed

+60
-45
lines changed

‎hw-xml.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@ library
9393
HaskellWorks.Data.Xml.DecodeResult
9494
HaskellWorks.Data.Xml.Grammar
9595
HaskellWorks.Data.Xml.Index
96+
HaskellWorks.Data.Xml.Internal.BalancedParens
9697
HaskellWorks.Data.Xml.Internal.ToIbBp64
9798
HaskellWorks.Data.Xml.Lens
9899
HaskellWorks.Data.Xml.Succinct

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

Lines changed: 0 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@
44
module HaskellWorks.Data.Xml.Conduit
55
( blankedXmlToInterestBits
66
, byteStringToBits
7-
, blankedXmlToBalancedParens2
87
, compressWordAsBit
98
, interestingWord8s
109
, isInterestingWord8
@@ -89,38 +88,6 @@ compressWordAsBit' aBS iBS = case iBS of
8988
, BS.drop 8 xs
9089
)
9190

92-
blankedXmlToBalancedParens2 :: [BS.ByteString] -> [BS.ByteString]
93-
blankedXmlToBalancedParens2 is = case is of
94-
(bs:bss) -> do
95-
let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)
96-
cs:blankedXmlToBalancedParens2 bss
97-
[] -> []
98-
where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
99-
gen (Just True , bs) = Just (0xFF, (Nothing, bs))
100-
gen (Just False , bs) = Just (0x00, (Nothing, bs))
101-
gen (Nothing , bs) = case BS.uncons bs of
102-
Just (c, cs) -> case balancedParensOf c of
103-
MiniN -> gen (Nothing , cs)
104-
MiniT -> Just (0xFF, (Nothing , cs))
105-
MiniF -> Just (0x00, (Nothing , cs))
106-
MiniTF -> Just (0xFF, (Just False , cs))
107-
Nothing -> Nothing
108-
109-
data MiniBP = MiniN | MiniT | MiniF | MiniTF
110-
111-
balancedParensOf :: Word8 -> MiniBP
112-
balancedParensOf c = case c of
113-
d | d == _less -> MiniT
114-
d | d == _greater -> MiniF
115-
d | d == _bracketleft -> MiniT
116-
d | d == _bracketright -> MiniF
117-
d | d == _parenleft -> MiniT
118-
d | d == _parenright -> MiniF
119-
d | d == _t -> MiniTF
120-
d | d == _a -> MiniTF
121-
d | d == _v -> MiniTF
122-
_ -> MiniN
123-
12491
yieldBitsOfWord8 :: Word8 -> [Bool]
12592
yieldBitsOfWord8 w =
12693
[ (w .&. BITS.bit 0) /= 0

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

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
module HaskellWorks.Data.Xml.Internal.BalancedParens
2+
( blankedXmlToBalancedParens
3+
) where
4+
5+
import Data.ByteString (ByteString)
6+
import Data.Word
7+
import Data.Word8
8+
9+
import qualified Data.ByteString as BS
10+
11+
data MiniBP = MiniN | MiniT | MiniF | MiniTF
12+
13+
blankedXmlToBalancedParens :: [ByteString] -> [ByteString]
14+
blankedXmlToBalancedParens is = case is of
15+
(bs:bss) -> do
16+
let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs)
17+
cs:blankedXmlToBalancedParens bss
18+
[] -> []
19+
where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
20+
gen (Just True , bs) = Just (0xFF, (Nothing, bs))
21+
gen (Just False , bs) = Just (0x00, (Nothing, bs))
22+
gen (Nothing , bs) = case BS.uncons bs of
23+
Just (c, cs) -> case balancedParensOf c of
24+
MiniN -> gen (Nothing , cs)
25+
MiniT -> Just (0xFF, (Nothing , cs))
26+
MiniF -> Just (0x00, (Nothing , cs))
27+
MiniTF -> Just (0xFF, (Just False , cs))
28+
Nothing -> Nothing
29+
30+
balancedParensOf :: Word8 -> MiniBP
31+
balancedParensOf c = case c of
32+
d | d == _less -> MiniT
33+
d | d == _greater -> MiniF
34+
d | d == _bracketleft -> MiniT
35+
d | d == _bracketright -> MiniF
36+
d | d == _parenleft -> MiniT
37+
d | d == _parenright -> MiniF
38+
d | d == _t -> MiniTF
39+
d | d == _a -> MiniTF
40+
d | d == _v -> MiniTF
41+
_ -> MiniN
42+

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module HaskellWorks.Data.Xml.Internal.ToIbBp64
1414
import Control.Applicative
1515
import Data.Word
1616
import HaskellWorks.Data.Xml.Conduit
17+
import HaskellWorks.Data.Xml.Internal.BalancedParens
1718
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml (BlankedXml (..))
1819
import HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits (blankedXmlToInterestBits, genInterestForever)
1920

@@ -26,11 +27,11 @@ genBitWordsForever bs = BS.uncons bs <|> Just (0, bs)
2627

2728
toBalancedParens64 :: BlankedXml -> DVS.Vector Word64
2829
toBalancedParens64 (BlankedXml bj) = DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)
29-
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 bj))
30+
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens bj))
3031
newLen = (BS.length interestBS + 7) `div` 8 * 8
3132

3233
toBalancedParens64' :: BlankedXml -> [BS.ByteString]
33-
toBalancedParens64' (BlankedXml bj) = compressWordAsBit (blankedXmlToBalancedParens2 bj)
34+
toBalancedParens64' (BlankedXml bj) = compressWordAsBit (blankedXmlToBalancedParens bj)
3435

3536
toInterestBits64 :: BlankedXml -> DVS.Vector Word64
3637
toInterestBits64 (BlankedXml bj) = DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS)

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

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import Control.Applicative
1212
import Data.Word
1313
import HaskellWorks.Data.BalancedParens as BP
1414
import HaskellWorks.Data.Xml.Conduit
15+
import HaskellWorks.Data.Xml.Internal.BalancedParens
1516
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
1617

1718
import qualified Data.ByteString as BS
@@ -28,20 +29,20 @@ genBitWordsForever bs = BS.uncons bs <|> Just (0, bs)
2829

2930
instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where
3031
fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))
31-
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))
32+
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))
3233
newLen = (BS.length interestBS + 7) `div` 8 * 8
3334

3435
instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where
3536
fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))
36-
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))
37+
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))
3738
newLen = (BS.length interestBS + 7) `div` 8 * 8
3839

3940
instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where
4041
fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))
41-
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))
42+
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))
4243
newLen = (BS.length interestBS + 7) `div` 8 * 8
4344

4445
instance FromBlankedXml (XmlBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where
4546
fromBlankedXml bj = XmlBalancedParens (SimpleBalancedParens (DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever interestBS)))
46-
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml bj)))
47+
where interestBS = BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml bj)))
4748
newLen = (BS.length interestBS + 7) `div` 8 * 8

‎test/HaskellWorks/Data/Xml/Succinct/Cursor/BalancedParensSpec.hs‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,17 @@
11
{-# LANGUAGE FlexibleContexts #-}
22
{-# LANGUAGE OverloadedStrings #-}
33

4-
module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec(spec) where
4+
module HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec
5+
( spec
6+
) where
57

68
import Data.Monoid ((<>))
79
import Data.String
810
import HaskellWorks.Data.Bits.BitShown
911
import HaskellWorks.Data.ByteString
1012
import HaskellWorks.Data.Xml.Conduit
1113
import HaskellWorks.Data.Xml.Conduit.Blank
14+
import HaskellWorks.Data.Xml.Internal.BalancedParens
1215
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
1316
import HaskellWorks.Hspec.Hedgehog
1417
import Hedgehog
@@ -22,14 +25,14 @@ spec :: Spec
2225
spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec" $ do
2326
it "Blanking XML should work 1" $ requireTest $ do
2427
let blankedXml = BlankedXml ["<t<t>>"]
25-
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml blankedXml)))
28+
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml)))
2629
bp === fromString "11011000"
2730
it "Blanking XML should work 2" $ requireTest $ do
2831
let blankedXml = BlankedXml
2932
[ "<><><><><><><><>"
3033
, "<><><><><><><><>"
3134
]
32-
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 (getBlankedXml blankedXml)))
35+
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens (getBlankedXml blankedXml)))
3336
bp === fromString
3437
"1010101010101010\
3538
\1010101010101010"
@@ -46,12 +49,12 @@ spec = describe "HaskellWorks.Data.Xml.Succinct.Cursor.BalancedParensSpec" $ do
4649
unchunkedInput === BS.concat chunkedInput
4750

4851
it "Blanking XML should work 3" $ requireTest $ do
49-
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 chunkedBlank))
52+
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBlank))
5053
annotate $ "Good: " <> show chunkedBlank
5154
bp === fromString "11101010 10001101 01010100"
5255

5356
it "Blanking XML should work 3" $ requireTest $do
54-
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens2 chunkedBadBlank))
57+
let bp = BitShown $ BS.concat (compressWordAsBit (blankedXmlToBalancedParens chunkedBadBlank))
5558
annotate $ "Bad: " <> show chunkedBadBlank
5659
bp === fromString "11101010 10001101 01010100"
5760

@@ -71,4 +74,4 @@ mkBlank :: Int -> BS.ByteString -> [BS.ByteString]
7174
mkBlank csize bs = blankXml (chunkedBy csize bs)
7275

7376
mkBits :: [BS.ByteString] -> [BS.ByteString]
74-
mkBits = compressWordAsBit . blankedXmlToBalancedParens2
77+
mkBits = compressWordAsBit . blankedXmlToBalancedParens

0 commit comments

Comments
 (0)