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

module HaskellWorks.Data.Json.LightJson where

import Control.Arrow
import Control.Monad
import Data.String
import Data.Text                                      (Text)
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Drop
import HaskellWorks.Data.Json.Internal.CharLike
import HaskellWorks.Data.Json.Internal.Doc
import HaskellWorks.Data.Json.Internal.Slurp
import HaskellWorks.Data.Json.Standard.Cursor.Generic
import HaskellWorks.Data.MQuery
import HaskellWorks.Data.MQuery.AtLeastSize
import HaskellWorks.Data.MQuery.Entry
import HaskellWorks.Data.MQuery.Micro
import HaskellWorks.Data.MQuery.Mini
import HaskellWorks.Data.MQuery.Row
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 Text.PrettyPrint.ANSI.Leijen

import qualified Data.ByteString                      as BS
import qualified Data.ByteString.Unsafe               as BSU
import qualified Data.List                            as L
import qualified Data.Text                            as T
import qualified HaskellWorks.Data.BalancedParens     as BP
import qualified HaskellWorks.Data.Json.Simple.Cursor as JSC

data LightJson c
  = LightJsonString Text
  | LightJsonNumber BS.ByteString
  | LightJsonObject [(Text, c)]
  | LightJsonArray [c]
  | LightJsonBool Bool
  | LightJsonNull
  | LightJsonError Text
  deriving Int -> LightJson c -> ShowS
[LightJson c] -> ShowS
LightJson c -> String
(Int -> LightJson c -> ShowS)
-> (LightJson c -> String)
-> ([LightJson c] -> ShowS)
-> Show (LightJson c)
forall c. Show c => Int -> LightJson c -> ShowS
forall c. Show c => [LightJson c] -> ShowS
forall c. Show c => LightJson c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LightJson c] -> ShowS
$cshowList :: forall c. Show c => [LightJson c] -> ShowS
show :: LightJson c -> String
$cshow :: forall c. Show c => LightJson c -> String
showsPrec :: Int -> LightJson c -> ShowS
$cshowsPrec :: forall c. Show c => Int -> LightJson c -> ShowS
Show

instance LightJsonAt c => Eq (LightJson c) where
  == :: LightJson c -> LightJson c -> Bool
(==) (LightJsonString Text
a) (LightJsonString Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
  (==) (LightJsonNumber ByteString
a) (LightJsonNumber ByteString
b) = ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
b
  (==) (LightJsonBool   Bool
a) (LightJsonBool   Bool
b) = Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b
  (==) (LightJsonObject [(Text, c)]
a) (LightJsonObject [(Text, c)]
b) = ((Text, c) -> (Text, LightJson c))
-> [(Text, c)] -> [(Text, LightJson c)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> LightJson c) -> (Text, c) -> (Text, LightJson c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
a [(Text, LightJson c)] -> [(Text, LightJson c)] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Text, c) -> (Text, LightJson c))
-> [(Text, c)] -> [(Text, LightJson c)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> LightJson c) -> (Text, c) -> (Text, LightJson c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
b
  (==) (LightJsonArray  [c]
a) (LightJsonArray  [c]
b) = (c -> LightJson c) -> [c] -> [LightJson c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt [c]
a [LightJson c] -> [LightJson c] -> Bool
forall a. Eq a => a -> a -> Bool
== (c -> LightJson c) -> [c] -> [LightJson c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt [c]
b
  (==)  LightJson c
LightJsonNull       LightJson c
LightJsonNull      = Bool
True
  (==) (LightJsonError  Text
a) (LightJsonError  Text
b) = Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b
  (==)  LightJson c
_                   LightJson c
_                  = Bool
False

data LightJsonField c = LightJsonField Text (LightJson c)

class LightJsonAt a where
  lightJsonAt :: a -> LightJson a

instance LightJsonAt c => Pretty (LightJsonField c) where
  pretty :: LightJsonField c -> Doc
pretty (LightJsonField Text
k LightJson c
v) = String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
k) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> LightJson c -> Doc
forall a. Pretty a => a -> Doc
pretty LightJson c
v

instance LightJsonAt c => Pretty (LightJson c) where
  pretty :: LightJson c -> Doc
pretty LightJson c
c = case LightJson c
c of
    LightJsonString Text
s   -> Doc -> Doc
dullgreen  (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
    LightJsonNumber ByteString
n   -> Doc -> Doc
cyan       (String -> Doc
text (ByteString -> String
forall a. Show a => a -> String
show ByteString
n))
    LightJsonObject []  -> String -> Doc
text String
"{}"
    LightJsonObject [(Text, c)]
kvs -> Doc -> Doc -> Doc -> [Doc] -> Doc
hEncloseSep (String -> Doc
text String
"{") (String -> Doc
text String
"}") (String -> Doc
text String
",") ((LightJsonField c -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJsonField c -> Doc)
-> ((Text, c) -> LightJsonField c) -> (Text, c) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, LightJson c) -> LightJsonField c
toLightJsonField ((Text, LightJson c) -> LightJsonField c)
-> ((Text, c) -> (Text, LightJson c))
-> (Text, c)
-> LightJsonField c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> LightJson c) -> (Text, c) -> (Text, LightJson c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) ((Text, c) -> Doc) -> [(Text, c)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, c)]
kvs)
    LightJsonArray [c]
