{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

module HaskellWorks.Data.Xml.Internal.List
  ( blankedXmlToInterestBits
  , compressWordAsBit
  ) where

import Data.ByteString                           (ByteString)
import Data.Word
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Xml.Internal.ByteString
import HaskellWorks.Data.Xml.Internal.Tables
import Prelude

import qualified Data.ByteString as BS

blankedXmlToInterestBits :: [ByteString] -> [ByteString]
blankedXmlToInterestBits :: [ByteString] -> [ByteString]
blankedXmlToInterestBits = ByteString -> [ByteString] -> [ByteString]
blankedXmlToInterestBits' ByteString
""

blankedXmlToInterestBits' :: ByteString -> [ByteString] -> [ByteString]
blankedXmlToInterestBits' :: ByteString -> [ByteString] -> [ByteString]
blankedXmlToInterestBits' ByteString
rs [ByteString]
is = case [ByteString]
is of
  (ByteString
bs:[ByteString]
bss) -> do
    let cs :: ByteString
cs = if ByteString -> Int
BS.length ByteString
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then [ByteString] -> ByteString
BS.concat [ByteString
rs, ByteString
bs] else ByteString
bs
    let lencs :: Int
lencs = ByteString -> Int
BS.length ByteString
cs
    let q :: Int
q = Int
lencs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
    let (ByteString
ds, ByteString
es) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) ByteString
cs
    let (ByteString
fs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
q ByteString -> Maybe (Word8, ByteString)
gen ByteString
ds
    ByteString
fsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString] -> [ByteString]
blankedXmlToInterestBits' ByteString
es [ByteString]
bss
  [] -> do
    let lenrs :: Int
lenrs = ByteString -> Int
BS.length ByteString
rs
    let q :: Int
q = Int
lenrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8
    [(ByteString, Maybe ByteString) -> ByteString
forall a b. (a, b) -> a
fst (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
q ByteString -> Maybe (Word8, ByteString)
gen ByteString
rs)]
  where gen :: ByteString -> Maybe (Word8, ByteString)
        gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
as = if ByteString -> Int
BS.length ByteString
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
          else (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ( (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr' (\Word8
b Word8
m -> Word8 -> Word8
isInterestingWord8 Word8
b Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
m Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count
1)) Word8
0 (Int -> ByteString -> ByteString
BS.take Int
8 ByteString
as)
                    , Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
as
                    )

compressWordAsBit :: [ByteString] -> [ByteString]
compressWordAsBit :: [ByteString] -> [ByteString]
compressWordAsBit = ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
BS.empty

compressWordAsBit' :: ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' :: ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
aBS [ByteString]
iBS = case [ByteString]
iBS of
  (ByteString
bBS:[ByteString]
bBSs) -> do
    let (ByteString
cBS, ByteString
dBS) = ByteString -> ByteString -> (ByteString, ByteString)
repartitionMod8 ByteString
aBS ByteString
bBS
    let (ByteString
cs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
cBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) ByteString -> Maybe (Word8, ByteString)
gen ByteString
cBS
    ByteString
csByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
dBS [ByteString]
bBSs
  [] -> do
    let (ByteString
cs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
aBS Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) ByteString -> Maybe (Word8, ByteString)
gen ByteString
aBS
    [ByteString
cs]
  where gen :: ByteString -> Maybe (Word8, ByteString)
        gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
xs = if ByteString -> Int
BS.length ByteString
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
          else (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ( (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr' (\Word8
b Word8
m -> ((Word8
b Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
1) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
m Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count
1))) Word8
0 (Int -> ByteString -> ByteString
BS.take Int
8 ByteString
xs)
                    , Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
xs
                    )