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

module HaskellWorks.Data.Json.PartialValue
  ( JsonPartialValue(..)
  , JsonPartialValueAt(..)
  , asInteger
  , asString
  , asText
  , castAsInteger
  , entry
  , hasKey
  , hasKV
  , item
  , jsonKeys
  , jsonSize
  , named
  ) where

import Control.Arrow
import Data.String
import Data.Text                                      (Text)
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Json.Internal.Doc
import HaskellWorks.Data.Json.Internal.Orphans        ()
import HaskellWorks.Data.Json.Internal.PartialIndex
import HaskellWorks.Data.Json.Internal.Value
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.RankSelect.Base.Rank0
import HaskellWorks.Data.RankSelect.Base.Rank1
import HaskellWorks.Data.RankSelect.Base.Select1
import Prelude                                        hiding (drop)
import Text.PrettyPrint.ANSI.Leijen                   hiding ((<$>))

import qualified Data.Attoparsec.ByteString.Char8 as ABC
import qualified Data.ByteString                  as BS
import qualified Data.DList                       as DL
import qualified Data.Text                        as T
import qualified HaskellWorks.Data.BalancedParens as BP

-- | Partial JSON type.
--
-- This data type has an additional 'JsonPartialError' data constructor to indicate parsing
-- errors.  This allows parsing to be more lazy because parsing errors may now be expressed
-- anywhere in the parsed document so the parser no longer needs to make a verdict about whether
-- there are any parsing errors in the entire document.
--
-- See 'jsonPartialJsonValueAt' on how to parse JSON text into this datatype.
--
-- Although this data type allows for lazier parsing it doesn't allow for sub-trees to be
-- garbage collected if a reference to an ancestor node is held.  To avoid holding onto
-- sub-trees that are no longer needed without having to drop references to ancestors use
-- 'HaskellWorks.Data.Json.LightJson.LightJson' instead.
data JsonPartialValue
  = JsonPartialString Text
  | JsonPartialNumber Double
  | JsonPartialObject [(Text, JsonPartialValue)]
  | JsonPartialArray [JsonPartialValue]
  | JsonPartialBool Bool
  | JsonPartialNull
  | JsonPartialError Text
  deriving (JsonPartialValue -> JsonPartialValue -> Bool
(JsonPartialValue -> JsonPartialValue -> Bool)
-> (JsonPartialValue -> JsonPartialValue -> Bool)
-> Eq JsonPartialValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonPartialValue -> JsonPartialValue -> Bool
$c/= :: JsonPartialValue -> JsonPartialValue -> Bool
== :: JsonPartialValue -> JsonPartialValue -> Bool
$c== :: JsonPartialValue -> JsonPartialValue -> Bool
Eq, Int -> JsonPartialValue -> ShowS
[JsonPartialValue] -> ShowS
JsonPartialValue -> String
(Int -> JsonPartialValue -> ShowS)
-> (JsonPartialValue -> String)
-> ([JsonPartialValue] -> ShowS)
-> Show JsonPartialValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonPartialValue] -> ShowS
$cshowList :: [JsonPartialValue] -> ShowS
show :: JsonPartialValue -> String
$cshow :: JsonPartialValue -> String
showsPrec :: Int -> JsonPartialValue -> ShowS
$cshowsPrec :: Int -> JsonPartialValue -> ShowS
Show, Eq JsonPartialValue
Eq JsonPartialValue
-> (JsonPartialValue -> JsonPartialValue -> Ordering)
-> (JsonPartialValue -> JsonPartialValue -> Bool)
-> (JsonPartialValue -> JsonPartialValue -> Bool)
-> (JsonPartialValue -> JsonPartialValue -> Bool)
-> (JsonPartialValue -> JsonPartialValue -> Bool)
-> (JsonPartialValue -> JsonPartialValue -> JsonPartialValue)
-> (JsonPartialValue -> JsonPartialValue -> JsonPartialValue)
-> Ord JsonPartialValue
JsonPartialValue -> JsonPartialValue -> Bool
JsonPartialValue -> JsonPartialValue -> Ordering
JsonPartialValue -> JsonPartialValue -> JsonPartialValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JsonPartialValue -> JsonPartialValue -> JsonPartialValue
$cmin :: JsonPartialValue -> JsonPartialValue -> JsonPartialValue
max :: JsonPartialValue -> JsonPartialValue -> JsonPartialValue
$cmax :: JsonPartialValue -> JsonPartialValue -> JsonPartialValue
>= :: JsonPartialValue -> JsonPartialValue -> Bool
$c>= :: JsonPartialValue -> JsonPartialValue -> Bool
> :: JsonPartialValue -> JsonPartialValue -> Bool
$c> :: JsonPartialValue -> JsonPartialValue -> Bool
<= :: JsonPartialValue -> JsonPartialValue -> Bool
$c<= :: JsonPartialValue -> JsonPartialValue -> Bool
< :: JsonPartialValue -> JsonPartialValue -> Bool
$c< :: JsonPartialValue -> JsonPartialValue -> Bool
compare :: JsonPartialValue -> JsonPartialValue -> Ordering
$ccompare :: JsonPartialValue -> JsonPartialValue -> Ordering
$cp1Ord :: Eq JsonPartialValue
Ord)

