{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Core.Encoding.Json
(
encodeToUTF8,
decodeFromUTF8,
JsonValue (..),
JsonKey (..),
JsonToken (..),
colourizeJson,
prettyKey,
prettyValue,
)
where
import Core.Data.Structures (Key, Map, fromMap, intoMap)
import Core.Text.Bytes (Bytes, fromBytes, intoBytes)
import Core.Text.Rope (Rope, Textual, fromRope, intoRope)
import Core.Text.Utilities
( brightBlue,
brightGrey,
brightMagenta,
dullBlue,
dullCyan,
dullGreen,
dullYellow,
AnsiColour,
Render(Token, highlight, colourize) )
import qualified Data.Aeson as Aeson
import Data.Coerce
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable (Hashable)
import Data.Scientific (Scientific)
import Data.String (IsString (..))
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
( Doc,
Pretty (..),
annotate,
comma,
dquote,
group,
hcat,
indent,
lbrace,
lbracket,
line,
line',
nest,
punctuate,
rbrace,
rbracket,
sep,
unAnnotate,
viaShow,
vsep,
(<+>),
)
import qualified Data.Vector as V
import GHC.Generics
encodeToUTF8 :: JsonValue -> Bytes
encodeToUTF8 :: JsonValue -> Bytes
encodeToUTF8 = ByteString -> Bytes
forall α. Binary α => α -> Bytes
intoBytes (ByteString -> Bytes)
-> (JsonValue -> ByteString) -> JsonValue -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString)
-> (JsonValue -> Value) -> JsonValue -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonValue -> Value
intoAeson
decodeFromUTF8 :: Bytes -> Maybe JsonValue
decodeFromUTF8 :: Bytes -> Maybe JsonValue
decodeFromUTF8 Bytes
b =
let x :: Maybe Aeson.Value
x :: Maybe Value
x = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decodeStrict' (Bytes -> ByteString
forall α. Binary α => Bytes -> α
fromBytes Bytes
b)
in (Value -> JsonValue) -> Maybe Value -> Maybe JsonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> JsonValue
fromAeson Maybe Value
x
data JsonValue
= JsonObject (Map JsonKey JsonValue)
| JsonArray [JsonValue]
| JsonString Rope
| JsonNumber Scientific
| JsonBool Bool
| JsonNull
deriving (JsonValue -> JsonValue -> Bool
(JsonValue -> JsonValue -> Bool)
-> (JsonValue -> JsonValue -> Bool) -> Eq JsonValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonValue -> JsonValue -> Bool
$c/= :: JsonValue -> JsonValue -> Bool
== :: JsonValue -> JsonValue -> Bool
$c== :: JsonValue -> JsonValue -> Bool
Eq, Int -> JsonValue -> ShowS
[JsonValue] -> ShowS
JsonValue -> String
(Int -> JsonValue -> ShowS)
-> (JsonValue -> String)
-> ([JsonValue] -> ShowS)
-> Show JsonValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonValue] -> ShowS
$cshowList :: [JsonValue] -> ShowS
show :: JsonValue -> String
$cshow :: JsonValue -> String
showsPrec :: Int -> JsonValue -> ShowS
$cshowsPrec :: Int -> JsonValue -> ShowS
Show, (forall x. JsonValue -> Rep JsonValue x)
-> (forall x. Rep JsonValue x -> JsonValue) -> Generic JsonValue
forall x. Rep JsonValue x -> JsonValue
forall x. JsonValue -> Rep JsonValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonValue x -> JsonValue
$cfrom :: forall x. JsonValue -> Rep JsonValue x
Generic)
instance IsString JsonValue where
fromString :: String -> JsonValue
fromString :: String -> JsonValue
fromString = Rope -> JsonValue
JsonString (Rope -> JsonValue) -> (String -> Rope) -> String -> JsonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rope
forall α. Textual α => α -> Rope
intoRope
instance Num JsonValue where
fromInteger :: Integer -> JsonValue
fromInteger = Scientific -> JsonValue
JsonNumber (Scientific -> JsonValue)
-> (Integer -> Scientific) -> Integer -> JsonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger
+ :: JsonValue -> JsonValue -> JsonValue
(+) = String -> JsonValue -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, you can't add JsonValues"
(-) = String -> JsonValue -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, you can't negate JsonValues"
* :: JsonValue -> JsonValue -> JsonValue
(*) = String -> JsonValue -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, you can't multiply JsonValues"
abs :: JsonValue -> JsonValue
abs = String -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, not applicable for JsonValues"
signum :: JsonValue -> JsonValue
signum = String -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, not applicable for JsonValues"
instance Fractional JsonValue where
fromRational :: Rational -> JsonValue
fromRational :: Rational -> JsonValue
fromRational = Scientific -> JsonValue
JsonNumber (Scientific -> JsonValue)
-> (Rational -> Scientific) -> Rational -> JsonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational
/ :: JsonValue -> JsonValue -> JsonValue
(/) = String -> JsonValue -> JsonValue -> JsonValue
forall a. HasCallStack => String -> a
error String
"Sorry, you can't do division on JsonValues"
intoAeson :: JsonValue -> Aeson.Value
intoAeson :: JsonValue -> Value
intoAeson JsonValue
value = case JsonValue
value of
JsonObject Map JsonKey JsonValue
xm ->
let kvs :: [(JsonKey, JsonValue)]
kvs = Map (K [(JsonKey, JsonValue)]) (V [(JsonKey, JsonValue)])
-> [(JsonKey, JsonValue)]
forall α. Dictionary α => Map (K α) (V α) -> α
fromMap Map (K [(JsonKey, JsonValue)]) (V [(JsonKey, JsonValue)])
Map JsonKey JsonValue
xm
tvs :: [(Text, Value)]
tvs = ((JsonKey, JsonValue) -> (Text, Value))
-> [(JsonKey, JsonValue)] -> [(Text, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(JsonKey
k, JsonValue
v) -> (Rope -> Text
forall α. Textual α => Rope -> α
fromRope (JsonKey -> Rope
coerce JsonKey
k), JsonValue -> Value
intoAeson JsonValue
v)) [(JsonKey, JsonValue)]
kvs
tvm :: HashMap T.Text Aeson.Value
tvm :: HashMap Text Value
tvm = [(Text, Value)] -> HashMap Text Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, Value)]
tvs
in HashMap Text Value -> Value
Aeson.Object HashMap Text Value
tvm
JsonArray [JsonValue]
xs ->
let vs :: [Value]
vs = (JsonValue -> Value) -> [JsonValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonValue -> Value
intoAeson [JsonValue]
xs
in Array -> Value
Aeson.Array ([Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
vs)
JsonString Rope
x -> Text -> Value
Aeson.String (Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
x)
JsonNumber Scientific
x -> Scientific -> Value
Aeson.Number Scientific
x
JsonBool Bool
x -> Bool -> Value
Aeson.Bool Bool
x
JsonValue
JsonNull -> Value
Aeson.Null
newtype JsonKey
= JsonKey Rope
deriving (JsonKey -> JsonKey -> Bool
(JsonKey -> JsonKey -> Bool)
-> (JsonKey -> JsonKey -> Bool) -> Eq JsonKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonKey -> JsonKey -> Bool
$c/= :: JsonKey -> JsonKey -> Bool
== :: JsonKey -> JsonKey -> Bool
$c== :: JsonKey -> JsonKey -> Bool
Eq, Int -> JsonKey -> ShowS
[JsonKey] -> ShowS
JsonKey -> String
(Int -> JsonKey -> ShowS)
-> (JsonKey -> String) -> ([JsonKey] -> ShowS) -> Show JsonKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonKey] -> ShowS
$cshowList :: [JsonKey] -> ShowS
show :: JsonKey -> String
$cshow :: JsonKey -> String
showsPrec :: Int -> JsonKey -> ShowS
$cshowsPrec :: Int -> JsonKey -> ShowS
Show, (forall x. JsonKey -> Rep JsonKey x)
-> (forall x. Rep JsonKey x -> JsonKey) -> Generic JsonKey
forall x. Rep JsonKey x -> JsonKey
forall x. JsonKey -> Rep JsonKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonKey x -> JsonKey
$cfrom :: forall x. JsonKey -> Rep JsonKey x
Generic, String -> JsonKey
(String -> JsonKey) -> IsString JsonKey
forall a. (String -> a) -> IsString a
fromString :: String -> JsonKey
$cfromString :: String -> JsonKey
IsString, Eq JsonKey
Eq JsonKey
-> (JsonKey -> JsonKey -> Ordering)
-> (JsonKey -> JsonKey -> Bool)
-> (JsonKey -> JsonKey -> Bool)
-> (JsonKey -> JsonKey -> Bool)
-> (JsonKey -> JsonKey -> Bool)
-> (JsonKey -> JsonKey -> JsonKey)
-> (JsonKey -> JsonKey -> JsonKey)
-> Ord JsonKey
JsonKey -> JsonKey -> Bool
JsonKey -> JsonKey -> Ordering
JsonKey -> JsonKey -> JsonKey
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 :: JsonKey -> JsonKey -> JsonKey
$cmin :: JsonKey -> JsonKey -> JsonKey
max :: JsonKey -> JsonKey -> JsonKey
$cmax :: JsonKey -> JsonKey -> JsonKey
>= :: JsonKey -> JsonKey -> Bool
$c>= :: JsonKey -> JsonKey -> Bool
> :: JsonKey -> JsonKey -> Bool
$c> :: JsonKey -> JsonKey -> Bool
<= :: JsonKey -> JsonKey -> Bool
$c<= :: JsonKey -> JsonKey -> Bool
< :: JsonKey -> JsonKey -> Bool
$c< :: JsonKey -> JsonKey -> Bool
compare :: JsonKey -> JsonKey -> Ordering
$ccompare :: JsonKey -> JsonKey -> Ordering
$cp1Ord :: Eq JsonKey
Ord)
instance Hashable JsonKey
instance Key JsonKey
instance Aeson.ToJSON Rope where
toJSON :: Rope -> Value
toJSON Rope
text = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
text :: T.Text)
instance Textual JsonKey where
fromRope :: Rope -> JsonKey
fromRope Rope
t = Rope -> JsonKey
coerce Rope
t
intoRope :: JsonKey -> Rope
intoRope JsonKey
x = JsonKey -> Rope
coerce JsonKey
x
fromAeson :: Aeson.Value -> JsonValue
fromAeson :: Value -> JsonValue
fromAeson Value
value = case Value
value of
Aeson.Object HashMap Text Value
o ->
let tvs :: [(Text, Value)]
tvs = HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
o
kvs :: [(JsonKey, JsonValue)]
kvs = ((Text, Value) -> (JsonKey, JsonValue))
-> [(Text, Value)] -> [(JsonKey, JsonValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
k, Value
v) -> (Rope -> JsonKey
JsonKey (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
k), Value -> JsonValue
fromAeson Value
v)) [(Text, Value)]
tvs
kvm :: Map JsonKey JsonValue
kvm :: Map JsonKey JsonValue
kvm = [(JsonKey, JsonValue)]
-> Map (K [(JsonKey, JsonValue)]) (V [(JsonKey, JsonValue)])
forall α. Dictionary α => α -> Map (K α) (V α)
intoMap [(JsonKey, JsonValue)]
kvs
in Map JsonKey JsonValue -> JsonValue
JsonObject Map JsonKey JsonValue
kvm
Aeson.Array Array
v -> [JsonValue] -> JsonValue
JsonArray ((Value -> JsonValue) -> [Value] -> [JsonValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> JsonValue
fromAeson (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v))
Aeson.String Text
t -> Rope -> JsonValue
JsonString (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
t)
Aeson.Number Scientific
n -> Scientific -> JsonValue
JsonNumber Scientific
n
Aeson.Bool Bool
x -> Bool -> JsonValue
JsonBool Bool
x
Value
Aeson.Null -> JsonValue
JsonNull
data JsonToken
= SymbolToken
| QuoteToken
| KeyToken
| StringToken
| EscapeToken
| NumberToken
| BooleanToken
| LiteralToken
instance Render JsonValue where
type Token JsonValue = JsonToken
colourize :: Token JsonValue -> AnsiColour
colourize = Token JsonValue -> AnsiColour
JsonToken -> AnsiColour
colourizeJson
highlight :: JsonValue -> Doc (Token JsonValue)
highlight = JsonValue -> Doc (Token JsonValue)
JsonValue -> Doc JsonToken
prettyValue
instance Render JsonKey where
type Token JsonKey = JsonToken
colourize :: Token JsonKey -> AnsiColour
colourize = Token JsonKey -> AnsiColour
JsonToken -> AnsiColour
colourizeJson
highlight :: JsonKey -> Doc (Token JsonKey)
highlight = JsonKey -> Doc (Token JsonKey)
JsonKey -> Doc JsonToken
prettyKey
instance Render Aeson.Value where
type Token Aeson.Value = JsonToken
colourize :: Token Value -> AnsiColour
colourize = Token Value -> AnsiColour
JsonToken -> AnsiColour
colourizeJson
highlight :: Value -> Doc (Token Value)
highlight = JsonValue -> Doc JsonToken
prettyValue (JsonValue -> Doc JsonToken)
-> (Value -> JsonValue) -> Value -> Doc JsonToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> JsonValue
fromAeson
colourizeJson :: JsonToken -> AnsiColour
colourizeJson :: JsonToken -> AnsiColour
colourizeJson JsonToken
token = case JsonToken
token of
JsonToken
SymbolToken -> AnsiColour
brightGrey
JsonToken
QuoteToken -> AnsiColour
brightGrey
JsonToken
KeyToken -> AnsiColour
brightBlue
JsonToken
StringToken -> AnsiColour
dullCyan
JsonToken
EscapeToken -> AnsiColour
dullYellow
JsonToken
NumberToken -> AnsiColour
dullGreen
JsonToken
BooleanToken -> AnsiColour
brightMagenta
JsonToken
LiteralToken -> AnsiColour
dullBlue
instance Pretty JsonKey where
pretty :: JsonKey -> Doc ann
pretty = Doc JsonToken -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
unAnnotate (Doc JsonToken -> Doc ann)
-> (JsonKey -> Doc JsonToken) -> JsonKey -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonKey -> Doc JsonToken
prettyKey
prettyKey :: JsonKey -> Doc JsonToken
prettyKey :: JsonKey -> Doc JsonToken
prettyKey (JsonKey Rope
t) =
JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
QuoteToken Doc JsonToken
forall ann. Doc ann
dquote
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
KeyToken (Text -> Doc JsonToken
forall a ann. Pretty a => a -> Doc ann
pretty (Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
t :: T.Text))
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
QuoteToken Doc JsonToken
forall ann. Doc ann
dquote
instance Pretty JsonValue where
pretty :: JsonValue -> Doc ann
pretty = Doc JsonToken -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
unAnnotate (Doc JsonToken -> Doc ann)
-> (JsonValue -> Doc JsonToken) -> JsonValue -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonValue -> Doc JsonToken
prettyValue
prettyValue :: JsonValue -> Doc JsonToken
prettyValue :: JsonValue -> Doc JsonToken
prettyValue JsonValue
value = case JsonValue
value of
JsonObject Map JsonKey JsonValue
xm ->
let pairs :: [(JsonKey, JsonValue)]
pairs = Map (K [(JsonKey, JsonValue)]) (V [(JsonKey, JsonValue)])
-> [(JsonKey, JsonValue)]
forall α. Dictionary α => Map (K α) (V α) -> α
fromMap Map (K [(JsonKey, JsonValue)]) (V [(JsonKey, JsonValue)])
Map JsonKey JsonValue
xm
entries :: [Doc JsonToken]
entries = ((JsonKey, JsonValue) -> Doc JsonToken)
-> [(JsonKey, JsonValue)] -> [Doc JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(JsonKey
k, JsonValue
v) -> (JsonKey -> Doc JsonToken
prettyKey JsonKey
k) Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
":" Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. Doc ann -> Doc ann -> Doc ann
<+> JsonValue -> Doc JsonToken -> Doc JsonToken
forall ann. JsonValue -> Doc ann -> Doc ann
clear JsonValue
v (JsonValue -> Doc JsonToken
prettyValue JsonValue
v)) [(JsonKey, JsonValue)]
pairs
clear :: JsonValue -> Doc ann -> Doc ann
clear JsonValue
v Doc ann
doc = case JsonValue
v of
(JsonObject Map JsonKey JsonValue
_) -> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc
(JsonArray [JsonValue]
_) -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group Doc ann
doc
JsonValue
_ -> Doc ann
doc
in if [Doc JsonToken] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc JsonToken]
entries Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken (Doc JsonToken
forall ann. Doc ann
lbrace Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Doc JsonToken
forall ann. Doc ann
rbrace)
else JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
lbrace Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Doc JsonToken
forall ann. Doc ann
line Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Int -> Doc JsonToken -> Doc JsonToken
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 ([Doc JsonToken] -> Doc JsonToken
forall ann. [Doc ann] -> Doc ann
vsep (Doc JsonToken -> [Doc JsonToken] -> [Doc JsonToken]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
comma) [Doc JsonToken]
entries)) Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Doc JsonToken
forall ann. Doc ann
line Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
rbrace
JsonArray [JsonValue]
xs ->
let entries :: [Doc JsonToken]
entries = (JsonValue -> Doc JsonToken) -> [JsonValue] -> [Doc JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonValue -> Doc JsonToken
prettyValue [JsonValue]
xs
in Doc JsonToken
forall ann. Doc ann
line'
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Int -> Doc JsonToken -> Doc JsonToken
forall ann. Int -> Doc ann -> Doc ann
nest
Int
4
( JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
lbracket
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Doc JsonToken
forall ann. Doc ann
line'
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> [Doc JsonToken] -> Doc JsonToken
forall ann. [Doc ann] -> Doc ann
sep (Doc JsonToken -> [Doc JsonToken] -> [Doc JsonToken]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
comma) [Doc JsonToken]
entries)
)
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> Doc JsonToken
forall ann. Doc ann
line'
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
SymbolToken Doc JsonToken
forall ann. Doc ann
rbracket
JsonString Rope
x ->
JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
QuoteToken Doc JsonToken
forall ann. Doc ann
dquote
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
StringToken (Rope -> Doc JsonToken
escapeText Rope
x)
Doc JsonToken -> Doc JsonToken -> Doc JsonToken
forall a. Semigroup a => a -> a -> a
<> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
QuoteToken Doc JsonToken
forall ann. Doc ann
dquote
JsonNumber Scientific
x -> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
NumberToken (Scientific -> Doc JsonToken
forall a ann. Show a => a -> Doc ann
viaShow Scientific
x)
JsonBool Bool
x -> case Bool
x of
Bool
True -> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
BooleanToken Doc JsonToken
"true"
Bool
False -> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
BooleanToken Doc JsonToken
"false"
JsonValue
JsonNull -> JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
LiteralToken Doc JsonToken
"null"
{-# INLINEABLE prettyValue #-}
escapeText :: Rope -> Doc JsonToken
escapeText :: Rope -> Doc JsonToken
escapeText Rope
text =
let t :: Text
t = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
text :: T.Text
ts :: [Text]
ts = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"') Text
t
ds :: [Doc JsonToken]
ds = (Text -> Doc JsonToken) -> [Text] -> [Doc JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc JsonToken
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
ts
in [Doc JsonToken] -> Doc JsonToken
forall ann. [Doc ann] -> Doc ann
hcat (Doc JsonToken -> [Doc JsonToken] -> [Doc JsonToken]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (JsonToken -> Doc JsonToken -> Doc JsonToken
forall ann. ann -> Doc ann -> Doc ann
annotate JsonToken
EscapeToken Doc JsonToken
"\\\"") [Doc JsonToken]
ds)
{-# INLINEABLE escapeText #-}