{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{- |
Module      :  ./Common/Json.hs
Description :  Json utilities
Copyright   :  (c) Christian Maeder, DFKI GmbH 2014
License     :  GPLv2 or higher, see LICENSE.txt
Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable

inspired by Yuriy Iskra's json2-types hackage package

-}

module Common.Json
  ( Json (..)
  , ppJson
  , mkJStr
  , mkJBool
  , mkJNum
  , mkJArr
  , mkJObj
  , JPair
  , mkJPair
  , mkNameJPair
  , mkPriorityJPair
  , toJson
  , rangeToJPair
  , rangedToJson
  , anToJson
  , tagJson
  , pJson
  , ToJson (..)
  ) where

import Common.AS_Annotation
import Common.Data
import Common.Doc as Doc
import Common.DocUtils
import Common.GlobalAnnotations
import Common.Id
import Common.Parsec
import Common.Result
import Common.Utils

import Data.Char
import Data.Data
import Data.List
import Data.Maybe
import Data.Ratio

import Numeric

import Text.ParserCombinators.Parsec

data Json
  = JString String
  | JNumber Rational
  | JBool Bool
  | JNull
  | JArray [Json]
  | JObject [JPair]
    deriving (Json -> Json -> Bool
(Json -> Json -> Bool) -> (Json -> Json -> Bool) -> Eq Json
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Json -> Json -> Bool
$c/= :: Json -> Json -> Bool
== :: Json -> Json -> Bool
$c== :: Json -> Json -> Bool
Eq, Eq Json
Eq Json =>
(Json -> Json -> Ordering)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Bool)
-> (Json -> Json -> Json)
-> (Json -> Json -> Json)
-> Ord Json
Json -> Json -> Bool
Json -> Json -> Ordering
Json -> Json -> Json
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 :: Json -> Json -> Json
$cmin :: Json -> Json -> Json
max :: Json -> Json -> Json
$cmax :: Json -> Json -> Json
>= :: Json -> Json -> Bool
$c>= :: Json -> Json -> Bool
> :: Json -> Json -> Bool
$c> :: Json -> Json -> Bool
<= :: Json -> Json -> Bool
$c<= :: Json -> Json -> Bool
< :: Json -> Json -> Bool
$c< :: Json -> Json -> Bool
compare :: Json -> Json -> Ordering
$ccompare :: Json -> Json -> Ordering
$cp1Ord :: Eq Json
Ord)

type JPair = (String, Json)

showRat :: Rational -> String
showRat :: Rational -> String
showRat r :: Rational
r = if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r else
  Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r :: Double)

-- use show to quote strings
instance Show Json where
  show :: Json -> String
show j :: Json
j = case Json
j of
    JString s :: String
s -> ShowS
forall a. Show a => a -> String
show String
s
    JNumber r :: Rational
r -> Rational -> String
showRat Rational
r
    JBool b :: Bool
b -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
b
    JNull -> "null"
    JArray js :: [Json]
js -> [Json] -> String
forall a. Show a => a -> String
show [Json]
js
    JObject m :: [JPair]
m -> '{'
      Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ","
        ((JPair -> String) -> [JPair] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (k :: String
k, v :: Json
v) -> ShowS
forall a. Show a => a -> String
show String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Json -> String
forall a. Show a => a -> String
show Json
v) [JPair]
m)
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ "}"

ppJson :: Json -> String
ppJson :: Json -> String
ppJson = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (Json -> Doc) -> Json -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Json -> Doc
pJ Bool
False

getOpBr :: Json -> Maybe Doc
getOpBr :: Json -> Maybe Doc
getOpBr j :: Json
j = case Json
j of
  JArray (j1 :: Json
j1 : _) -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ Doc
lbrack Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty (Json -> Maybe Doc
getOpBr Json
j1)
  JObject _ -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
lbrace
  _ -> Maybe Doc
forall a. Maybe a
Nothing

