{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module HaskellWorks.Data.Json.Standard.Cursor.Internal.ToInterestBits64
  ( ToInterestBits64(..)
  ) where

import Control.Applicative
import Data.ByteString.Internal
import Data.Word
import HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex

import qualified Data.ByteString                                             as BS
import qualified Data.Vector.Storable                                        as DVS
import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson as J

class ToInterestBits64 a where
  toInterestBits64 :: a -> DVS.Vector Word64

instance ToInterestBits64 J.BlankedJson where
  toInterestBits64 :: BlankedJson -> Vector Word64
toInterestBits64 BlankedJson
bj = 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
blankedJsonBssToInterestBitsBs (BlankedJson -> [ByteString]
J.unBlankedJson BlankedJson
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

blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs [ByteString]
bss = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
blankedJsonToInterestBits [ByteString]
bss

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)