{-# 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