class JsonPartialValueAt a where
  -- | Get a JSON partial value from another type
  --
  -- This function can always "succeed" because the data type it returns allows for the document value
  -- to contain an arbitrary number of errors.  This means errors can be reported in document nodes
  -- as parsing occurs lazily.
  --
  -- There are garbage collection implementations you may want to consider.  If you would like to be
  -- able to hold onto ancestor nodes and still be able to garbage collect visited sub-trees, then
  -- consider using 'HaskellWorks.Data.Json.LightJson.lightJsonAt' instead.
  jsonPartialJsonValueAt :: a -> JsonPartialValue

data JsonPartialField = JsonPartialField Text JsonPartialValue

jsonPartialValueString :: JsonPartialValue -> Text
jsonPartialValueString :: JsonPartialValue -> Text
jsonPartialValueString JsonPartialValue
pjv = case JsonPartialValue
pjv of
  JsonPartialString Text
s -> Text
s
  JsonPartialValue
_                   -> Text
""

instance JsonPartialValueAt JsonPartialIndex where
  jsonPartialJsonValueAt :: JsonPartialIndex -> JsonPartialValue
jsonPartialJsonValueAt JsonPartialIndex
i = case JsonPartialIndex
i of
    JsonPartialIndexString ByteString
s  -> case Parser String -> ByteString -> Result String
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser String
forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
s of
      ABC.Fail    {}  -> Text -> JsonPartialValue
JsonPartialError (Text
"Invalid string: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...'")
      ABC.Partial ByteString -> Result String
_   -> Text -> JsonPartialValue
JsonPartialError Text
"Unexpected end of string"
      ABC.Done    ByteString
_ String
r -> Text -> JsonPartialValue
JsonPartialString (String -> Text
T.pack String
r) -- TODO optimise
    JsonPartialIndexNumber ByteString
s  -> case Parser Double -> ByteString -> Result Double
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser Double
forall a. Fractional a => Parser a
ABC.rational ByteString
s of
      ABC.Fail    {}    -> Text -> JsonPartialValue
JsonPartialError (Text
"Invalid number: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...'")
      ABC.Partial ByteString -> Result Double
f     -> case ByteString -> Result Double
f ByteString
" " of
        ABC.Fail    {}  -> Text -> JsonPartialValue
JsonPartialError (Text
"Invalid number: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
s)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...'")
        ABC.Partial ByteString -> Result Double
_   -> Text -> JsonPartialValue
JsonPartialError Text
"Unexpected end of number"
        ABC.Done    ByteString
_ Double
r -> Double -> JsonPartialValue
JsonPartialNumber Double
r
      ABC.Done    ByteString
_ Double
r   -> Double -> JsonPartialValue
JsonPartialNumber Double
r
    JsonPartialIndexObject  [(ByteString, JsonPartialIndex)]
