{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Jordan.ToJSON.Text
    where

import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.List (intersperse)
import qualified Data.Scientific as Sci
import Data.Semigroup (Endo(..))
import Data.String (IsString(..))
import qualified Data.Text as T
import Data.Void (absurd)
import Jordan.ToJSON.Class

data TextComma
  = Written (T.Text -> T.Text)
  | Empty

runWritten :: TextComma -> T.Text -> T.Text
runWritten :: TextComma -> Text -> Text
runWritten TextComma
Empty = Text -> Text
forall a. a -> a
id
runWritten (Written Text -> Text
f) = Text -> Text
f

instance IsString TextComma where
  fromString :: String -> TextComma
fromString String
s = (Text -> Text) -> TextComma
Written (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
s)

instance Semigroup TextComma where
  TextComma
Empty <> :: TextComma -> TextComma -> TextComma
<> TextComma
a = TextComma
a
  TextComma
a <> TextComma
Empty = TextComma
a
  (Written Text -> Text
f) <> (Written Text -> Text
f') = (Text -> Text) -> TextComma
Written (Text -> Text
f (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f')

instance Monoid TextComma where
  mempty :: TextComma
mempty = TextComma
Empty

newtype CommaBuilder v = CommaBuilder { CommaBuilder v -> v -> TextComma
runCommaBuilder :: v -> TextComma }
  deriving (b -> CommaBuilder v -> CommaBuilder v
NonEmpty (CommaBuilder v) -> CommaBuilder v
CommaBuilder v -> CommaBuilder v -> CommaBuilder v
(CommaBuilder v -> CommaBuilder v -> CommaBuilder v)
-> (NonEmpty (CommaBuilder v) -> CommaBuilder v)
-> (forall b. Integral b => b -> CommaBuilder v -> CommaBuilder v)
-> Semigroup (CommaBuilder v)
forall b. Integral b => b -> CommaBuilder v -> CommaBuilder v
forall v. NonEmpty (CommaBuilder v) -> CommaBuilder v
forall v. CommaBuilder v -> CommaBuilder v -> CommaBuilder v
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall v b. Integral b => b -> CommaBuilder v -> CommaBuilder v
stimes :: b -> CommaBuilder v -> CommaBuilder v
$cstimes :: forall v b. Integral b => b -> CommaBuilder v -> CommaBuilder v
sconcat :: NonEmpty (CommaBuilder v) -> CommaBuilder v
$csconcat :: forall v. NonEmpty (CommaBuilder v) -> CommaBuilder v
<> :: CommaBuilder v -> CommaBuilder v -> CommaBuilder v
$c<> :: forall v. CommaBuilder v -> CommaBuilder v -> CommaBuilder v
Semigroup, Semigroup (CommaBuilder v)
CommaBuilder v
Semigroup (CommaBuilder v)
-> CommaBuilder v
-> (CommaBuilder v -> CommaBuilder v -> CommaBuilder v)
-> ([CommaBuilder v] -> CommaBuilder v)
-> Monoid (CommaBuilder v)
[CommaBuilder v] -> CommaBuilder v
CommaBuilder v -> CommaBuilder v -> CommaBuilder v
forall v. Semigroup (CommaBuilder v)
forall v. CommaBuilder v
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall v. [CommaBuilder v] -> CommaBuilder v
forall v. CommaBuilder v -> CommaBuilder v -> CommaBuilder v
mconcat :: [CommaBuilder v] -> CommaBuilder v
$cmconcat :: forall v. [CommaBuilder v] -> CommaBuilder v
mappend :: CommaBuilder v -> CommaBuilder v -> CommaBuilder v
$cmappend :: forall v. CommaBuilder v -> CommaBuilder v -> CommaBuilder v
mempty :: CommaBuilder v
$cmempty :: forall v. CommaBuilder v
$cp1Monoid :: forall v. Semigroup (CommaBuilder v)
Monoid) via (v -> TextComma)

runCommaBuilder' :: CommaBuilder v -> v -> T.Text -> T.Text
runCommaBuilder' :: CommaBuilder v -> v -> Text -> Text
runCommaBuilder' (CommaBuilder v -> TextComma
f) = TextComma -> Text -> Text
runWritten (TextComma -> Text -> Text)
-> (v -> TextComma) -> v -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> TextComma
f

instance Contravariant CommaBuilder where
  contramap :: (a -> b) -> CommaBuilder b -> CommaBuilder a
contramap a -> b
f (CommaBuilder b -> TextComma
v) = (a -> TextComma) -> CommaBuilder a
forall v. (v -> TextComma) -> CommaBuilder v
CommaBuilder (b -> TextComma
v (b -> TextComma) -> (a -> b) -> a -> TextComma
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Divisible CommaBuilder where
  conquer :: CommaBuilder a
conquer = (a -> TextComma) -> CommaBuilder a
forall v. (v -> TextComma) -> CommaBuilder v
CommaBuilder (TextComma -> a -> TextComma
forall a b. a -> b -> a
const TextComma
Empty)
  divide :: (a -> (b, c)) -> CommaBuilder b -> CommaBuilder c -> CommaBuilder a
divide a -> (b, c)
d (CommaBuilder b -> TextComma
b) (CommaBuilder c -> TextComma
c) = (a -> TextComma) -> CommaBuilder a
forall v. (v -> TextComma) -> CommaBuilder v
CommaBuilder ((a -> TextComma) -> CommaBuilder a)
-> (a -> TextComma) -> CommaBuilder a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    let (b
b', c
c') = a -> (b, c)
d a
a in b -> TextComma
b b
b' TextComma -> TextComma -> TextComma
forall a. Semigroup a => a -> a -> a
<> c -> TextComma
c c
c'

newtype TextArray v = TextArray { TextArray v -> v -> [Text] -> [Text]
runTextArray :: v -> ([T.Text] -> [T.Text]) }
  deriving (b -> TextArray v -> TextArray v
NonEmpty (TextArray v) -> TextArray v
TextArray v -> TextArray v -> TextArray v
(TextArray v -> TextArray v -> TextArray v)
-> (NonEmpty (TextArray v) -> TextArray v)
-> (forall b. Integral b => b -> TextArray v -> TextArray v)
-> Semigroup (TextArray v)
forall b. Integral b => b -> TextArray v -> TextArray v
forall v. NonEmpty (TextArray v) -> TextArray v
forall v. TextArray v -> TextArray v -> TextArray v
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall v b. Integral b => b -> TextArray v -> TextArray v
stimes :: b -> TextArray v -> TextArray v
$cstimes :: forall v b. Integral b => b -> TextArray v -> TextArray v
sconcat :: NonEmpty (TextArray v) -> TextArray v
$csconcat :: forall v. NonEmpty (TextArray v) -> TextArray v
<> :: TextArray v -> TextArray v -> TextArray v
$c<> :: forall v. TextArray v -> TextArray v -> TextArray v
Semigroup, Semigroup (TextArray v)
TextArray v
Semigroup (TextArray v)
-> TextArray v
-> (TextArray v -> TextArray v -> TextArray v)
-> ([TextArray v] -> TextArray v)
-> Monoid (TextArray v)
[TextArray v] -> TextArray v
TextArray v -> TextArray v -> TextArray v
forall v. Semigroup (TextArray v)
forall v. TextArray v
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall v. [TextArray v] -> TextArray v
forall v. TextArray v -> TextArray v -> TextArray v
mconcat :: [TextArray v] -> TextArray v
$cmconcat :: forall v. [TextArray v] -> TextArray v
mappend :: TextArray v -> TextArray v -> TextArray v
$cmappend :: forall v. TextArray v -> TextArray v -> TextArray v
mempty :: TextArray v
$cmempty :: forall v. TextArray v
$cp1Monoid :: forall v. Semigroup (TextArray v)
Monoid) via (v -> Endo [T.Text])

instance Contravariant TextArray where
  contramap :: (a -> b) -> TextArray b -> TextArray a
contramap a -> b
f (TextArray b -> [Text] -> [Text]
b) = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ \a
a -> b -> [Text] -> [Text]
b (a -> b
f a
a)

instance Divisible TextArray where
  conquer :: TextArray a
conquer = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> a -> [Text] -> [Text]
forall a b. a -> b -> a
const [Text] -> [Text]
forall a. Monoid a => a
mempty
  divide :: (a -> (b, c)) -> TextArray b -> TextArray c -> TextArray a
divide a -> (b, c)
d (TextArray b -> [Text] -> [Text]
b) (TextArray c -> [Text] -> [Text]
c) = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    let (b
b', c
c') = a -> (b, c)
d a
a in b -> [Text] -> [Text]
b b
b' ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [Text] -> [Text]
c c
c'

instance Decidable TextArray where
  lose :: (a -> Void) -> TextArray a
lose a -> Void
_ = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> a -> [Text] -> [Text]
forall a b. a -> b -> a
const [Text] -> [Text]
forall a. Monoid a => a
mempty
  choose :: (a -> Either b c) -> TextArray b -> TextArray c -> TextArray a
choose a -> Either b c
f (TextArray b -> [Text] -> [Text]
b) (TextArray c -> [Text] -> [Text]
c) = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ \a
a ->
    case a -> Either b c
f a
a of
      Left b
b'  -> b -> [Text] -> [Text]
b b
b'
      Right c
c' -> c -> [Text] -> [Text]
c c
c'

instance JSONTupleSerializer CommaBuilder where
  writeItem :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> CommaBuilder a
writeItem forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
f = (a -> TextComma) -> CommaBuilder a
forall v. (v -> TextComma) -> CommaBuilder v
CommaBuilder ((a -> TextComma) -> CommaBuilder a)
-> (a -> TextComma) -> CommaBuilder a
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> TextComma
Written ((Text -> Text) -> TextComma)
-> (a -> Text -> Text) -> a -> TextComma
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONText a -> a -> Text -> Text
forall a. JSONText a -> a -> Text -> Text
runJSONText JSONText a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
f

instance JSONObjectSerializer CommaBuilder where
  writeField :: Text
-> (forall (jsonSerializer :: * -> *).
    JSONSerializer jsonSerializer =>
    jsonSerializer a)
-> CommaBuilder a
writeField Text
t forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
s = (a -> TextComma) -> CommaBuilder a
forall v. (v -> TextComma) -> CommaBuilder v
CommaBuilder ((a -> TextComma) -> CommaBuilder a)
-> (a -> TextComma) -> CommaBuilder a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    (Text -> Text) -> TextComma
Written (Text -> Text -> Text
quoteString Text
t (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONText a -> a -> Text -> Text
forall a. JSONText a -> a -> Text -> Text
runJSONText JSONText a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
s a
arg)

instance JSONTupleSerializer TextArray where
  writeItem :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> TextArray a
writeItem forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
f = (a -> [Text] -> [Text]) -> TextArray a
forall v. (v -> [Text] -> [Text]) -> TextArray v
TextArray ((a -> [Text] -> [Text]) -> TextArray a)
-> (a -> [Text] -> [Text]) -> TextArray a
forall a b. (a -> b) -> a -> b
$ \a
a -> ([JSONText a -> a -> Text -> Text
forall a. JSONText a -> a -> Text -> Text
runJSONText JSONText a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
f a
a Text
""] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>)

newtype JSONText a
  = JSONText { JSONText a -> a -> Text -> Text
runJSONText :: a -> (T.Text -> T.Text) }
  deriving (b -> JSONText a -> JSONText a
NonEmpty (JSONText a) -> JSONText a
JSONText a -> JSONText a -> JSONText a
(JSONText a -> JSONText a -> JSONText a)
-> (NonEmpty (JSONText a) -> JSONText a)
-> (forall b. Integral b => b -> JSONText a -> JSONText a)
-> Semigroup (JSONText a)
forall b. Integral b => b -> JSONText a -> JSONText a
forall a. NonEmpty (JSONText a) -> JSONText a
forall a. JSONText a -> JSONText a -> JSONText a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> JSONText a -> JSONText a
stimes :: b -> JSONText a -> JSONText a
$cstimes :: forall a b. Integral b => b -> JSONText a -> JSONText a
sconcat :: NonEmpty (JSONText a) -> JSONText a
$csconcat :: forall a. NonEmpty (JSONText a) -> JSONText a
<> :: JSONText a -> JSONText a -> JSONText a
$c<> :: forall a. JSONText a -> JSONText a -> JSONText a
Semigroup, Semigroup (JSONText a)
JSONText a
Semigroup (JSONText a)
-> JSONText a
-> (JSONText a -> JSONText a -> JSONText a)
-> ([JSONText a] -> JSONText a)
-> Monoid (JSONText a)
[JSONText a] -> JSONText a
JSONText a -> JSONText a -> JSONText a
forall a. Semigroup (JSONText a)
forall a. JSONText a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [JSONText a] -> JSONText a
forall a. JSONText a -> JSONText a -> JSONText a
mconcat :: [JSONText a] -> JSONText a
$cmconcat :: forall a. [JSONText a] -> JSONText a
mappend :: JSONText a -> JSONText a -> JSONText a
$cmappend :: forall a. JSONText a -> JSONText a -> JSONText a
mempty :: JSONText a
$cmempty :: forall a. JSONText a
$cp1Monoid :: forall a. Semigroup (JSONText a)
Monoid) via (a -> Endo T.Text)

instance Contravariant JSONText where
  contramap :: (a -> b) -> JSONText b -> JSONText a
contramap a -> b
f (JSONText b -> Text -> Text
s) = (a -> Text -> Text) -> JSONText a
forall a. (a -> Text -> Text) -> JSONText a
JSONText (b -> Text -> Text
s (b -> Text -> Text) -> (a -> b) -> a -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Selectable JSONText where
  giveUp :: (arg -> Void) -> JSONText arg
giveUp arg -> Void
f = (arg -> Text -> Text) -> JSONText arg
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((arg -> Text -> Text) -> JSONText arg)
-> (arg -> Text -> Text) -> JSONText arg
forall a b. (a -> b) -> a -> b
$ \arg
a -> Void -> Text -> Text
forall a. Void -> a
absurd (arg -> Void
f arg
a)
  select :: (arg -> Either lhs rhs)
-> JSONText lhs -> JSONText rhs -> JSONText arg
select arg -> Either lhs rhs
f (JSONText lhs -> Text -> Text
lhs) (JSONText rhs -> Text -> Text
rhs) = (arg -> Text -> Text) -> JSONText arg
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((arg -> Text -> Text) -> JSONText arg)
-> (arg -> Text -> Text) -> JSONText arg
forall a b. (a -> b) -> a -> b
$ (lhs -> Text -> Text)
-> (rhs -> Text -> Text) -> Either lhs rhs -> Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either lhs -> Text -> Text
lhs rhs -> Text -> Text
rhs (Either lhs rhs -> Text -> Text)
-> (arg -> Either lhs rhs) -> arg -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. arg -> Either lhs rhs
f

convChar :: Char -> (T.Text -> T.Text)
convChar :: Char -> Text -> Text
convChar = \case
  Char
'\b' -> (Text
"\\b" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'\f' -> (Text
"\\f" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'\n' -> (Text
"\\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'\r' -> (Text
"\\r" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'\t' -> (Text
"\\t" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'"' -> (Text
"\\\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
'\\' -> (Text
"\\\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  Char
o -> (Char -> Text
T.singleton Char
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

isBadChar :: Char -> Bool
isBadChar :: Char -> Bool
isBadChar = \case
  Char
'\b' -> Bool
True
  Char
'\f' -> Bool
True
  Char
'\r' -> Bool
True
  Char
'\t' -> Bool
True
  Char
'\\' -> Bool
True
  Char
'"' -> Bool
True
  Char
_ -> Bool
False

quoteString :: T.Text -> (T.Text -> T.Text)
quoteString :: Text -> Text -> Text
quoteString Text
t = (Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
innerText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  where
    innerText :: Text -> Text
innerText
      | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isBadChar Text
t = ((Text -> Text) -> Char -> Text -> Text)
-> (Text -> Text) -> Text -> Text -> Text
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Text -> Text
o Char
a -> Text -> Text
o (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
convChar Char
a) Text -> Text
forall a. a -> a
id Text
t
      | Bool
otherwise = (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

sArray :: (a -> T.Text -> T.Text) -> [a] -> (T.Text -> T.Text)
sArray :: (a -> Text -> Text) -> [a] -> Text -> Text
sArray a -> Text -> Text
_ [] = Text -> Text
forall a. a -> a
id
sArray a -> Text -> Text
f [a
x] = a -> Text -> Text
f a
x
sArray a -> Text -> Text
f (a
x : [a]
xs) = a -> Text -> Text
f a
x (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text -> Text) -> [a] -> Text -> Text
forall a. (a -> Text -> Text) -> [a] -> Text -> Text
sArray a -> Text -> Text
f [a]
xs

instance JSONSerializer JSONText where
  serializeNull :: JSONText any
serializeNull = (any -> Text -> Text) -> JSONText any
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((any -> Text -> Text) -> JSONText any)
-> (any -> Text -> Text) -> JSONText any
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> any -> Text -> Text
forall a b. a -> b -> a
const (Text
"null" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  serializeText :: JSONText Text
serializeText = (Text -> Text -> Text) -> JSONText Text
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((Text -> Text -> Text) -> JSONText Text)
-> (Text -> Text -> Text) -> JSONText Text
forall a b. (a -> b) -> a -> b
$ \Text
a -> Text -> Text -> Text
quoteString Text
a
  serializeTextConstant :: Text -> JSONText a
serializeTextConstant Text
t = (a -> Text -> Text) -> JSONText a
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((a -> Text -> Text) -> JSONText a)
-> (a -> Text -> Text) -> JSONText a
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> a -> Text -> Text
forall a b. a -> b -> a
const ((Text -> Text) -> a -> Text -> Text)
-> (Text -> Text) -> a -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
quoteString Text
t
  serializeNumber :: JSONText Scientific
serializeNumber = (Scientific -> Text -> Text) -> JSONText Scientific
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((Scientific -> Text -> Text) -> JSONText Scientific)
-> (Scientific -> Text -> Text) -> JSONText Scientific
forall a b. (a -> b) -> a -> b
$ \Scientific
n ->
    ((String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
Sci.formatScientific FPFormat
Sci.Generic Maybe Int
forall a. Maybe a
Nothing Scientific
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  serializeDictionary :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> JSONText (t (Text, a))
serializeDictionary (JSONText serItem) = (t (Text, a) -> Text -> Text) -> JSONText (t (Text, a))
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((t (Text, a) -> Text -> Text) -> JSONText (t (Text, a)))
-> (t (Text, a) -> Text -> Text) -> JSONText (t (Text, a))
forall a b. (a -> b) -> a -> b
$ \t (Text, a)
n ->
    (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Text, a) -> Text -> Text
forall (t :: * -> *). Foldable t => t (Text, a) -> Text -> Text
keys t (Text, a)
n (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      where
        keys :: t (Text, a) -> Text -> Text
keys t (Text, a)
v = TextComma -> Text -> Text
runWritten (TextComma -> Text -> Text) -> TextComma -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, a) -> TextComma) -> t (Text, a) -> TextComma
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Text
k, a
v) -> (Text -> Text) -> TextComma
Written ((Text -> Text) -> TextComma) -> (Text -> Text) -> TextComma
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
quoteString Text
k (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text -> Text
serItem a
v) t (Text, a)
v
  serializeBool :: JSONText Bool
serializeBool = (Bool -> Text -> Text) -> JSONText Bool
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((Bool -> Text -> Text) -> JSONText Bool)
-> (Bool -> Text -> Text) -> JSONText Bool
forall a b. (a -> b) -> a -> b
$ \Bool
a -> ((if Bool
a then Text
"true" else Text
"false") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  serializeObject :: Text
-> (forall (objSerializer :: * -> *).
    JSONObjectSerializer objSerializer =>
    objSerializer a)
-> JSONText a
serializeObject Text
n forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a
obj = (a -> Text -> Text) -> JSONText a
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((a -> Text -> Text) -> JSONText a)
-> (a -> Text -> Text) -> JSONText a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    (Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaBuilder a -> a -> Text -> Text
forall v. CommaBuilder v -> v -> Text -> Text
runCommaBuilder' CommaBuilder a
forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a
obj a
arg (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  serializeTuple :: (forall (tupleSerializer :: * -> *).
 JSONTupleSerializer tupleSerializer =>
 tupleSerializer a)
-> JSONText a
serializeTuple forall (tupleSerializer :: * -> *).
JSONTupleSerializer tupleSerializer =>
tupleSerializer a
obj = (a -> Text -> Text) -> JSONText a
forall a. (a -> Text -> Text) -> JSONText a
JSONText ((a -> Text -> Text) -> JSONText a)
-> (a -> Text -> Text) -> JSONText a
forall a b. (a -> b) -> a -> b
$ \a
arg ->
    (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaBuilder a -> a -> Text -> Text
forall v. CommaBuilder v -> v -> Text -> Text
runCommaBuilder' CommaBuilder a
forall (tupleSerializer :: * -> *).
JSONTupleSerializer tupleSerializer =>
tupleSerializer a
obj a
arg (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  serializeArray :: JSONText [a]
serializeArray = ([a] -> Text -> Text) -> JSONText [a]
forall a. (a -> Text -> Text) -> JSONText a
JSONText (([a] -> Text -> Text) -> JSONText [a])
-> ([a] -> Text -> Text) -> JSONText [a]
forall a b. (a -> b) -> a -> b
$ \[a]
a -> (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text -> Text) -> [a] -> Text -> Text
forall a. (a -> Text -> Text) -> [a] -> Text -> Text
sArray (JSONText a -> a -> Text -> Text
forall a. JSONText a -> a -> Text -> Text
runJSONText JSONText a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON) [a]
a (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

toJSONText :: (ToJSON a) => a -> T.Text
toJSONText :: a -> Text
toJSONText a
a = JSONText a -> a -> Text -> Text
forall a. JSONText a -> a -> Text -> Text
runJSONText JSONText a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON a
a Text
""