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

module HaskellWorks.Data.Json.Internal.Index where

import Control.Arrow
import Control.Monad
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Drop
import HaskellWorks.Data.Json.DecodeError
import HaskellWorks.Data.Json.Internal.CharLike
import HaskellWorks.Data.Json.Standard.Cursor.Generic
import HaskellWorks.Data.Positioning
import HaskellWorks.Data.RankSelect.Base.Rank0
import HaskellWorks.Data.RankSelect.Base.Rank1
import HaskellWorks.Data.RankSelect.Base.Select1
import HaskellWorks.Data.TreeCursor
import HaskellWorks.Data.Uncons
import Prelude                                        hiding (drop)

import qualified Data.ByteString                  as BS
import qualified Data.List                        as L
import qualified HaskellWorks.Data.BalancedParens as BP

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 (GenericCursor BS.ByteString v w) where
  jsonIndexAt :: GenericCursor ByteString v w -> Either DecodeError JsonIndex
jsonIndexAt GenericCursor ByteString v w
k = case ByteString -> Maybe (Elem ByteString, ByteString)
forall v. Uncons v => v -> Maybe (Elem v, v)
uncons 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 (GenericCursor ByteString v w)
-> Either DecodeError [(ByteString, JsonIndex)]
forall a.
(JsonIndexAt a, TreeCursor a) =>
Maybe a -> Either DecodeError [(ByteString, JsonIndex)]
mapValuesFrom   (GenericCursor ByteString v w
-> Maybe (GenericCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild GenericCursor 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 (GenericCursor ByteString v w)
-> Either DecodeError [JsonIndex]
forall a.
(JsonIndexAt a, TreeCursor a) =>
Maybe a -> Either DecodeError [JsonIndex]
arrayValuesFrom (GenericCursor ByteString v w
-> Maybe (GenericCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
firstChild GenericCursor 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                = GenericCursor ByteString v w -> v
forall t v w. GenericCursor t v w -> v
interests GenericCursor ByteString v w
k
          bpk :: w
bpk               = GenericCursor ByteString v w -> w
forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor 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 (GenericCursor ByteString v w -> Count
forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor ByteString v w
k)))
          remainder :: ByteString
remainder         = Count -> ByteString -> ByteString
forall v. Drop v => Count -> v -> v
drop (Position -> Count
forall a. ToCount a => a -> Count
toCount Position
p) (GenericCursor ByteString v w -> ByteString
forall t v w. GenericCursor t v w -> t
cursorText GenericCursor 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
_                 -> []