pJ :: Bool -> Json -> Doc
pJ :: Bool -> Json -> Doc
pJ omitOpBr :: Bool
omitOpBr j :: Json
j = case Json
j of
  JArray js :: [Json]
js@(j1 :: Json
j1 : _) -> let md :: Maybe Doc
md = Json -> Maybe Doc
getOpBr Json
j1 in
    [Doc] -> Doc
cat [ if Bool
omitOpBr then Doc
empty else Doc
lbrack Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty Maybe Doc
md
        , [Doc] -> Doc
sep (Bool -> [Json] -> [Doc]
pJA (Maybe Doc -> Bool
forall a. Maybe a -> Bool
isJust Maybe Doc
md) [Json]
js) ]
  JObject m :: [JPair]
m -> [Doc] -> Doc
sep [ if Bool
omitOpBr then Doc
empty else Doc
lbrace
    , [Doc] -> Doc
sep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
      ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JPair -> Doc) -> [JPair] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\ (k :: String
k, v :: Json
v) -> let md :: Maybe Doc
md = Json -> Maybe Doc
getOpBr Json
v in
        [Doc] -> Doc
cat [ String -> Doc
text (ShowS
forall a. Show a => a -> String
show String
k) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty Maybe Doc
md
            , Doc
Doc.space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Bool -> Json -> Doc
pJ (Maybe Doc -> Bool
forall a. Maybe a -> Bool
isJust Maybe Doc
md) Json
v]) [JPair]
m
    , Doc
rbrace ]
  _ -> String -> Doc
text (Json -> String
forall a. Show a => a -> String
show Json
j)

pJA :: Bool -> [Json] -> [Doc]
pJA :: Bool -> [Json] -> [Doc]
pJA omitOpBr :: Bool
omitOpBr l :: [Json]
l = case [Json]
l of
  j1 :: Json
j1 : r :: [Json]
r@(j2 :: Json
j2 : _) -> let md :: Maybe Doc
md = Json -> Maybe Doc
getOpBr Json
j2 in
      (Bool -> Json -> Doc
pJ Bool
omitOpBr Json
j1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
<+> Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty Maybe Doc
md)
      Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [Json] -> [Doc]
pJA (Maybe Doc -> Bool
forall a. Maybe a -> Bool
isJust Maybe Doc
md) [Json]
r
  [j :: Json
j] -> [Bool -> Json -> Doc
pJ Bool
omitOpBr Json
j Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrack]
  [] -> []

mkJStr :: String -> Json
mkJStr :: String -> Json
mkJStr = String -> Json
JString

mkJPair :: String -> String -> JPair
mkJPair :: String -> String -> JPair
mkJPair a :: String
a b :: String
b = (String
a, String -> Json
mkJStr String
b)

mkNameJPair :: String -> JPair
mkNameJPair :: String -> JPair
mkNameJPair = String -> String -> JPair
mkJPair "name"

mkPriorityJPair :: String -> JPair
mkPriorityJPair :: String -> JPair
mkPriorityJPair = String -> String -> JPair
mkJPair "priority"

mkJNum :: Real b => b -> Json
mkJNum :: b -> Json
mkJNum = Rational -> Json
JNumber (Rational -> Json) -> (b -> Rational) -> b -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Rational
forall a. Real a => a -> Rational
toRational

mkJBool :: Bool -> Json
mkJBool :: Bool -> Json
mkJBool = Bool -> Json
JBool

toJson :: Pretty a => GlobalAnnos -> a -> Json
toJson :: GlobalAnnos -> a -> Json
toJson ga :: GlobalAnnos
ga a :: a
a = String -> Json
mkJStr (String -> Json) -> String -> Json
forall a b. (a -> b) -> a -> b
$ GlobalAnnos -> a -> ShowS
forall a. Pretty a => GlobalAnnos -> a -> ShowS
showGlobalDoc GlobalAnnos
ga a
a ""