vs   -> Doc -> Doc -> Doc -> [Doc] -> Doc
hEncloseSep (String -> Doc
text String
"[") (String -> Doc
text String
"]") (String -> Doc
text String
",") ((LightJson c -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJson c -> Doc) -> (c -> LightJson c) -> c -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) (c -> Doc) -> [c] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [c]
vs)
    LightJsonBool Bool
w     -> Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
    LightJson c
LightJsonNull       -> String -> Doc
text String
"null"
    LightJsonError Text
s    -> String -> Doc
text String
"<error " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
">"
    where toLightJsonField :: (Text, LightJson c) -> LightJsonField c
          toLightJsonField :: (Text, LightJson c) -> LightJsonField c
toLightJsonField (Text
k, LightJson c
v) = Text -> LightJson c -> LightJsonField c
forall c. Text -> LightJson c -> LightJsonField c
LightJsonField Text
k LightJson c
v

instance Pretty (Micro (LightJson c)) where
  pretty :: Micro (LightJson c) -> Doc
pretty (Micro (LightJsonString Text
s )) = Doc -> Doc
dullgreen (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
  pretty (Micro (LightJsonNumber ByteString
n )) = Doc -> Doc
cyan      (String -> Doc
text (ByteString -> String
forall a. Show a => a -> String
show ByteString
n))
  pretty (Micro (LightJsonObject [])) = String -> Doc
text String
"{}"
  pretty (Micro (LightJsonObject [(Text, c)]
_ )) = String -> Doc
text String
"{..}"
  pretty (Micro (LightJsonArray [] )) = String -> Doc
text String
"[]"
  pretty (Micro (LightJsonArray [c]
_  )) = String -> Doc
text String
"[..]"
  pretty (Micro (LightJsonBool Bool
w   )) = Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
  pretty (Micro  LightJson c
LightJsonNull      ) = String -> Doc
text String
"null"
  pretty (Micro (LightJsonError Text
s  )) = String -> Doc
text String
"<error " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
">"

instance Pretty (Micro (String, LightJson c)) where
  pretty :: Micro (String, LightJson c) -> Doc
pretty (Micro (String
fieldName, LightJson c
jpv)) = Doc -> Doc
red (String -> Doc
text (ShowS
forall a. Show a => a -> String
show String
fieldName)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Micro (LightJson c) -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJson c -> Micro (LightJson c)
forall a. a -> Micro a
Micro LightJson c
jpv)

instance Pretty (Micro (Text, LightJson c)) where
  pretty :: Micro (Text, LightJson c) -> Doc
pretty (Micro (Text
fieldName, LightJson c
jpv)) = Doc -> Doc
red (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
fieldName)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Micro (LightJson c) -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJson c -> Micro (LightJson c)
forall a. a -> Micro a
Micro LightJson c
jpv)

