{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Aeson.Match.QQ.Internal.AesonUtils
( toJSONE
, pp
) where
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding.Internal as Aeson (encodingToLazyByteString)
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
import Data.Bool (bool)
import Data.Foldable (toList)
import qualified Data.List as List
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Int (Int64)
import Data.Scientific (Scientific, floatingOrInteger)
import Data.String (fromString)
import Data.Text (Text)
import Data.Vector (Vector)
import Text.PrettyPrint ((<+>))
import qualified Text.PrettyPrint as PP
toJSONE :: Aeson.ToJSON x => x -> Aeson.Value
toJSONE :: forall x. ToJSON x => x -> Value
toJSONE x
x =
let
~(Just Value
val) = x -> Maybe Value
conv x
x
in
Value
val
where
conv :: x -> Maybe Value
conv =
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
Aeson.encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
Aeson.toEncoding
pp :: Aeson.Value -> PP.Doc
pp :: Value -> Doc
pp = \case
Value
Aeson.Null ->
Doc
rNull
Aeson.Bool Bool
b ->
Bool -> Doc
rBool Bool
b
Aeson.Number Scientific
n ->
Scientific -> Doc
rNumber Scientific
n
Aeson.String Text
str ->
Text -> Doc
rString Text
str
Aeson.Array Array
xs ->
Array -> Doc
rArray Array
xs
Aeson.Object Object
o ->
HashMap Text Value -> Doc
rObject (forall v. KeyMap v -> HashMap Text v
Aeson.KeyMap.toHashMapText Object
o)
where
rNull :: PP.Doc
rNull :: Doc
rNull =
Doc
"null"
rBool :: Bool -> PP.Doc
rBool :: Bool -> Doc
rBool =
forall a. a -> a -> Bool -> a
bool Doc
"false" Doc
"true"
rNumber :: Scientific -> PP.Doc
rNumber :: Scientific -> Doc
rNumber =
forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Show a => a -> String
show @Double) (forall a. Show a => a -> String
show @Int64) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger
rString :: Text -> PP.Doc
rString :: Text -> Doc
rString =
forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
rArray :: Vector Aeson.Value -> PP.Doc
rArray :: Array -> Doc
rArray Array
values =
case forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
values of
[] ->
Doc
"[]"
Value
x : [Value]
xs ->
[Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
[Doc
"[" Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
x] forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> [a] -> [b]
map (\Value
x' -> Doc
"," Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
x') [Value]
xs forall a. Semigroup a => a -> a -> a
<>
[Doc
"]"]
rObject :: HashMap Text Aeson.Value -> PP.Doc
rObject :: HashMap Text Value -> Doc
rObject HashMap Text Value
values =
case forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
values) of
[] ->
Doc
"{}"
(Text, Value)
kv : [(Text, Value)]
kvs ->
[Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
[Doc
"{" Doc -> Doc -> Doc
<+> (Text, Value) -> Doc
rKeyValue (Text, Value)
kv] forall a. Semigroup a => a -> a -> a
<>
forall a b. (a -> b) -> [a] -> [b]
map (\(Text, Value)
kv' -> Doc
"," Doc -> Doc -> Doc
<+> (Text, Value) -> Doc
rKeyValue (Text, Value)
kv') [(Text, Value)]
kvs forall a. Semigroup a => a -> a -> a
<>
[Doc
"}"]
where
rKeyValue :: (Text, Value) -> Doc
rKeyValue (Text
key, Value
value) =
if Value -> Bool
simpleValue Value
value then
(Text -> Doc
rString Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":") Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
value
else
[Doc] -> Doc
PP.vcat
[ Text -> Doc
rString Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":"
, Value -> Doc
pp Value
value
]
simpleValue :: Aeson.Value -> Bool
simpleValue :: Value -> Bool
simpleValue = \case
Aeson.Null {} ->
Bool
True
Aeson.Bool {} ->
Bool
True
Aeson.Number {} ->
Bool
True
Aeson.String {} ->
Bool
True
Aeson.Array {} ->
Bool
False
Aeson.Object {} ->
Bool
False