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

module HaskellWorks.Data.Json.Succinct.Cursor.InterestBits
  ( JsonInterestBits(..)
  , getJsonInterestBits
  ) where

import           Control.Applicative
import qualified Data.ByteString                                       as BS
import           Data.ByteString.Internal
import qualified Data.Vector.Storable                                  as DVS
import           Data.Word
import           HaskellWorks.Data.Bits.BitShown
import           HaskellWorks.Data.Conduit.List
import           HaskellWorks.Data.FromByteString
import           HaskellWorks.Data.Json.Conduit
import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson
import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512

newtype JsonInterestBits a = JsonInterestBits a

getJsonInterestBits :: JsonInterestBits a -> a
getJsonInterestBits :: JsonInterestBits a -> a
getJsonInterestBits (JsonInterestBits a
a) = a
a

blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs [ByteString]
bss = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ConduitT ByteString ByteString [] ()
-> [ByteString] -> [ByteString]
forall i o. ConduitT i o [] () -> [i] -> [o]
runListConduit ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
blankedJsonToInterestBits [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 FromBlankedJson (JsonInterestBits (BitShown [Bool])) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown [Bool])
fromBlankedJson = BitShown [Bool] -> JsonInterestBits (BitShown [Bool])
forall a. a -> JsonInterestBits a
JsonInterestBits (BitShown [Bool] -> JsonInterestBits (BitShown [Bool]))
-> (BlankedJson -> BitShown [Bool])
-> BlankedJson
-> JsonInterestBits (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])
-> (BlankedJson -> ByteString) -> BlankedJson -> BitShown [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (BlankedJson -> [ByteString]) -> BlankedJson -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT ByteString ByteString [] ()
-> [ByteString] -> [ByteString]
forall i o. ConduitT i o [] () -> [i] -> [o]
runListConduit ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
blankedJsonToInterestBits ([ByteString] -> [ByteString])
-> (BlankedJson -> [ByteString]) -> BlankedJson -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlankedJson -> [ByteString]
getBlankedJson

instance FromBlankedJson (JsonInterestBits (BitShown BS.ByteString)) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown ByteString)
fromBlankedJson = BitShown ByteString -> JsonInterestBits (BitShown ByteString)
forall a. a -> JsonInterestBits a
JsonInterestBits (BitShown ByteString -> JsonInterestBits (BitShown ByteString))
-> (BlankedJson -> BitShown ByteString)
-> BlankedJson
-> JsonInterestBits (BitShown ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BitShown ByteString
forall a. a -> BitShown a
BitShown (ByteString -> BitShown ByteString)
-> (BlankedJson -> ByteString)
-> BlankedJson
-> 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)
-> (BlankedJson -> ByteString) -> BlankedJson -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs ([ByteString] -> ByteString)
-> (BlankedJson -> [ByteString]) -> BlankedJson -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlankedJson -> [ByteString]
getBlankedJson

instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word8))) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown (Vector Word8))
fromBlankedJson = BitShown (Vector Word8)
-> JsonInterestBits (BitShown (Vector Word8))
forall a. a -> JsonInterestBits a
JsonInterestBits (BitShown (Vector Word8)
 -> JsonInterestBits (BitShown (Vector Word8)))
-> (BlankedJson -> BitShown (Vector Word8))
-> BlankedJson
-> JsonInterestBits (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))
-> (BlankedJson -> Vector Word8)
-> BlankedJson
-> 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)
-> (BlankedJson -> ByteString) -> BlankedJson -> Vector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
blankedJsonBssToInterestBitsBs ([ByteString] -> ByteString)
-> (BlankedJson -> [ByteString]) -> BlankedJson -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlankedJson -> [ByteString]
getBlankedJson

instance FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word16))) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown (Vector Word16))
fromBlankedJson BlankedJson
bj = BitShown (Vector Word16)
-> JsonInterestBits (BitShown (Vector Word16))
forall a. a -> JsonInterestBits a
JsonInterestBits (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
blankedJsonBssToInterestBitsBs (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
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 FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word32))) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown (Vector Word32))
fromBlankedJson BlankedJson
bj = BitShown (Vector Word32)
-> JsonInterestBits (BitShown (Vector Word32))
forall a. a -> JsonInterestBits a
JsonInterestBits (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
blankedJsonBssToInterestBitsBs (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
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 FromBlankedJson (JsonInterestBits (BitShown (DVS.Vector Word64))) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits (BitShown (Vector Word64))
fromBlankedJson BlankedJson
bj    = BitShown (Vector Word64)
-> JsonInterestBits (BitShown (Vector Word64))
forall a. a -> JsonInterestBits a
JsonInterestBits (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
blankedJsonBssToInterestBitsBs (BlankedJson -> [ByteString]
getBlankedJson 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

instance FromBlankedJson (JsonInterestBits Poppy512) where
  fromBlankedJson :: BlankedJson -> JsonInterestBits Poppy512
fromBlankedJson = Poppy512 -> JsonInterestBits Poppy512
forall a. a -> JsonInterestBits a
JsonInterestBits (Poppy512 -> JsonInterestBits Poppy512)
-> (BlankedJson -> Poppy512)
-> BlankedJson
-> JsonInterestBits Poppy512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> Poppy512
makePoppy512 (Vector Word64 -> Poppy512)
-> (BlankedJson -> Vector Word64) -> BlankedJson -> 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)
-> (BlankedJson -> BitShown (Vector Word64))
-> BlankedJson
-> Vector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonInterestBits (BitShown (Vector Word64))
-> BitShown (Vector Word64)
forall a. JsonInterestBits a -> a
getJsonInterestBits (JsonInterestBits (BitShown (Vector Word64))
 -> BitShown (Vector Word64))
-> (BlankedJson -> JsonInterestBits (BitShown (Vector Word64)))
-> BlankedJson
-> BitShown (Vector Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlankedJson -> JsonInterestBits (BitShown (Vector Word64))
forall a. FromBlankedJson a => BlankedJson -> a
fromBlankedJson