mkJObj :: [JPair] -> Json
mkJObj :: [JPair] -> Json
mkJObj l :: [JPair]
l = if [JPair] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JPair]
l then Json
JNull else [JPair] -> Json
JObject [JPair]
l

mkJArr :: [Json] -> Json
mkJArr :: [Json] -> Json
mkJArr l :: [Json]
l = if [Json] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Json]
l then Json
JNull else [Json] -> Json
JArray [Json]
l

rangeToJPair :: Range -> [JPair]
rangeToJPair :: Range -> [JPair]
rangeToJPair rg :: Range
rg = case Range -> [Pos]
rangeToList Range
rg of
  [] -> []
  ps :: [Pos]
ps -> [String -> String -> JPair
mkJPair "range" (String -> JPair) -> (Doc -> String) -> Doc -> JPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show (Doc -> JPair) -> Doc -> JPair
forall a b. (a -> b) -> a -> b
$ [Pos] -> Doc
prettyRange [Pos]
ps]

rangedToJson :: (GetRange a, Pretty a) => String -> GlobalAnnos -> a -> [JPair]
rangedToJson :: String -> GlobalAnnos -> a -> [JPair]
rangedToJson s :: String
s ga :: GlobalAnnos
ga a :: a
a = (String
s, GlobalAnnos -> a -> Json
forall a. Pretty a => GlobalAnnos -> a -> Json
toJson GlobalAnnos
ga a
a) JPair -> [JPair] -> [JPair]
forall a. a -> [a] -> [a]
: Range -> [JPair]
rangeToJPair (a -> Range
forall a. GetRange a => a -> Range
getRangeSpan a
a)

anToJson :: GlobalAnnos -> Annotation -> Json
anToJson :: GlobalAnnos -> Annotation -> Json
anToJson ga :: GlobalAnnos
ga = [JPair] -> Json
mkJObj ([JPair] -> Json) -> (Annotation -> [JPair]) -> Annotation -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GlobalAnnos -> Annotation -> [JPair]
forall a.
(GetRange a, Pretty a) =>
String -> GlobalAnnos -> a -> [JPair]
rangedToJson "annotation" GlobalAnnos
ga

tagJson :: String -> Json -> Json
tagJson :: String -> Json -> Json
tagJson s :: String
s j :: Json
j = [JPair] -> Json
mkJObj [(String
s, Json
j)]

pStr :: CharParser st String
pStr :: CharParser st String
pStr = do
  String
s <- CharParser st String
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  case ReadS String
forall a. Read a => ReadS a
reads String
s of
    [(s0 :: String
s0, s1 :: String
s1)] -> String -> ParsecT String st Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput String
s1 ParsecT String st Identity ()
-> CharParser st String -> CharParser st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> CharParser st String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s0
    _ -> CharParser st String
forall tok st a. GenParser tok st a
pzero

pJBool :: CharParser st Json
pJBool :: CharParser st Json
pJBool = [CharParser st Json] -> CharParser st Json
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
  ([CharParser st Json] -> CharParser st Json)
-> [CharParser st Json] -> CharParser st Json
forall a b. (a -> b) -> a -> b
$ (Bool -> CharParser st Json) -> [Bool] -> [CharParser st Json]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: Bool
b -> let j :: Json
j = Bool -> Json
mkJBool Bool
b in String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Json -> String
forall a. Show a => a -> String
show Json
j) ParsecT String st Identity String
-> CharParser st Json -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Json -> CharParser st Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
j)
    [Bool
False, Bool
True]

pJNull :: CharParser st Json
pJNull :: CharParser st Json
pJNull = String -> ParsecT String st Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Json -> String
forall a. Show a => a -> String
show Json
JNull) ParsecT String st Identity String
-> CharParser st Json -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Json -> CharParser st Json
forall (m :: * -> *) a. Monad m => a -> m a
return Json
JNull

