{-# 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
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 forall a. Eq a => a -> a -> Bool
== Text
b
  (==) (LightJsonNumber ByteString
a) (LightJsonNumber ByteString
b) = ByteString
a forall a. Eq a => a -> a -> Bool
== ByteString
b
  (==) (LightJsonBool   Bool
a) (LightJsonBool   Bool
b) = Bool
a forall a. Eq a => a -> a -> Bool
== Bool
b
  (==) (LightJsonObject [(Text, c)]
a) (LightJsonObject [(Text, c)]
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
a forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
b
  (==) (LightJsonArray  [c]
a) (LightJsonArray  [c]
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. LightJsonAt a => a -> LightJson a
lightJsonAt [c]
a forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 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 (forall a. Show a => a -> String
show Text
k) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " forall a. Semigroup a => a -> a -> a
<> 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 (forall a. Show a => a -> String
show Text
s))
    LightJsonNumber ByteString
n   -> Doc -> Doc
cyan       (String -> Doc
text (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
",") ((forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, LightJson c) -> LightJsonField c
toLightJsonField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) 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
",") ((forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) forall a b. (a -> b) -> [a] -> [b]
`map` [c]
vs)
    LightJsonBool Bool
w     -> Doc -> Doc
red (String -> Doc
text (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 " forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) 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) = 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 (forall a. Show a => a -> String
show Text
s))
  pretty (Micro (LightJsonNumber ByteString
n )) = Doc -> Doc
cyan      (String -> Doc
text (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 (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 " forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) 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 (forall a. Show a => a -> String
show String
fieldName)) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (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 (forall a. Show a => a -> String
show Text
fieldName)) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (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 (forall a. Show a => a -> String
show Text
s))
    Mini (LightJsonNumber ByteString
n   ) -> Doc -> Doc
cyan       (String -> Doc
text (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
"{" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
kvs) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..}"
      []                          -> String -> Doc
text String
"{}"
      [(Text, c)]
_                           -> String -> Doc
text String
"{" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) [(Text, c)]
kvs) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"}"
    Mini (LightJsonArray []   ) -> String -> Doc
text String
"[]"
    Mini (LightJsonArray [c]
vs   ) | [c]
vs forall a. AtLeastSize a => a -> Int -> Bool
`atLeastSize` Int
11 -> String -> Doc
text String
"[" forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (forall a. Pretty a => [a] -> Doc
prettyVs ((forall a. a -> Micro a
Micro forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) forall a b. (a -> b) -> [a] -> [b]
`map` forall a. Int -> [a] -> [a]
take Int
10 [c]
vs)) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..]"
    Mini (LightJsonArray [c]
vs   ) | [c]
vs forall a. AtLeastSize a => a -> Int -> Bool
`atLeastSize` Int
1  -> String -> Doc
text String
"[" forall a. Semigroup a => a -> a -> a
<> Int -> Doc -> Doc
nest Int
2 (forall a. Pretty a => [a] -> Doc
prettyVs ((forall a. a -> Micro a
Micro forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) forall a b. (a -> b) -> [a] -> [b]
`map` forall a. Int -> [a] -> [a]
take Int
10 [c]
vs)) 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 (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 " forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Text -> String
T.unpack Text
s) 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 (forall a. Show a => a -> String
show String
fieldName) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (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 (forall a. Show a => a -> String
show Text
fieldName) forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (forall a. a -> Mini a
Mini LightJson c
jpv)

instance LightJsonAt c => Pretty (MQuery (LightJson c)) where
  pretty :: MQuery (LightJson c) -> Doc
pretty = forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> Row a
Row Int
120 forall b c a. (b -> c) -> (a -> b) -> a -> 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) = forall a. Pretty a => a -> Doc
pretty (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 forall v. Uncons v => v -> Maybe (Elem v, v)
uncons ByteString
remainder of
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isLeadingDigit2 Elem ByteString
c -> forall c. ByteString -> LightJson c
LightJsonNumber  (ByteString -> ByteString
slurpNumber ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isQuotDbl Elem ByteString
c       -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall c. Text -> LightJson c
LightJsonError forall c. Text -> LightJson c
LightJsonString (ByteString -> Either Text Text
slurpText ByteString
remainder)
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isChar_t Elem ByteString
c        -> forall c. Bool -> LightJson c
LightJsonBool    Bool
True
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isChar_f Elem ByteString
c        -> forall c. Bool -> LightJson c
LightJsonBool    Bool
False
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isChar_n Elem ByteString
c        -> forall c. LightJson c
LightJsonNull
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isBraceLeft Elem ByteString
c     -> forall c. [(Text, c)] -> LightJson c
LightJsonObject (Maybe (GenericCursor ByteString v w)
-> [(Text, GenericCursor ByteString v w)]
mapValuesFrom   (forall k. TreeCursor k => k -> Maybe k
firstChild GenericCursor ByteString v w
k))
    Just (!Elem ByteString
c, ByteString
_) | forall c. JsonCharLike c => c -> Bool
isBracketLeft Elem ByteString
c   -> forall c. [c] -> LightJson c
LightJsonArray  (Maybe (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
arrayValuesFrom (forall k. TreeCursor k => k -> Maybe k
firstChild GenericCursor ByteString v w
k))
    Just (Elem ByteString, ByteString)
_                           -> forall c. Text -> LightJson c
LightJsonError Text
"Invalid Json Type"
    Maybe (Elem ByteString, ByteString)
Nothing                          -> forall c. Text -> LightJson c
LightJsonError Text
"End of data"
    where ik :: v
ik                = forall t v w. GenericCursor t v w -> v
interests GenericCursor ByteString v w
k
          bpk :: w
bpk               = forall t v w. GenericCursor t v w -> w
balancedParens GenericCursor ByteString v w
k
          p :: Position
p                 = Count -> Position
lastPositionOf (forall v. Select1 v => v -> Count -> Count
select1 v
ik (forall v. Rank1 v => v -> Count -> Count
rank1 w
bpk (forall t v w. GenericCursor t v w -> Count
cursorRank GenericCursor ByteString v w
k)))
          remainder :: ByteString
remainder         = forall v. Drop v => Count -> v -> v
drop (forall a. ToCount a => a -> Count
toCount Position
p) (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   = forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& 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   = forall {b}. [b] -> [(b, b)]
pairwise (Maybe (GenericCursor ByteString v w)
-> [GenericCursor ByteString v w]
arrayValuesFrom Maybe (GenericCursor ByteString v w)
j) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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) forall a. a -> [a] -> [a]
: [b] -> [(b, b)]
pairwise [b]
rs
          pairwise [b]
_        = []
          asField :: (a, b) -> [(Text, b)]
asField (a
a, b
b)    = case 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 forall a. Integral a => a -> a -> a
`mod` Count
2 forall a. Eq a => a -> a -> Bool
== Count
1
    then let i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count
kpa forall a. Num a => a -> a -> a
- Count
1) :: Int in
      if Int
i 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  -> forall c. [c] -> LightJson c
LightJsonArray  []
          Word8
123 -> forall c. [(Text, c)] -> LightJson c
LightJsonObject []
          Word8
_   -> forall c. Text -> LightJson c
LightJsonError Text
"Invalid collection character"
        else forall c. Text -> LightJson c
LightJsonError Text
"Index out of bounds"
    else forall c. Text -> LightJson c
LightJsonError Text
"Unaligned cursor"
    where kpa :: Count
kpa   = forall v. Select1 v => v -> Count -> Count
select1 v
kib Count
kta forall a. Num a => a -> a -> a
+ Count
km
          kib :: v
kib   = forall t v w. JsonCursor t v w -> v
JSC.interests JsonCursor ByteString v w
k
          kra :: Count
kra   = forall t v w. JsonCursor t v w -> Count
JSC.cursorRank JsonCursor ByteString v w
k
          ksa :: Count
ksa   = Count
kra forall a. Num a => a -> a -> a
+ Count
1
          kta :: Count
kta   = Count
ksa forall a. Integral a => a -> a -> a
`div` Count
2
          km :: Count
km    = Count
ksa forall a. Integral a => a -> a -> a
`mod` Count
2
          kt :: ByteString
kt    = forall t v w. JsonCursor t v w -> t
JSC.cursorText JsonCursor ByteString v w
k