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

module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens
  ( JsonBalancedParens(..)
  , getJsonBalancedParens
  ) where

import           Control.Applicative
import qualified Data.ByteString                                    as BS
import           Data.Conduit
import qualified Data.Vector.Storable                               as DVS
import           Data.Word
import           HaskellWorks.Data.Conduit.List
import           HaskellWorks.Data.Json.Conduit
import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson
import           HaskellWorks.Data.Succinct.BalancedParens          as BP

newtype JsonBalancedParens a = JsonBalancedParens a

getJsonBalancedParens :: JsonBalancedParens a -> a
getJsonBalancedParens :: JsonBalancedParens a -> a
getJsonBalancedParens (JsonBalancedParens a
a) = a
a

genBitWordsForever :: BS.ByteString -> Maybe (Word8, BS.ByteString)
genBitWordsForever :: ByteString -> Maybe (Word8, ByteString)
genBitWordsForever 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)
{-# INLINABLE genBitWordsForever #-}

instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens [Bool])) where
  fromBlankedJson :: BlankedJson -> JsonBalancedParens (SimpleBalancedParens [Bool])
fromBlankedJson (BlankedJson [ByteString]
bj) = SimpleBalancedParens [Bool]
-> JsonBalancedParens (SimpleBalancedParens [Bool])
forall a. a -> JsonBalancedParens a
JsonBalancedParens ([Bool] -> SimpleBalancedParens [Bool]
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (ConduitT ByteString Bool [] () -> [ByteString] -> [Bool]
forall i o. ConduitT i o [] () -> [i] -> [o]
runListConduit ConduitT ByteString Bool [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m Bool
blankedJsonToBalancedParens [ByteString]
bj))

instance FromBlankedJson (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word8))) where
  fromBlankedJson :: BlankedJson
-> JsonBalancedParens (SimpleBalancedParens (Vector Word8))
fromBlankedJson BlankedJson
bj  = SimpleBalancedParens (Vector Word8)
-> JsonBalancedParens (SimpleBalancedParens (Vector Word8))
forall a. a -> JsonBalancedParens a
JsonBalancedParens (Vector Word8 -> SimpleBalancedParens (Vector Word8)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (Vector Word8 -> Vector Word8
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
BS.concat (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
blankedJsonToBalancedParens2 ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
=$= ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
compressWordAsBit) (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
bj))
          newLen :: Int
newLen      = (ByteString -> Int
BS.length ByteString
bpBS 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 (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word16))) where
  fromBlankedJson :: BlankedJson
-> JsonBalancedParens (SimpleBalancedParens (Vector Word16))
fromBlankedJson BlankedJson
bj  = SimpleBalancedParens (Vector Word16)
-> JsonBalancedParens (SimpleBalancedParens (Vector Word16))
forall a. a -> JsonBalancedParens a
JsonBalancedParens (Vector Word16 -> SimpleBalancedParens (Vector Word16)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (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)
genBitWordsForever ByteString
bpBS)))
    where bpBS :: ByteString
bpBS        = [ByteString] -> ByteString
BS.concat (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
blankedJsonToBalancedParens2 ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
=$= ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
compressWordAsBit) (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
bj))
          newLen :: Int
newLen      = (ByteString -> Int
BS.length ByteString
bpBS 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 (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word32))) where
  fromBlankedJson :: BlankedJson
-> JsonBalancedParens (SimpleBalancedParens (Vector Word32))
fromBlankedJson BlankedJson
bj  = SimpleBalancedParens (Vector Word32)
-> JsonBalancedParens (SimpleBalancedParens (Vector Word32))
forall a. a -> JsonBalancedParens a
JsonBalancedParens (Vector Word32 -> SimpleBalancedParens (Vector Word32)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (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)
genBitWordsForever ByteString
bpBS)))
    where bpBS :: ByteString
bpBS        = [ByteString] -> ByteString
BS.concat (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
blankedJsonToBalancedParens2 ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
=$= ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
compressWordAsBit) (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
bj))
          newLen :: Int
newLen      = (ByteString -> Int
BS.length ByteString
bpBS 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 (JsonBalancedParens (SimpleBalancedParens (DVS.Vector Word64))) where
  fromBlankedJson :: BlankedJson
-> JsonBalancedParens (SimpleBalancedParens (Vector Word64))
fromBlankedJson BlankedJson
bj  = SimpleBalancedParens (Vector Word64)
-> JsonBalancedParens (SimpleBalancedParens (Vector Word64))
forall a. a -> JsonBalancedParens a
JsonBalancedParens (Vector Word64 -> SimpleBalancedParens (Vector Word64)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens (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
BS.concat (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
blankedJsonToBalancedParens2 ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
-> ConduitT ByteString ByteString [] ()
forall (m :: * -> *) a b c r.
Monad m =>
Conduit a m b -> ConduitT b c m r -> ConduitT a c m r
=$= ConduitT ByteString ByteString [] ()
forall (m :: * -> *). Monad m => Conduit ByteString m ByteString
compressWordAsBit) (BlankedJson -> [ByteString]
getBlankedJson BlankedJson
bj))
          newLen :: Int
newLen      = (ByteString -> Int
BS.length ByteString
bpBS 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