pJNumber :: CharParser st Json
pJNumber :: CharParser st Json
pJNumber = do
  String
s <- ParsecT String st Identity String
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  case ReadS Rational -> ReadS Rational
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Rational
forall a. RealFrac a => ReadS a
readFloat String
s of
    [(n :: Rational
n, s1 :: String
s1)] -> String -> ParsecT String st Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput String
s1 ParsecT String st Identity ()
-> CharParser st Json -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Json -> CharParser st Json
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Json
JNumber Rational
n)
    _ -> CharParser st Json
forall tok st a. GenParser tok st a
pzero

pJson :: CharParser st Json
pJson :: CharParser st Json
pJson = CharParser st Json -> CharParser st Json
forall st a. CharParser st a -> CharParser st a
tok (CharParser st Json -> CharParser st Json)
-> CharParser st Json -> CharParser st Json
forall a b. (a -> b) -> a -> b
$ [CharParser st Json] -> CharParser st Json
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [(String -> Json)
-> ParsecT String st Identity String -> CharParser st Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Json
mkJStr ParsecT String st Identity String
forall st. CharParser st String
pStr, CharParser st Json
forall st. CharParser st Json
pJBool, CharParser st Json
forall st. CharParser st Json
pJNull, CharParser st Json
forall st. CharParser st Json
pJNumber, CharParser st Json
forall st. CharParser st Json
pJArr, CharParser st Json
forall st. CharParser st Json
pJObj]

tok :: CharParser st a -> CharParser st a
tok :: CharParser st a -> CharParser st a
tok p :: CharParser st a
p = CharParser st a
p CharParser st a -> ParsecT String st Identity () -> CharParser st a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< ParsecT String st Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces

cTok :: Char -> CharParser st ()
cTok :: Char -> CharParser st ()
cTok = ParsecT String st Identity Char -> CharParser st ()
forall (m :: * -> *) a. Monad m => m a -> m ()
forget (ParsecT String st Identity Char -> CharParser st ())
-> (Char -> ParsecT String st Identity Char)
-> Char
-> CharParser st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String st Identity Char -> ParsecT String st Identity Char
forall st a. CharParser st a -> CharParser st a
tok (ParsecT String st Identity Char
 -> ParsecT String st Identity Char)
-> (Char -> ParsecT String st Identity Char)
-> Char
-> ParsecT String st Identity Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ParsecT String st Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char

commaTok :: CharParser st ()
commaTok :: CharParser st ()
commaTok = Char -> CharParser st ()
forall st. Char -> CharParser st ()
cTok ','

pJArr :: CharParser st Json
pJArr :: CharParser st Json
pJArr = Char -> CharParser st ()
forall st. Char -> CharParser st ()
cTok '[' CharParser st () -> CharParser st Json -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Json] -> Json)
-> ParsecT String st Identity [Json] -> CharParser st Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Json] -> Json
JArray (CharParser st Json
-> CharParser st () -> ParsecT String st Identity [Json]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 CharParser st Json
forall st. CharParser st Json
pJson CharParser st ()
forall st. CharParser st ()
commaTok) CharParser st Json -> CharParser st () -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< Char -> CharParser st ()
forall st. Char -> CharParser st ()
cTok ']'

pJObj :: CharParser st Json
pJObj :: CharParser st Json
pJObj = Char -> CharParser st ()
forall st. Char -> CharParser st ()
cTok '{' CharParser st () -> CharParser st Json -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([JPair] -> Json)
-> ParsecT String st Identity [JPair] -> CharParser st Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [JPair] -> Json
JObject (ParsecT String st Identity JPair
-> CharParser st () -> ParsecT String st Identity [JPair]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT String st Identity JPair
forall st. CharParser st JPair
pJPair CharParser st ()
forall st. CharParser st ()
commaTok) CharParser st Json -> CharParser st () -> CharParser st Json
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< Char -> CharParser st ()
forall st. Char -> CharParser st ()
cTok '}'

