{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} module HaskellWorks.Data.Xml.Succinct.Cursor.InterestBits ( XmlInterestBits(..) , getXmlInterestBits , blankedXmlToInterestBits , blankedXmlBssToInterestBitsBs , genInterestForever ) where import Control.Applicative import Control.DeepSeq import Data.ByteString.Internal import Data.Word import GHC.Generics import HaskellWorks.Data.Bits.BitShown import HaskellWorks.Data.FromByteString import HaskellWorks.Data.RankSelect.Poppy512 import HaskellWorks.Data.Xml.Internal.List import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml import qualified Data.ByteString as BS import qualified Data.Vector.Storable as DVS newtype XmlInterestBits a = XmlInterestBits a deriving (XmlInterestBits a -> XmlInterestBits a -> Bool (XmlInterestBits a -> XmlInterestBits a -> Bool) -> (XmlInterestBits a -> XmlInterestBits a -> Bool) -> Eq (XmlInterestBits a) forall a. Eq a => XmlInterestBits a -> XmlInterestBits a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: XmlInterestBits a -> XmlInterestBits a -> Bool $c/= :: forall a. Eq a => XmlInterestBits a -> XmlInterestBits a -> Bool == :: XmlInterestBits a -> XmlInterestBits a -> Bool $c== :: forall a. Eq a => XmlInterestBits a -> XmlInterestBits a -> Bool Eq, Int -> XmlInterestBits a -> ShowS [XmlInterestBits a] -> ShowS XmlInterestBits a -> String (Int -> XmlInterestBits a -> ShowS) -> (XmlInterestBits a -> String) -> ([XmlInterestBits a] -> ShowS) -> Show (XmlInterestBits a) forall a. Show a => Int -> XmlInterestBits a -> ShowS forall a. Show a => [XmlInterestBits a] -> ShowS forall a. Show a => XmlInterestBits a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [XmlInterestBits a] -> ShowS $cshowList :: forall a. Show a => [XmlInterestBits a] -> ShowS show :: XmlInterestBits a -> String $cshow :: forall a. Show a => XmlInterestBits a -> String showsPrec :: Int -> XmlInterestBits a -> ShowS $cshowsPrec :: forall a. Show a => Int -> XmlInterestBits a -> ShowS Show, (forall x. XmlInterestBits a -> Rep (XmlInterestBits a) x) -> (forall x. Rep (XmlInterestBits a) x -> XmlInterestBits a) -> Generic (XmlInterestBits a) forall x. Rep (XmlInterestBits a) x -> XmlInterestBits a forall x. XmlInterestBits a -> Rep (XmlInterestBits a) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall a x. Rep (XmlInterestBits a) x -> XmlInterestBits a forall a x. XmlInterestBits a -> Rep (XmlInterestBits a) x $cto :: forall a x. Rep (XmlInterestBits a) x -> XmlInterestBits a $cfrom :: forall a x. XmlInterestBits a -> Rep (XmlInterestBits a) x Generic, XmlInterestBits a -> () (XmlInterestBits a -> ()) -> NFData (XmlInterestBits a) forall a. NFData a => XmlInterestBits a -> () forall a. (a -> ()) -> NFData a rnf :: XmlInterestBits a -> () $crnf :: forall a. NFData a => XmlInterestBits a -> () NFData) getXmlInterestBits :: XmlInterestBits a -> a getXmlInterestBits :: XmlInterestBits a -> a getXmlInterestBits (XmlInterestBits a a) = a a blankedXmlBssToInterestBitsBs :: [ByteString] -> ByteString blankedXmlBssToInterestBitsBs :: [ByteString] -> ByteString blankedXmlBssToInterestBitsBs [ByteString] bss = [ByteString] -> ByteString BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString forall a b. (a -> b) -> a -> b $ [ByteString] -> [ByteString] blankedXmlToInterestBits [ByteString] bss genInterest :: ByteString -> Maybe (Word8, ByteString) genInterest :: ByteString -> Maybe (Word8, ByteString) genInterest = ByteString -> Maybe (Word8, ByteString) BS.uncons genInterestForever :: ByteString -> Maybe (Word8, ByteString) genInterestForever :: ByteString -> Maybe (Word8, ByteString) genInterestForever ByteString bs = ByteString -> Maybe (Word8, ByteString) BS.uncons ByteString bs Maybe (Word8, ByteString) -> Maybe (Word8, ByteString) -> Maybe (Word8, ByteString) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (Word8, ByteString) -> Maybe (Word8, ByteString) forall a. a -> Maybe a Just (Word8 0, ByteString bs) instance FromBlankedXml (XmlInterestBits (BitShown [Bool])) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown [Bool]) fromBlankedXml = BitShown [Bool] -> XmlInterestBits (BitShown [Bool]) forall a. a -> XmlInterestBits a XmlInterestBits (BitShown [Bool] -> XmlInterestBits (BitShown [Bool])) -> (BlankedXml -> BitShown [Bool]) -> BlankedXml -> XmlInterestBits (BitShown [Bool]) forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> BitShown [Bool] forall a. FromByteString a => ByteString -> a fromByteString (ByteString -> BitShown [Bool]) -> (BlankedXml -> ByteString) -> BlankedXml -> BitShown [Bool] forall b c a. (b -> c) -> (a -> b) -> a -> c . [ByteString] -> ByteString BS.concat ([ByteString] -> ByteString) -> (BlankedXml -> [ByteString]) -> BlankedXml -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . [ByteString] -> [ByteString] blankedXmlToInterestBits ([ByteString] -> [ByteString]) -> (BlankedXml -> [ByteString]) -> BlankedXml -> [ByteString] forall b c a. (b -> c) -> (a -> b) -> a -> c . BlankedXml -> [ByteString] getBlankedXml instance FromBlankedXml (XmlInterestBits (BitShown BS.ByteString)) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown ByteString) fromBlankedXml = BitShown ByteString -> XmlInterestBits (BitShown ByteString) forall a. a -> XmlInterestBits a XmlInterestBits (BitShown ByteString -> XmlInterestBits (BitShown ByteString)) -> (BlankedXml -> BitShown ByteString) -> BlankedXml -> XmlInterestBits (BitShown ByteString) forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> BitShown ByteString forall a. a -> BitShown a BitShown (ByteString -> BitShown ByteString) -> (BlankedXml -> ByteString) -> BlankedXml -> BitShown ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . (ByteString -> Maybe (Word8, ByteString)) -> ByteString -> ByteString forall a. (a -> Maybe (Word8, a)) -> a -> ByteString BS.unfoldr ByteString -> Maybe (Word8, ByteString) genInterest (ByteString -> ByteString) -> (BlankedXml -> ByteString) -> BlankedXml -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . [ByteString] -> ByteString blankedXmlBssToInterestBitsBs ([ByteString] -> ByteString) -> (BlankedXml -> [ByteString]) -> BlankedXml -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . BlankedXml -> [ByteString] getBlankedXml instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word8))) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown (Vector Word8)) fromBlankedXml = BitShown (Vector Word8) -> XmlInterestBits (BitShown (Vector Word8)) forall a. a -> XmlInterestBits a XmlInterestBits (BitShown (Vector Word8) -> XmlInterestBits (BitShown (Vector Word8))) -> (BlankedXml -> BitShown (Vector Word8)) -> BlankedXml -> XmlInterestBits (BitShown (Vector Word8)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Vector Word8 -> BitShown (Vector Word8) forall a. a -> BitShown a BitShown (Vector Word8 -> BitShown (Vector Word8)) -> (BlankedXml -> Vector Word8) -> BlankedXml -> BitShown (Vector Word8) forall b c a. (b -> c) -> (a -> b) -> a -> c . (ByteString -> Maybe (Word8, ByteString)) -> ByteString -> Vector Word8 forall a b. Storable a => (b -> Maybe (a, b)) -> b -> Vector a DVS.unfoldr ByteString -> Maybe (Word8, ByteString) genInterest (ByteString -> Vector Word8) -> (BlankedXml -> ByteString) -> BlankedXml -> Vector Word8 forall b c a. (b -> c) -> (a -> b) -> a -> c . [ByteString] -> ByteString blankedXmlBssToInterestBitsBs ([ByteString] -> ByteString) -> (BlankedXml -> [ByteString]) -> BlankedXml -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . BlankedXml -> [ByteString] getBlankedXml instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word16))) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown (Vector Word16)) fromBlankedXml BlankedXml bj = BitShown (Vector Word16) -> XmlInterestBits (BitShown (Vector Word16)) forall a. a -> XmlInterestBits a XmlInterestBits (Vector Word16 -> BitShown (Vector Word16) forall a. a -> BitShown a BitShown (Vector Word8 -> Vector Word16 forall a b. (Storable a, Storable b) => Vector a -> Vector b DVS.unsafeCast (Int -> (ByteString -> Maybe (Word8, ByteString)) -> ByteString -> Vector Word8 forall a b. Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a DVS.unfoldrN Int newLen ByteString -> Maybe (Word8, ByteString) genInterestForever ByteString interestBS))) where interestBS :: ByteString interestBS = [ByteString] -> ByteString blankedXmlBssToInterestBitsBs (BlankedXml -> [ByteString] getBlankedXml BlankedXml bj) newLen :: Int newLen = (ByteString -> Int BS.length ByteString interestBS Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1) Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 2 Int -> Int -> Int forall a. Num a => a -> a -> a * Int 2 instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word32))) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown (Vector Word32)) fromBlankedXml BlankedXml bj = BitShown (Vector Word32) -> XmlInterestBits (BitShown (Vector Word32)) forall a. a -> XmlInterestBits a XmlInterestBits (Vector Word32 -> BitShown (Vector Word32) forall a. a -> BitShown a BitShown (Vector Word8 -> Vector Word32 forall a b. (Storable a, Storable b) => Vector a -> Vector b DVS.unsafeCast (Int -> (ByteString -> Maybe (Word8, ByteString)) -> ByteString -> Vector Word8 forall a b. Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a DVS.unfoldrN Int newLen ByteString -> Maybe (Word8, ByteString) genInterestForever ByteString interestBS))) where interestBS :: ByteString interestBS = [ByteString] -> ByteString blankedXmlBssToInterestBitsBs (BlankedXml -> [ByteString] getBlankedXml BlankedXml bj) newLen :: Int newLen = (ByteString -> Int BS.length ByteString interestBS Int -> Int -> Int forall a. Num a => a -> a -> a + Int 3) Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 4 Int -> Int -> Int forall a. Num a => a -> a -> a * Int 4 instance FromBlankedXml (XmlInterestBits (BitShown (DVS.Vector Word64))) where fromBlankedXml :: BlankedXml -> XmlInterestBits (BitShown (Vector Word64)) fromBlankedXml BlankedXml bj = BitShown (Vector Word64) -> XmlInterestBits (BitShown (Vector Word64)) forall a. a -> XmlInterestBits a XmlInterestBits (Vector Word64 -> BitShown (Vector Word64) forall a. a -> BitShown a BitShown (Vector Word8 -> Vector Word64 forall a b. (Storable a, Storable b) => Vector a -> Vector b DVS.unsafeCast (Int -> (ByteString -> Maybe (Word8, ByteString)) -> ByteString -> Vector Word8 forall a b. Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a DVS.unfoldrN Int newLen ByteString -> Maybe (Word8, ByteString) genInterestForever ByteString interestBS))) where interestBS :: ByteString interestBS = [ByteString] -> ByteString blankedXmlBssToInterestBitsBs (BlankedXml -> [ByteString] getBlankedXml BlankedXml bj) newLen :: Int newLen = (ByteString -> Int BS.length ByteString interestBS 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 Int -> Int -> Int forall a. Num a => a -> a -> a * Int 8 instance FromBlankedXml (XmlInterestBits Poppy512) where fromBlankedXml :: BlankedXml -> XmlInterestBits Poppy512 fromBlankedXml = Poppy512 -> XmlInterestBits Poppy512 forall a. a -> XmlInterestBits a XmlInterestBits (Poppy512 -> XmlInterestBits Poppy512) -> (BlankedXml -> Poppy512) -> BlankedXml -> XmlInterestBits Poppy512 forall b c a. (b -> c) -> (a -> b) -> a -> c . Vector Word64 -> Poppy512 makePoppy512 (Vector Word64 -> Poppy512) -> (BlankedXml -> Vector Word64) -> BlankedXml -> Poppy512 forall b c a. (b -> c) -> (a -> b) -> a -> c . BitShown (Vector Word64) -> Vector Word64 forall a. BitShown a -> a bitShown (BitShown (Vector Word64) -> Vector Word64) -> (BlankedXml -> BitShown (Vector Word64)) -> BlankedXml -> Vector Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . XmlInterestBits (BitShown (Vector Word64)) -> BitShown (Vector Word64) forall a. XmlInterestBits a -> a getXmlInterestBits (XmlInterestBits (BitShown (Vector Word64)) -> BitShown (Vector Word64)) -> (BlankedXml -> XmlInterestBits (BitShown (Vector Word64))) -> BlankedXml -> BitShown (Vector Word64) forall b c a. (b -> c) -> (a -> b) -> a -> c . BlankedXml -> XmlInterestBits (BitShown (Vector Word64)) forall a. FromBlankedXml a => BlankedXml -> a fromBlankedXml