fs -> [(Text, JsonPartialValue)] -> JsonPartialValue
JsonPartialObject (((ByteString, JsonPartialIndex) -> (Text, JsonPartialValue))
-> [(ByteString, JsonPartialIndex)] -> [(Text, JsonPartialValue)]
forall a b. (a -> b) -> [a] -> [b]
map ((JsonPartialValue -> Text
jsonPartialValueString (JsonPartialValue -> Text)
-> (ByteString -> JsonPartialValue) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> JsonPartialValue
parseString) (ByteString -> Text)
-> (JsonPartialIndex -> JsonPartialValue)
-> (ByteString, JsonPartialIndex)
-> (Text, JsonPartialValue)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** JsonPartialIndex -> JsonPartialValue
forall a. JsonPartialValueAt a => a -> JsonPartialValue
jsonPartialJsonValueAt) [(ByteString, JsonPartialIndex)]
fs)
    JsonPartialIndexArray   [JsonPartialIndex]
es -> [JsonPartialValue] -> JsonPartialValue
JsonPartialArray ((JsonPartialIndex -> JsonPartialValue)
-> [JsonPartialIndex] -> [JsonPartialValue]
forall a b. (a -> b) -> [a] -> [b]
map JsonPartialIndex -> JsonPartialValue
forall a. JsonPartialValueAt a => a -> JsonPartialValue
jsonPartialJsonValueAt [JsonPartialIndex]
es)
    JsonPartialIndexBool    Bool
v  -> Bool -> JsonPartialValue
JsonPartialBool Bool
v
    JsonPartialIndex
JsonPartialIndexNull       -> JsonPartialValue
JsonPartialNull
    JsonPartialIndexError String
s    -> Text -> JsonPartialValue
JsonPartialError (String -> Text
T.pack String
s) -- TODO optimise
    where parseString :: ByteString -> JsonPartialValue
parseString ByteString
bs = case Parser String -> ByteString -> Result String
forall a. Parser a -> ByteString -> Result a
ABC.parse Parser String
forall t u. (Parser t u, IsString t) => Parser t String
parseJsonString ByteString
bs of
            ABC.Fail    {}  -> Text -> JsonPartialValue