pJPair :: CharParser st JPair
pJPair :: CharParser st JPair
pJPair = ParsecT String st Identity String
-> ParsecT String st Identity Json -> CharParser st JPair
forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
pair (ParsecT String st Identity String
-> ParsecT String st Identity String
forall st a. CharParser st a -> CharParser st a
tok ParsecT String st Identity String
forall st. CharParser st String
pStr ParsecT String st Identity String
-> ParsecT String st Identity ()
-> ParsecT String st Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
<< Char -> ParsecT String st Identity ()
forall st. Char -> CharParser st ()
cTok ':') ParsecT String st Identity Json
forall st. CharParser st Json
pJson

{- | convert to json with special treatment for numbers, booleans, strings
and other lists. -}
myDataToJson :: MyData -> Json
myDataToJson :: MyData -> Json
myDataToJson md :: MyData
md =
  let
    recordFieldToObject :: (String, MyData) -> (String, Json)
    recordFieldToObject :: (String, MyData) -> JPair
recordFieldToObject (fieldName :: String
fieldName, value :: MyData
value) =
      (ShowS
toSnakeCase String
fieldName, MyData -> Json
myDataToJson MyData
value)
  in
    case MyData
md of
      Builtin typ :: String
typ value :: String
value -> case String
typ of
        "number" -> case ReadS Rational -> ReadS Rational
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Rational
forall a. RealFrac a => ReadS a
readFloat String
value of
          [(n :: Rational
n, "")] -> Rational -> Json
JNumber Rational
n
          _ -> String -> Json
JString String
value
        "bool" | String
value String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "True" -> Bool -> Json
JBool Bool
True
               | String
value String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "False" -> Bool -> Json
JBool Bool
False
        "string" -> String -> Json
JString String
value
        _ -> String -> Json
JString String
value
      ListOrTuple _ mds :: [MyData]
mds -> [Json] -> Json
JArray ([Json] -> Json) -> [Json] -> Json
forall a b. (a -> b) -> a -> b
$ (MyData -> Json) -> [MyData] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map MyData -> Json
myDataToJson [MyData]
mds
      -- Special cases
      Cons c :: String
c Nothing [] | String
c String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["Nothing", "Just", "Left", "Right"] ->
        String -> Json
forall a. HasCallStack => String -> a
error ("myDataToJson: Constructor should not have appeared: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
c)
      -- Records
      Cons _ (Just fields :: [String]
fields) mds :: [MyData]
mds ->
        let
        in [JPair] -> Json
JObject ([JPair] -> Json) -> [JPair] -> Json
forall a b. (a -> b) -> a -> b
$ (String -> MyData -> JPair) -> [String] -> [MyData] -> [JPair]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((String, MyData) -> JPair) -> String -> MyData -> JPair
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (String, MyData) -> JPair
recordFieldToObject) [String]
fields [MyData]
mds
      -- Data types
      Cons constructor :: String
constructor Nothing mds :: [MyData]
mds -> case (MyData -> Json) -> [MyData] -> [Json]
forall a b. (a -> b) -> [a] -> [b]
map MyData -> Json
myDataToJson [MyData]
mds of
        [] -> String -> Json
JString String
constructor
        [e :: Json
e] -> Json
e
        ijs :: [Json]
ijs -> [Json] -> Json
JArray [Json]
ijs

class ToJson a where
  asJson :: a -> Json

instance {-# OVERLAPPABLE #-} Data a => ToJson a where
  asJson :: a -> Json
asJson = MyData -> Json
myDataToJson (MyData -> Json) -> (a -> MyData) -> a -> Json
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MyData -> MyData
normalizeMyDataForSerialization (MyData -> MyData) -> (a -> MyData) -> a -> MyData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MyData
forall a. Data a => a -> MyData
dataToMyData