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

module HaskellWorks.Data.Json.Succinct.Index where

import           Control.Arrow
import           Control.Monad
import qualified Data.ByteString                                            as BS
import qualified Data.List                                                  as L
import           HaskellWorks.Data.Bits.BitWise
import           HaskellWorks.Data.Decode
import           HaskellWorks.Data.Json.CharLike
import           HaskellWorks.Data.Json.Succinct
import           HaskellWorks.Data.Positioning
import qualified HaskellWorks.Data.Succinct.BalancedParens                  as BP
import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0
import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1
import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1
import           HaskellWorks.Data.TreeCursor
import           HaskellWorks.Data.Vector.VectorLike

data JsonIndex
  = JsonIndexString BS.ByteString
  | JsonIndexNumber BS.ByteString
  | JsonIndexObject [(BS.ByteString, JsonIndex)]
  | JsonIndexArray [JsonIndex]
  | JsonIndexBool Bool
  | JsonIndexNull
  deriving (JsonIndex -> JsonIndex -> Bool
(JsonIndex -> JsonIndex -> Bool)
-> (JsonIndex -> JsonIndex -> Bool) -> Eq JsonIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonIndex -> JsonIndex -> Bool
$c/= :: JsonIndex -> JsonIndex -> Bool
== :: JsonIndex -> JsonIndex -> Bool
$c== :: JsonIndex -> JsonIndex -> Bool
Eq, Int -> JsonIndex -> ShowS
[JsonIndex] -> ShowS
JsonIndex -> String
(Int -> JsonIndex -> ShowS)
-> (JsonIndex -> String)
-> ([JsonIndex] -> ShowS)
-> Show JsonIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonIndex] -> ShowS
$cshowList :: [JsonIndex] -> ShowS
show :: JsonIndex -> String
$cshow :: JsonIndex -> String
showsPrec :: Int -> JsonIndex -> ShowS
$cshowsPrec :: Int -> JsonIndex -> ShowS
Show)

class JsonIndexAt a where
  jsonIndexAt :: a -> Either DecodeError JsonIndex

instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where
  jsonIndexAt :: JsonCursor ByteString v w -> Either DecodeError JsonIndex
