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

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

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

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

genBitWordsForever :: LBS.ByteString -> Maybe (Word8, LBS.ByteString)
genBitWordsForever :: ByteString -> Maybe (Word8, ByteString)
genBitWordsForever ByteString
bs = ByteString -> Maybe (Word8, ByteString)
LBS.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)
{-# INLINE genBitWordsForever #-}

class ToBalancedParens64 a where
  toBalancedParens64 :: a -> DVS.Vector Word64

instance ToBalancedParens64 J.BlankedJson where
  toBalancedParens64 :: BlankedJson -> Vector Word64
toBalancedParens64 (J.BlankedJson [ByteString]
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)
genBitWordsForever ByteString
bpBS)
    where bpBS :: ByteString
bpBS    = [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> [ByteString]
compressWordAsBit ([ByteString] -> [ByteString]
blankedJsonToBalancedParens [ByteString]
bj))
          newLen :: Int
newLen  = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((ByteString -> Int64
LBS.length ByteString
bpBS Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
7) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
8 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
8)