{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

module HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex
  ( blankedJsonToInterestBits
  , byteStringToBits
  , blankedJsonToBalancedParens
  , compressWordAsBit
  , interestingWord8s
  ) where

import Control.Monad
import Data.Array.Unboxed             ((!))
import Data.ByteString                (ByteString)
import Data.Int
import Data.Word
import Data.Word8
import GHC.Generics
import HaskellWorks.Data.Bits.BitWise
import Prelude                        as P

import qualified Data.Array.Unboxed as A
import qualified Data.Bits          as BITS
import qualified Data.ByteString    as BS

interestingWord8s :: A.UArray Word8 Word8
interestingWord8s :: UArray Word8 Word8
interestingWord8s = (Word8, Word8) -> [(Word8, Word8)] -> UArray Word8 Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Word8
0, Word8
255) [
  (Word8
w, if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_bracketleft Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_braceleft Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_parenleft Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_t Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_f Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_n Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_1
    then Word8
1
    else Word8
0)
  | Word8
w <- [Word8
0 .. Word8
255]]

blankedJsonToInterestBits :: [BS.ByteString] -> [BS.ByteString]
blankedJsonToInterestBits :: [ByteString] -> [ByteString]
blankedJsonToInterestBits = ByteString -> [ByteString] -> [ByteString]
blankedJsonToInterestBits' ByteString
""

padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString
padRight :: Word8 -> Int -> ByteString -> ByteString
padRight Word8
w Int
n ByteString
bs = if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n then ByteString
bs else (ByteString, Maybe ByteString) -> ByteString
forall a b. (a, b) -> a
fst (Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
n ByteString -> Maybe (Word8, ByteString)
gen ByteString
bs)
  where gen :: ByteString -> Maybe (Word8, ByteString)
        gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
          Just (Word8
c, ByteString
ds) -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
c, ByteString
ds)
          Maybe (Word8, ByteString)
Nothing      -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
w, ByteString
BS.empty)

blankedJsonToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]
blankedJsonToInterestBits' :: ByteString -> [ByteString] -> [ByteString]
blankedJsonToInterestBits' ByteString
rs [ByteString]
as = case [ByteString]
as of
  (ByteString
bs:[ByteString]
bss) ->
      let cs :: ByteString
cs = if ByteString -> Int
BS.length ByteString
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then [ByteString] -> ByteString
BS.concat [ByteString
rs, ByteString
bs] else ByteString
bs in
      let lencs :: Int
lencs = ByteString -> Int
BS.length ByteString
cs in
      let q :: Int
q = Int
lencs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8 in
      let (ByteString
ds, ByteString
es) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) ByteString
cs in
      let (ByteString
fs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
q ByteString -> Maybe (Word8, ByteString)
gen ByteString
ds in
      ByteString
fsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString] -> [ByteString]
blankedJsonToInterestBits' ByteString
es [ByteString]
bss
  [] -> []
  where gen :: ByteString -> Maybe (Word8, ByteString)
        gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
ds = if ByteString -> Int
BS.length ByteString
ds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
          else (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ( (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr (\Word8
b Word8
m -> (UArray Word8 Word8
interestingWord8s UArray Word8 Word8 -> Word8 -> Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Word8
b) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
m Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count
1)) Word8
0 (Word8 -> Int -> ByteString -> ByteString
padRight Word8
0 Int
8 (Int -> ByteString -> ByteString
BS.take Int
8 ByteString
ds))
                    , Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
ds
                    )

repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)
repartitionMod8 :: ByteString -> ByteString -> (ByteString, ByteString)
repartitionMod8 ByteString
aBS ByteString
bBS = (Int -> ByteString -> ByteString
BS.take Int
cLen ByteString
abBS, Int -> ByteString -> ByteString
BS.drop Int
cLen ByteString
abBS)
  where abBS :: ByteString
abBS = [ByteString] -> ByteString
BS.concat [ByteString
aBS, ByteString
bBS]
        abLen :: Int
abLen = ByteString -> Int
BS.length ByteString
abBS
        cLen :: Int
cLen = (Int
abLen 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

compressWordAsBit :: [BS.ByteString] -> [BS.ByteString]
compressWordAsBit :: [ByteString] -> [ByteString]
compressWordAsBit = ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
BS.empty

compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString]
compressWordAsBit' :: ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
aBS [ByteString]
as = case [ByteString]
as of
  (ByteString
bBS:[ByteString]
bBSs) ->
    let (ByteString
cBS, ByteString
dBS) = ByteString -> ByteString -> (ByteString, ByteString)
repartitionMod8 ByteString
aBS ByteString
bBS in
    let (ByteString
cs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
cBS 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) ByteString -> Maybe (Word8, ByteString)
gen ByteString
cBS in
    ByteString
csByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString] -> [ByteString]
compressWordAsBit' ByteString
dBS [ByteString]
bBSs
  [] -> do
    let (ByteString
cs, Maybe ByteString
_) = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> (ByteString, Maybe ByteString)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
aBS 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) ByteString -> Maybe (Word8, ByteString)
gen ByteString
aBS
    [ByteString
cs]
  where gen :: ByteString -> Maybe (Word8, ByteString)
        gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