jsonIndexAt JsonCursor ByteString v w
k = case ByteString -> Maybe (Elem ByteString, ByteString)
forall v. Seq v => v -> Maybe (Elem v, v)
vUncons ByteString
remainder of
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isLeadingDigit2 Word8
Elem ByteString
c  -> JsonIndex -> Either DecodeError JsonIndex
forall a b. b -> Either a b
Right (ByteString -> JsonIndex
JsonIndexNumber  ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isQuotDbl Word8
Elem ByteString
c        -> JsonIndex -> Either DecodeError JsonIndex
forall a b. b -> Either a b
Right (ByteString -> JsonIndex
JsonIndexString  ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_t Word8
Elem ByteString
c         -> JsonIndex -> Either DecodeError JsonIndex
forall a b. b -> Either a b
Right (Bool -> JsonIndex
JsonIndexBool    Bool
True)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_f Word8
Elem ByteString
c         -> JsonIndex -> Either DecodeError JsonIndex
forall a b. b -> Either a b
Right (Bool -> JsonIndex
JsonIndexBool    Bool
False)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_n Word8
Elem ByteString
c         -> JsonIndex -> Either DecodeError JsonIndex
forall a b. b -> Either a b
Right  JsonIndex
JsonIndexNull
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isBraceLeft Word8
Elem ByteString
c      -> [(ByteString, JsonIndex)] -> JsonIndex
JsonIndexObject ([(ByteString, JsonIndex)] -> JsonIndex)
-> Either DecodeError [(ByteString, JsonIndex)]
-> Either DecodeError JsonIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (JsonCursor ByteString v w)
-> Either DecodeError [(ByteString, JsonIndex)]
forall a.
(JsonIndexAt a, TreeCursor a) =>
Maybe a -> Either DecodeError [(ByteString, JsonIndex)]
mapValuesFrom   (JsonCursor ByteString v w -> Maybe (JsonCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild JsonCursor ByteString v w
k)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isBracketLeft Word8
Elem ByteString
c    -> [JsonIndex] -> JsonIndex
JsonIndexArray  ([JsonIndex] -> JsonIndex)
-> Either DecodeError [JsonIndex] -> Either DecodeError JsonIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (JsonCursor ByteString v w) -> Either DecodeError [JsonIndex]
forall a.
(JsonIndexAt a, TreeCursor a) =>
Maybe a -> Either DecodeError [JsonIndex]
arrayValuesFrom (JsonCursor ByteString v w -> Maybe (JsonCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild JsonCursor ByteString v w
k)
    Just (Elem ByteString, ByteString)
_                            -> DecodeError -> Either DecodeError JsonIndex
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"Invalid Json Type")
    Maybe (Elem ByteString, ByteString)
Nothing                           -> DecodeError -> Either DecodeError JsonIndex
forall a b. a -> Either a b
Left (String -> DecodeError
DecodeError String
"End of data"      )
    where ik :: v
ik                = JsonCursor ByteString v w -> v
forall t v w. JsonCursor t v w -> v
interests JsonCursor ByteString v w
k
          bpk :: w
bpk               = JsonCursor ByteString v w -> w
forall t v w. JsonCursor t v w -> w
balancedParens JsonCursor ByteString v w
k
          p :: Position
p                 = Count -> Position
lastPositionOf (v -> Count -> Count
forall v. Select1 v => v -> Count -> Count
select1 v
ik (w -> Count -> Count
forall v. Rank1 v => v -> Count -> Count
rank1 w
bpk (JsonCursor ByteString v w -> Count
forall t v w. JsonCursor t v w -> Count
cursorRank JsonCursor ByteString v w
k)))
          remainder :: ByteString
remainder         = Count -> ByteString -> ByteString
forall v. Seq v => Count -> v -> v
vDrop (Position -> Count
toCount Position
p) (JsonCursor ByteString v w -> ByteString
forall t v w. JsonCursor t v w -> t
cursorText JsonCursor ByteString v w
k)
          arrayValuesFrom :: Maybe a -> Either DecodeError [JsonIndex]
arrayValuesFrom Maybe a
j = [Either DecodeError JsonIndex] -> Either DecodeError [JsonIndex]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Maybe a -> Maybe (Either DecodeError JsonIndex, Maybe a))
-> Maybe a -> [Either DecodeError JsonIndex]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr ((a -> (Either DecodeError JsonIndex, Maybe a))
-> Maybe a -> Maybe (Either DecodeError JsonIndex, Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Either DecodeError JsonIndex
forall a. JsonIndexAt a => a -> Either DecodeError JsonIndex
jsonIndexAt (a -> Either DecodeError JsonIndex)
-> (a -> Maybe a) -> a -> (Either DecodeError JsonIndex, Maybe a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> Maybe a
forall k. TreeCursor k => k -> Maybe k
nextSibling)) Maybe a
j)
          mapValuesFrom :: Maybe a -> Either DecodeError [(ByteString, JsonIndex)]
mapValuesFrom Maybe a
j   = ([JsonIndex] -> [(JsonIndex, JsonIndex)]
forall b. [b] -> [(b, b)]
pairwise ([JsonIndex] -> [(JsonIndex, JsonIndex)])
-> ((JsonIndex, JsonIndex) -> [(ByteString, JsonIndex)])
-> [JsonIndex]
-> [(ByteString, JsonIndex)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (JsonIndex, JsonIndex) -> [(ByteString, JsonIndex)]
forall b. (JsonIndex, b) -> [(ByteString, b)]
asField) ([JsonIndex] -> [(ByteString, JsonIndex)])
-> Either DecodeError [JsonIndex]
-> Either DecodeError [(ByteString, JsonIndex)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> Either DecodeError [JsonIndex]
forall a.
(JsonIndexAt a, TreeCursor a) =>
Maybe a -> Either DecodeError [JsonIndex]
arrayValuesFrom Maybe a
j
          pairwise :: [b] -> [(b, b)]
pairwise (b
a:b
b:[b]
rs) = (b
a, b
b) (b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
pairwise [b]
rs
          pairwise [b]
_        = []
          asField :: (JsonIndex, b) -> [(ByteString, b)]
asField (JsonIndex
a, b
b)    = case JsonIndex
a of
                                JsonIndexString ByteString
s -> [(ByteString
s, b
b)]
                                JsonIndex
_                 -> []