instance LightJsonAt c => Pretty (Mini (LightJson c)) where
  pretty :: Mini (LightJson c) -> Doc
pretty Mini (LightJson c)
mjpv = case Mini (LightJson c)
mjpv of
    Mini (LightJsonString Text
s   ) -> Doc -> Doc
dullgreen  (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
    Mini (LightJsonNumber ByteString
n   ) -> Doc -> Doc
cyan       (String -> Doc
text (ByteString -> String
forall a. Show a => a -> String
show ByteString
n))
    Mini (LightJsonObject []  ) -> String -> Doc
text String
"{}"
    Mini (LightJsonObject [(Text, c)]
kvs ) -> case [(Text, c)]
kvs of
      ((Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:(Text, c)
_:[(Text, c)]
_) -> String -> Doc
text String
"{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [(Text, LightJson c)] -> Doc
forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs (((Text, c) -> (Text, LightJson c))
-> [(Text, c)] -> [(Text, LightJson c)]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> LightJson c) -> (Text, c) -> (Text, LightJson c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
kvs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..}"
      []                          -> String -> Doc
text String
"{}"
      [(Text, c)]
_                           -> String -> Doc
text String
"{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [(Text, LightJson c)] -> Doc
forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs (((Text, c) -> (Text, LightJson c))
-> [(Text, c)] -> [(Text, LightJson c)]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> LightJson c) -> (Text, c) -> (Text, LightJson c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
kvs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"}"
    Mini (LightJsonArray []   ) -> String -> Doc
text String
"[]"
    Mini (LightJsonArray [c]
vs   ) | [c]
vs [c] -> Int -> Bool
forall a. AtLeastSize a => a -> Int -> Bool
`atLeastSize` Int
11 -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 ([Micro (LightJson c)] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs ((LightJson c -> Micro (LightJson c)
forall a. a -> Micro a
Micro (LightJson c -> Micro (LightJson c))
-> (c -> LightJson c) -> c -> Micro (LightJson c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) (c -> Micro (LightJson c)) -> [c] -> [Micro (LightJson c)]
forall a b. (a -> b) -> [a] -> [b]
`map` Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
10 [c]
vs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..]"
    Mini (LightJsonArray [c]
vs   ) | [c]
vs [c] -> Int -> Bool
forall a. AtLeastSize a => a -> Int -> Bool
`atLeastSize` Int
1  -> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 ([Micro (LightJson c)] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs ((LightJson c -> Micro (LightJson c)
forall a. a -> Micro a
Micro (LightJson c -> Micro (LightJson c))
-> (c -> LightJson c) -> c -> Micro (LightJson c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) (c -> Micro (LightJson c)) -> [c] -> [Micro (LightJson c)]
forall a b. (a -> b) -> [a] -> [b]
`map` Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
10 [c]
vs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
    Mini (LightJsonArray [c]
_    )                       -> String -> Doc
text String
"[]"
    Mini (LightJsonBool Bool
w     ) -> Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
    Mini  LightJson c
LightJsonNull         -> String -> Doc
text String
"null"
    Mini (LightJsonError Text
s    ) -> String -> Doc
text String
"<error " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
">"

instance LightJsonAt c => Pretty (Mini (String, LightJson c)) where
  pretty :: Mini (String, LightJson c) -> Doc
pretty (Mini (String
fieldName, LightJson c
jpv)) = String -> Doc
text (ShowS
forall a. Show a => a -> String
show String
fieldName) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Mini (LightJson c) -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJson c -> Mini (LightJson c)
forall a. a -> Mini a
Mini LightJson c
jpv)

instance LightJsonAt c => Pretty (Mini (Text, LightJson c)) where
  pretty :: Mini (Text, LightJson c) -> Doc
pretty (Mini (Text
fieldName, LightJson c
jpv)) = String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
fieldName) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Mini (LightJson c) -> Doc
forall a. Pretty a => a -> Doc
pretty (LightJson c -> Mini (LightJson c)
forall a. a -> Mini a
Mini LightJson c
jpv)

instance LightJsonAt c => Pretty (MQuery (LightJson c)) where
  pretty :: MQuery (LightJson c) -> Doc
pretty = Row (DList (LightJson c)) -> Doc
forall a. Pretty a => a -> Doc
pretty (Row (DList (LightJson c)) -> Doc)
-> (MQuery (LightJson c) -> Row (DList (LightJson c)))
-> MQuery (LightJson c)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DList (LightJson c) -> Row (DList (LightJson c))
forall a. Int -> a -> Row a
Row Int
120 (DList (LightJson c) -> Row (DList (LightJson c)))
-> (MQuery (LightJson c) -> DList (LightJson c))
-> MQuery (LightJson c)
-> Row (DList (LightJson c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MQuery (LightJson c) -> DList (LightJson c)
forall a. MQuery a -> DList a
mQuery

instance LightJsonAt c => Pretty (MQuery (Entry String (LightJson c))) where
  pretty :: MQuery (Entry String (LightJson c)) -> Doc
pretty (MQuery DList (Entry String (LightJson c))
das) = Row (DList (Entry String (LightJson c))) -> Doc
forall a. Pretty a => a -> Doc
pretty (Int
-> DList (Entry String (LightJson c))
-> Row (DList (Entry String (LightJson c)))
forall a. Int -> a -> Row a
Row Int
120 DList (Entry String (LightJson c))
das)

instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (GenericCursor BS.ByteString v w) where
  lightJsonAt :: GenericCursor ByteString v w
-> LightJson (GenericCursor ByteString v w)
lightJsonAt 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 -> ByteString -> LightJson (GenericCursor ByteString v w)
forall c. ByteString -> LightJson c
LightJsonNumber  (ByteString -> ByteString
slurpNumber ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isQuotDbl Word8
Elem ByteString
c       -> (Text -> LightJson (GenericCursor ByteString v w))
-> (Text -> LightJson (GenericCursor ByteString v w))
-> Either Text Text
-> LightJson (GenericCursor ByteString v w)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> LightJson (GenericCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text -> LightJson (GenericCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonString (ByteString -> Either Text Text
slurpText ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_t Word8
Elem ByteString
c        -> Bool -> LightJson (GenericCursor ByteString v w)
forall c. Bool -> LightJson c
LightJsonBool    Bool
True
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_f Word8
Elem ByteString
c        -> Bool -> LightJson (GenericCursor ByteString v w)
forall c. Bool -> LightJson c
LightJsonBool    Bool
False
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isChar_n Word8
Elem ByteString
c        -> LightJson (GenericCursor ByteString v w)
forall c. LightJson c
LightJsonNull
    Just (!Elem ByteString
c, ByteString
_) | Word8 -> Bool
forall c. JsonCharLike c => c -> Bool
isBraceLeft Word8
Elem ByteString
c     -> [(Text, GenericCursor ByteString v w)]
-> LightJson (GenericCursor ByteString v w)
forall c. [(Text, c)] -> LightJson c
LightJsonObject (Maybe (GenericCursor ByteString v w)
-> [(Text, GenericCursor ByteString v w)]
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   -> [GenericCursor ByteString v w]
-> LightJson (GenericCursor ByteString v w)
forall c. [c] -> LightJson c
LightJsonArray  (Maybe (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
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)
_                           -> Text -> LightJson (GenericCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text
"Invalid Json Type"
    Maybe (Elem ByteString, ByteString)
Nothing                          -> Text -> LightJson (GenericCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text
"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 (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
arrayValuesFrom   = (Maybe (GenericCursor ByteString v w)
 -> Maybe
      (GenericCursor ByteString v w,
       Maybe (GenericCursor ByteString v w)))
-> Maybe (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr ((GenericCursor ByteString v w
 -> (GenericCursor ByteString v w,
     Maybe (GenericCursor ByteString v w)))
-> Maybe (GenericCursor ByteString v w)
-> Maybe
     (GenericCursor ByteString v w,
      Maybe (GenericCursor ByteString v w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenericCursor ByteString v w -> GenericCursor ByteString v w
forall a. a -> a
id (GenericCursor ByteString v w -> GenericCursor ByteString v w)
-> (GenericCursor ByteString v w
    -> Maybe (GenericCursor ByteString v w))
-> GenericCursor ByteString v w
-> (GenericCursor ByteString v w,
    Maybe (GenericCursor ByteString v w))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& GenericCursor ByteString v w
-> Maybe (GenericCursor ByteString v w)
forall k. TreeCursor k => k -> Maybe k
nextSibling))
          mapValuesFrom :: Maybe (GenericCursor ByteString v w)
-> [(Text, GenericCursor ByteString v w)]
mapValuesFrom Maybe (GenericCursor ByteString v w)
j   = [GenericCursor ByteString v w]
-> [(GenericCursor ByteString v w, GenericCursor ByteString v w)]
forall b. [b] -> [(b, b)]
pairwise (Maybe (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
arrayValuesFrom Maybe (GenericCursor ByteString v w)
j) [(GenericCursor ByteString v w, GenericCursor ByteString v w)]
-> ((GenericCursor ByteString v w, GenericCursor ByteString v w)
    -> [(Text, GenericCursor ByteString v w)])
-> [(Text, GenericCursor ByteString v w)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GenericCursor ByteString v w, GenericCursor ByteString v w)
-> [(Text, GenericCursor ByteString v w)]
forall a b. LightJsonAt a => (a, b) -> [(Text, b)]
asField
          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 :: (a, b) -> [(Text, b)]
asField (a
a, b
b)    = case a -> LightJson a
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt a
a of
                                LightJsonString Text
s -> [(Text
s, b
b)]
                                LightJson a
_                 -> []

instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JSC.JsonCursor BS.ByteString v w) where
  lightJsonAt :: JsonCursor ByteString v w -> LightJson (JsonCursor ByteString v w)
lightJsonAt JsonCursor ByteString v w
k = if Count
kra Count -> Count -> Count
forall a. Integral a => a -> a -> a
`mod` Count
2 Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
1
    then let i :: Int
i = Count -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count
kpa Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
1) :: Int in
      if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
kt
        then case ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
kt Int
i of
          Word8
91  -> [JsonCursor ByteString v w]
-> LightJson (JsonCursor ByteString v w)
forall c. [c] -> LightJson c
LightJsonArray  []
          Word8
123 -> [(Text, JsonCursor ByteString v w)]
-> LightJson (JsonCursor ByteString v w)
forall c. [(Text, c)] -> LightJson c
LightJsonObject []
          Word8
_   -> Text -> LightJson (JsonCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text
"Invalid collection character"
        else Text -> LightJson (JsonCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text
"Index out of bounds"
    else Text -> LightJson (JsonCursor ByteString v w)
forall c. Text -> LightJson c
LightJsonError Text
"Unaligned cursor"
    where kpa :: Count
kpa   = v -> Count -> Count
forall v. Select1 v => v -> Count -> Count
select1 v
kib Count
kta Count -> Count -> Count
forall a. Num a => a -> a -> a
+ Count
km
          kib :: v
kib   = JsonCursor ByteString v w -> v
forall t v w. JsonCursor t v w -> v
JSC.interests JsonCursor ByteString v w
k
          kra :: Count
kra   = JsonCursor ByteString v w -> Count
forall t v w. JsonCursor t v w -> Count
JSC.cursorRank JsonCursor ByteString v w
k
          ksa :: Count
ksa   = Count
kra Count -> Count -> Count
forall a. Num a => a -> a -> a
+ Count
1
          kta :: Count
kta   = Count
ksa Count -> Count -> Count
forall a. Integral a => a -> a -> a
`div` Count
2
          km :: Count
km    = Count
ksa Count -> Count -> Count
forall a. Integral a => a -> a -> a
`mod` Count
2
          kt :: ByteString
kt    = JsonCursor ByteString v w -> ByteString
forall t v w. JsonCursor t v w -> t
JSC.cursorText JsonCursor ByteString v w
k