xs = if ByteString -> Int
BS.length ByteString
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
          else (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just ( (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr (\Word8
b Word8
m -> ((Word8
b Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
1) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
m Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count
1))) Word8
0 (Word8 -> Int -> ByteString -> ByteString
padRight Word8
0 Int
8 (Int -> ByteString -> ByteString
BS.take Int
8 ByteString
xs))
                    , Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
xs
                    )

blankedJsonToBalancedParens :: [BS.ByteString] -> [BS.ByteString]
blankedJsonToBalancedParens :: [ByteString] -> [ByteString]
blankedJsonToBalancedParens [ByteString]
as = case [ByteString]
as of
  (ByteString
bs:[ByteString]
bss) ->
    let (ByteString
cs, Maybe (Maybe Bool, ByteString)
_) = Int
-> ((Maybe Bool, ByteString)
    -> Maybe (Word8, (Maybe Bool, ByteString)))
-> (Maybe Bool, ByteString)
-> (ByteString, Maybe (Maybe Bool, ByteString))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
gen (Maybe Bool
forall a. Maybe a
Nothing, ByteString
bs) in
    ByteString
csByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString] -> [ByteString]
blankedJsonToBalancedParens [ByteString]
bss
  [] -> []
  where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
        gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
gen (Just Bool
True  , ByteString
bs) = (Word8, (Maybe Bool, ByteString))
-> Maybe (Word8, (Maybe Bool, ByteString))
forall a. a -> Maybe a
Just (Word8
0xFF, (Maybe Bool
forall a. Maybe a
Nothing, ByteString
bs))
        gen (Just Bool
False , ByteString
bs) = (Word8, (Maybe Bool, ByteString))
-> Maybe (Word8, (Maybe Bool, ByteString))
forall a. a -> Maybe a
Just (Word8
0x00, (Maybe Bool
forall a. Maybe a
Nothing, ByteString
bs))
        gen (Maybe Bool
Nothing    , ByteString
bs) = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
          Just (Word8
c, ByteString
cs) -> case Word8 -> MiniBP
balancedParensOf Word8
c of
            MiniBP
MiniN  -> (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString))
gen         (Maybe Bool
forall a. Maybe a
Nothing    , ByteString
cs)
            MiniBP
MiniT  -> (Word8, (Maybe Bool, ByteString))
-> Maybe (Word8, (Maybe Bool, ByteString))
forall a. a -> Maybe a
Just (Word8
0xFF, (Maybe Bool
forall a. Maybe a
Nothing    , ByteString
cs))
            MiniBP
MiniF  -> (Word8, (Maybe Bool, ByteString))
-> Maybe (Word8, (Maybe Bool, ByteString))
forall a. a -> Maybe a
Just (Word8
0x00, (Maybe Bool
forall a. Maybe a
Nothing    , ByteString
cs))
            MiniBP
MiniTF -> (Word8, (Maybe Bool, ByteString))
-> Maybe (Word8, (Maybe Bool, ByteString))
forall a. a -> Maybe a
Just (Word8
0xFF, (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False , ByteString
cs))
          Maybe (Word8, ByteString)
Nothing   -> Maybe (Word8, (Maybe Bool, ByteString))
forall a. Maybe a
Nothing

data MiniBP = MiniN | MiniT | MiniF | MiniTF deriving (forall x. MiniBP -> Rep MiniBP x)
-> (forall x. Rep MiniBP x -> MiniBP) -> Generic MiniBP
forall x. Rep MiniBP x -> MiniBP
forall x. MiniBP -> Rep MiniBP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MiniBP x -> MiniBP
$cfrom :: forall x. MiniBP -> Rep MiniBP x
Generic

balancedParensOf :: Word8 -> MiniBP
balancedParensOf :: Word8 -> MiniBP
balancedParensOf Word8
c = case Word8
c of
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_braceleft    -> MiniBP
MiniT
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_braceright   -> MiniBP
MiniF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_bracketleft  -> MiniBP
MiniT
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_bracketright -> MiniBP
MiniF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_parenleft    -> MiniBP
MiniT
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_parenright   -> MiniBP
MiniF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_t            -> MiniBP
MiniTF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_f            -> MiniBP
MiniTF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_1            -> MiniBP
MiniTF
    Word8
d | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_n            -> MiniBP
MiniTF
    Word8
_                      -> MiniBP
MiniN

yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool]
yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool]
yieldBitsOfWord8 Word8
w =
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
0) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
1) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
2) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
3) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
4) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
5) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
6) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Int -> Word8
forall a. Bits a => Int -> a
BITS.bit Int
7) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)

yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool]
yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool]
yieldBitsofWord8s = (Word8 -> ([Bool] -> [Bool]) -> [Bool] -> [Bool])
-> ([Bool] -> [Bool]) -> [Word8] -> [Bool] -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
P.foldr (([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool])
-> (Word8 -> [Bool] -> [Bool])
-> Word8
-> ([Bool] -> [Bool])
-> [Bool]
-> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> [Bool] -> [Bool]
yieldBitsOfWord8) [Bool] -> [Bool]
forall a. a -> a
id

byteStringToBits :: [BS.ByteString] -> [Bool] -> [Bool]
byteStringToBits :: [ByteString] -> [Bool] -> [Bool]
byteStringToBits [ByteString]
as = case [ByteString]
as of
  (ByteString
bs:[ByteString]
bss) -> [Word8] -> [Bool] -> [Bool]
yieldBitsofWord8s (ByteString -> [Word8]
BS.unpack ByteString
bs) ([Bool] -> [Bool]) -> ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [Bool] -> [Bool]
byteStringToBits [ByteString]
bss
  []       -> [Bool] -> [Bool]
forall a. a -> a
id