JsonPartialError (Text
"Invalid field: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ByteString -> String
forall a. Show a => a -> String
show (Int -> ByteString -> ByteString
BS.take Int
20 ByteString
bs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...'")
            ABC.Partial ByteString -> Result String
_   -> Text -> JsonPartialValue
JsonPartialError Text
"Unexpected end of field"
            ABC.Done    ByteString
_ String
s -> Text -> JsonPartialValue
JsonPartialString (String -> Text
T.pack String
s) -- TODO optimise

toJsonPartialField :: (Text, JsonPartialValue) -> JsonPartialField
toJsonPartialField :: (Text, JsonPartialValue) -> JsonPartialField
toJsonPartialField (Text
k, JsonPartialValue
v) = Text -> JsonPartialValue -> JsonPartialField
JsonPartialField Text
k JsonPartialValue
v

instance Pretty JsonPartialField where
  pretty :: JsonPartialField -> Doc
pretty (JsonPartialField Text
k JsonPartialValue
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
<> JsonPartialValue -> Doc
forall a. Pretty a => a -> Doc
pretty JsonPartialValue
v

instance Pretty JsonPartialValue where
  pretty :: JsonPartialValue -> Doc
pretty JsonPartialValue
mjpv = case JsonPartialValue
mjpv of
    JsonPartialString Text
s   -> Doc -> Doc
dullgreen  (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
    JsonPartialNumber Double
n   -> Doc -> Doc
cyan       (String -> Doc
text (Double -> String
forall a. Show a => a -> String
show Double
n))
    JsonPartialObject []  -> String -> Doc
text String
"{}"
    JsonPartialObject [(Text, JsonPartialValue)]
kvs -> Doc -> Doc -> Doc -> [Doc] -> Doc
hEncloseSep (String -> Doc
text String
"{") (String -> Doc
text String
"}") (String -> Doc
text String
",") ((JsonPartialField -> Doc
forall a. Pretty a => a -> Doc
pretty (JsonPartialField -> Doc)
-> ((Text, JsonPartialValue) -> JsonPartialField)
-> (Text, JsonPartialValue)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, JsonPartialValue) -> JsonPartialField
toJsonPartialField) ((Text, JsonPartialValue) -> Doc)
-> [(Text, JsonPartialValue)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, JsonPartialValue)]
kvs)
    JsonPartialArray [JsonPartialValue]
vs   -> Doc -> Doc -> Doc -> [Doc] -> Doc
hEncloseSep (String -> Doc
text String
"[") (String -> Doc
text String
"]") (String -> Doc
text String
",") (JsonPartialValue -> Doc
forall a. Pretty a => a -> Doc
pretty (JsonPartialValue -> Doc) -> [JsonPartialValue] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
`map` [JsonPartialValue]
vs)
    JsonPartialBool Bool
w     -> Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
    JsonPartialValue
JsonPartialNull       -> String -> Doc
text String
"null"
    JsonPartialError 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 JsonPartialValue) where
  pretty :: Micro JsonPartialValue -> Doc
pretty (Micro (JsonPartialString Text
s )) = Doc -> Doc
dullgreen (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
  pretty (Micro (JsonPartialNumber Double
n )) = Doc -> Doc
cyan      (String -> Doc
text (Double -> String
forall a. Show a => a -> String
show Double
n))
  pretty (Micro (JsonPartialObject [])) = String -> Doc
text String
"{}"
  pretty (Micro (JsonPartialObject [(Text, JsonPartialValue)]
_ )) = String -> Doc
text String
"{..}"
  pretty (Micro (JsonPartialArray [] )) = String -> Doc
text String
"[]"
  pretty (Micro (JsonPartialArray [JsonPartialValue]
_  )) = String -> Doc
text String
"[..]"
  pretty (Micro (JsonPartialBool Bool
w   )) = Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
  pretty (Micro  JsonPartialValue
JsonPartialNull      ) = String -> Doc
text String
"null"
  pretty (Micro (JsonPartialError 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, JsonPartialValue)) where
  pretty :: Micro (String, JsonPartialValue) -> Doc
pretty (Micro (String
fieldName, JsonPartialValue
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 JsonPartialValue -> Doc
forall a. Pretty a => a -> Doc
pretty (JsonPartialValue -> Micro JsonPartialValue
forall a. a -> Micro a
Micro JsonPartialValue
jpv)

instance Pretty (Micro (Text, JsonPartialValue)) where
  pretty :: Micro (Text, JsonPartialValue) -> Doc
pretty (Micro (Text
fieldName, JsonPartialValue
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 JsonPartialValue -> Doc
forall a. Pretty a => a -> Doc
pretty (JsonPartialValue -> Micro JsonPartialValue
forall a. a -> Micro a
Micro JsonPartialValue
jpv)

instance Pretty (Mini JsonPartialValue) where
  pretty :: Mini JsonPartialValue -> Doc
pretty Mini JsonPartialValue
mjpv = case Mini JsonPartialValue
mjpv of
    Mini (JsonPartialString Text
s   ) -> Doc -> Doc
dullgreen  (String -> Doc
text (Text -> String
forall a. Show a => a -> String
show Text
s))
    Mini (JsonPartialNumber Double
n   ) -> Doc -> Doc
cyan       (String -> Doc
text (Double -> String
forall a. Show a => a -> String
show Double
n))
    Mini (JsonPartialObject []  ) -> String -> Doc
text String
"{}"
    Mini (JsonPartialObject [(Text, JsonPartialValue)]
kvs ) -> case [(Text, JsonPartialValue)]
kvs of
      ((Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:(Text, JsonPartialValue)
_:[(Text, JsonPartialValue)]
_) -> String -> Doc
text String
"{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [(Text, JsonPartialValue)] -> Doc
forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs [(Text, JsonPartialValue)]
kvs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..}"
      []                          -> String -> Doc
text String
"{}"
      [(Text, JsonPartialValue)]
_                           -> String -> Doc
text String
"{" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [(Text, JsonPartialValue)] -> Doc
forall a. Pretty (Micro a) => [a] -> Doc
prettyKvs [(Text, JsonPartialValue)]
kvs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"}"
    Mini (JsonPartialArray []   ) -> String -> Doc
text String
"[]"
    Mini (JsonPartialArray [JsonPartialValue]
vs   ) | [JsonPartialValue]
vs [JsonPartialValue] -> 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 JsonPartialValue] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs (JsonPartialValue -> Micro JsonPartialValue
forall a. a -> Micro a
Micro (JsonPartialValue -> Micro JsonPartialValue)
-> [JsonPartialValue] -> [Micro JsonPartialValue]
forall a b. (a -> b) -> [a] -> [b]
`map` Int -> [JsonPartialValue] -> [JsonPartialValue]
forall a. Int -> [a] -> [a]
take Int
10 [JsonPartialValue]
vs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
", ..]"
    Mini (JsonPartialArray [JsonPartialValue]
vs   ) | [JsonPartialValue]
vs [JsonPartialValue] -> 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 JsonPartialValue] -> Doc
forall a. Pretty a => [a] -> Doc
prettyVs (JsonPartialValue -> Micro JsonPartialValue
forall a. a -> Micro a
Micro (JsonPartialValue -> Micro JsonPartialValue)
-> [JsonPartialValue] -> [Micro JsonPartialValue]
forall a b. (a -> b) -> [a] -> [b]
`map` Int -> [JsonPartialValue] -> [JsonPartialValue]
forall a. Int -> [a] -> [a]
take Int
10 [JsonPartialValue]
vs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
    Mini (JsonPartialArray [JsonPartialValue]
_    )                       -> String -> Doc
text String
"[]"
    Mini (JsonPartialBool Bool
w     ) -> Doc -> Doc
red (String -> Doc
text (Bool -> String
forall a. Show a => a -> String
show Bool
w))
    Mini  JsonPartialValue
JsonPartialNull         -> String -> Doc
text String
"null"
    Mini (JsonPartialError 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 (Mini (Text, JsonPartialValue)) where
  pretty :: Mini (Text, JsonPartialValue) -> Doc
pretty (Mini (Text
fieldName, JsonPartialValue
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 JsonPartialValue -> Doc
forall a. Pretty a => a -> Doc
pretty (JsonPartialValue -> Mini JsonPartialValue
forall a. a -> Mini a
Mini JsonPartialValue
jpv)

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

instance Pretty (MQuery (Entry Text JsonPartialValue)) where
  pretty :: MQuery (Entry Text JsonPartialValue) -> Doc
pretty (MQuery DList (Entry Text JsonPartialValue)
das) = Row (DList (Entry Text JsonPartialValue)) -> Doc
forall a. Pretty a => a -> Doc
pretty (Int
-> DList (Entry Text JsonPartialValue)
-> Row (DList (Entry Text JsonPartialValue))
forall a. Int -> a -> Row a
Row Int
120 DList (Entry Text JsonPartialValue)
das)

instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (GenericCursor BS.ByteString v w) where
  jsonPartialJsonValueAt :: GenericCursor ByteString v w -> JsonPartialValue
jsonPartialJsonValueAt = JsonPartialIndex -> JsonPartialValue
forall a. JsonPartialValueAt a => a -> JsonPartialValue
jsonPartialJsonValueAt (JsonPartialIndex -> JsonPartialValue)
-> (GenericCursor ByteString v w -> JsonPartialIndex)
-> GenericCursor ByteString v w
-> JsonPartialValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericCursor ByteString v w -> JsonPartialIndex
forall a. JsonPartialIndexAt a => a -> JsonPartialIndex
jsonPartialIndexAt

hasKV :: Text -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue
hasKV :: Text
-> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue
hasKV Text
k JsonPartialValue
v (JsonPartialObject [(Text, JsonPartialValue)]
xs) = if (Text
k, JsonPartialValue
v) (Text, JsonPartialValue) -> [(Text, JsonPartialValue)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Text, JsonPartialValue)]
xs then DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (JsonPartialValue -> DList JsonPartialValue
forall a. a -> DList a
DL.singleton ([(Text, JsonPartialValue)] -> JsonPartialValue
JsonPartialObject [(Text, JsonPartialValue)]
xs)) else DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery DList JsonPartialValue
forall a. DList a
DL.empty
hasKV Text
_ JsonPartialValue
_  JsonPartialValue
_                     = DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery DList JsonPartialValue
forall a. DList a
DL.empty

item :: JsonPartialValue -> MQuery JsonPartialValue
item :: JsonPartialValue -> MQuery JsonPartialValue
item JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialArray [JsonPartialValue]
es -> DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (DList JsonPartialValue -> MQuery JsonPartialValue)
-> DList JsonPartialValue -> MQuery JsonPartialValue
forall a b. (a -> b) -> a -> b
$ [JsonPartialValue] -> DList JsonPartialValue
forall a. [a] -> DList a
DL.fromList [JsonPartialValue]
es
  JsonPartialValue
_                   -> DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery   DList JsonPartialValue
forall a. DList a
DL.empty

entry :: JsonPartialValue -> MQuery (Entry Text JsonPartialValue)
entry :: JsonPartialValue -> MQuery (Entry Text JsonPartialValue)
entry JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialObject [(Text, JsonPartialValue)]
fs -> DList (Entry Text JsonPartialValue)
-> MQuery (Entry Text JsonPartialValue)
forall a. DList a -> MQuery a
MQuery (DList (Entry Text JsonPartialValue)
 -> MQuery (Entry Text JsonPartialValue))
-> DList (Entry Text JsonPartialValue)
-> MQuery (Entry Text JsonPartialValue)
forall a b. (a -> b) -> a -> b
$ [Entry Text JsonPartialValue]
-> DList (Entry Text JsonPartialValue)
forall a. [a] -> DList a
DL.fromList ((Text -> JsonPartialValue -> Entry Text JsonPartialValue)
-> (Text, JsonPartialValue) -> Entry Text JsonPartialValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> JsonPartialValue -> Entry Text JsonPartialValue
forall k v. k -> v -> Entry k v
Entry ((Text, JsonPartialValue) -> Entry Text JsonPartialValue)
-> [(Text, JsonPartialValue)] -> [Entry Text JsonPartialValue]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, JsonPartialValue)]
fs)
  JsonPartialValue
_                    -> DList (Entry Text JsonPartialValue)
-> MQuery (Entry Text JsonPartialValue)
forall a. DList a -> MQuery a
MQuery   DList (Entry Text JsonPartialValue)
forall a. DList a
DL.empty

asString :: JsonPartialValue -> MQuery String
asString :: JsonPartialValue -> MQuery String
asString JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialString Text
s -> DList String -> MQuery String
forall a. DList a -> MQuery a
MQuery (DList String -> MQuery String) -> DList String -> MQuery String
forall a b. (a -> b) -> a -> b
$ String -> DList String
forall a. a -> DList a
DL.singleton (Text -> String
T.unpack Text
s)
  JsonPartialValue
_                   -> DList String -> MQuery String
forall a. DList a -> MQuery a
MQuery   DList String
forall a. DList a
DL.empty

asText :: JsonPartialValue -> MQuery Text
asText :: JsonPartialValue -> MQuery Text
asText JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialString Text
s -> DList Text -> MQuery Text
forall a. DList a -> MQuery a
MQuery (DList Text -> MQuery Text) -> DList Text -> MQuery Text
forall a b. (a -> b) -> a -> b
$ Text -> DList Text
forall a. a -> DList a
DL.singleton Text
s
  JsonPartialValue
_                   -> DList Text -> MQuery Text
forall a. DList a -> MQuery a
MQuery   DList Text
forall a. DList a
DL.empty

asInteger :: JsonPartialValue -> MQuery Integer
asInteger :: JsonPartialValue -> MQuery Integer
asInteger JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialNumber Double
n -> DList Integer -> MQuery Integer
forall a. DList a -> MQuery a
MQuery (DList Integer -> MQuery Integer)
-> DList Integer -> MQuery Integer
forall a b. (a -> b) -> a -> b
$ Integer -> DList Integer
forall a. a -> DList a
DL.singleton (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
n)
  JsonPartialValue
_                   -> DList Integer -> MQuery Integer
forall a. DList a -> MQuery a
MQuery   DList Integer
forall a. DList a
DL.empty

castAsInteger :: JsonPartialValue -> MQuery Integer
castAsInteger :: JsonPartialValue -> MQuery Integer
castAsInteger JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialString Text
n -> DList Integer -> MQuery Integer
forall a. DList a -> MQuery a
MQuery (DList Integer -> MQuery Integer)
-> DList Integer -> MQuery Integer
forall a b. (a -> b) -> a -> b
$ Integer -> DList Integer
forall a. a -> DList a
DL.singleton (String -> Integer
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
n))
  JsonPartialNumber Double
n -> DList Integer -> MQuery Integer
forall a. DList a -> MQuery a
MQuery (DList Integer -> MQuery Integer)
-> DList Integer -> MQuery Integer
forall a b. (a -> b) -> a -> b
$ Integer -> DList Integer
forall a. a -> DList a
DL.singleton (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
n)
  JsonPartialValue
_                   -> DList Integer -> MQuery Integer
forall a. DList a -> MQuery a
MQuery   DList Integer
forall a. DList a
DL.empty

named :: Text -> Entry Text JsonPartialValue -> MQuery JsonPartialValue
named :: Text -> Entry Text JsonPartialValue -> MQuery JsonPartialValue
named Text
fieldName (Entry Text
fieldName' JsonPartialValue
jpv) | Text
fieldName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldName'  = DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (DList JsonPartialValue -> MQuery JsonPartialValue)
-> DList JsonPartialValue -> MQuery JsonPartialValue
forall a b. (a -> b) -> a -> b
$ JsonPartialValue -> DList JsonPartialValue
forall a. a -> DList a
DL.singleton JsonPartialValue
jpv
named Text
_         Entry Text JsonPartialValue
_                      = DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery   DList JsonPartialValue
forall a. DList a
DL.empty

jsonKeys :: JsonPartialValue -> [Text]
jsonKeys :: JsonPartialValue -> [Text]
jsonKeys JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialObject [(Text, JsonPartialValue)]
fs -> (Text, JsonPartialValue) -> Text
forall a b. (a, b) -> a
fst ((Text, JsonPartialValue) -> Text)
-> [(Text, JsonPartialValue)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, JsonPartialValue)]
fs
  JsonPartialValue
_                    -> []

hasKey :: Text -> JsonPartialValue -> Bool
hasKey :: Text -> JsonPartialValue -> Bool
hasKey Text
fieldName JsonPartialValue
jpv = Text
fieldName Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` JsonPartialValue -> [Text]
jsonKeys JsonPartialValue
jpv

jsonSize :: JsonPartialValue -> MQuery JsonPartialValue
jsonSize :: JsonPartialValue -> MQuery JsonPartialValue
jsonSize JsonPartialValue
jpv = case JsonPartialValue
jpv of
  JsonPartialArray  [JsonPartialValue]
es -> DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (JsonPartialValue -> DList JsonPartialValue
forall a. a -> DList a
DL.singleton (Double -> JsonPartialValue
JsonPartialNumber (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([JsonPartialValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JsonPartialValue]
es))))
  JsonPartialObject [(Text, JsonPartialValue)]
es -> DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (JsonPartialValue -> DList JsonPartialValue
forall a. a -> DList a
DL.singleton (Double -> JsonPartialValue
JsonPartialNumber (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Text, JsonPartialValue)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, JsonPartialValue)]
es))))
  JsonPartialValue
_                    -> DList JsonPartialValue -> MQuery JsonPartialValue
forall a. DList a -> MQuery a
MQuery (JsonPartialValue -> DList JsonPartialValue
forall a. a -> DList a
DL.singleton (Double -> JsonPartialValue
JsonPartialNumber Double
0))