Json.hs revision 4e9a6943fbd220c49b5984b2f26c854de962467f
b6ff72be73dad3d1394cf2c71e29e67624ff030bChristian Maeder{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : Json utilities
2725abe920f91de62ae5c0b7230c1627cccf5fabChristian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2014
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederMaintainer : Christian.Maeder@dfki.de
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederStability : provisional
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederPortability : non-portable
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederinspired by Yuriy Iskra's json2-types hackage package
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder , mkNameJPair
85e1d54a475bfc30b3eac5ae6c5e42a2d7e93f10Christian Maeder , mkPriorityJPair
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder , rangeToJPair
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder , rangedToJson
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder , ToJson (..)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederimport Numeric
3a9d784341454573b50b32fa1b494e7418df3086Christian Maeder = JString String
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder | JNumber Rational
9d6562465b41f17c7967d4e5678f34811d958cb2Christian Maeder | JArray [Json]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | JObject [JPair]
502483734c83d0bf1eadcc94113d0362f8713784Christian Maeder deriving (Eq, Ord)
be43c3fa0292555bd126784ae27ff5c1d23438cbChristian Maedertype JPair = (String, Json)
16b71dad8d398af412d66a4f4763f1ada5b03d23Christian MaedershowRat :: Rational -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedershowRat r = if denominator r == 1 then show $ numerator r else
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder show (fromRational r :: Double)
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian Maeder-- use show to quote strings
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian Maederinstance Show Json where
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian Maeder show j = case j of
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian Maeder JString s -> show s
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder JNumber r -> showRat r
2353f65833a3da763392f771223250cd50b8d873Christian Maeder JBool b -> map toLower $ show b
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder JNull -> "null"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder JArray js -> show js
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder JObject m -> '{'
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder : intercalate ","
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder (map (\ (k, v) -> show k ++ ":" ++ show v) m)
d81905a5b924415c524d702df26204683c82c12eChristian MaederppJson :: Json -> String
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian MaederppJson = show . pJ False
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetOpBr :: Json -> Maybe Doc
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetOpBr j = case j of
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder JArray (j1 : _) -> Just $ lbrack <> fromMaybe empty (getOpBr j1)
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder JObject _ -> Just lbrace
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederpJ :: Bool -> Json -> Doc
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederpJ omitOpBr j = case j of
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder JArray js@(j1 : _) -> let md = getOpBr j1 in
0ae7a79e865d4a6022d705d160530682b3c1f825Christian Maeder cat [ if omitOpBr then empty else lbrack <> fromMaybe empty md
083bc1972a66d73749760eab3a90bf4eb9ca7951Christian Maeder , sep (pJA (isJust md) js) ]
6352f3c31da3043783a13be6594aacb2147378baRazvan Pascanu JObject m -> sep [ if omitOpBr then empty else lbrace
fefee7e1dee1ee5f0768a03a4abae88d1ca2c3fdRazvan Pascanu , sep . punctuate comma
b324cda6178c49ddeead3ce62b832ccf644cbcabRazvan Pascanu $ map (\ (k, v) -> let md = getOpBr v in
fefee7e1dee1ee5f0768a03a4abae88d1ca2c3fdRazvan Pascanu cat [ text (show k) <> colon <+> fromMaybe empty md
bc263f610d20a9cd3014ddfca903026127fa0d48Christian Maeder , Doc.space <> pJ (isJust md) v]) m
8c8545dd3bf34fbcbc16904b65d249658f8f9efcChristian Maeder _ -> text (show j)
33fcc19ef2b59493b4e91eebf701df95fd230765Christian MaederpJA :: Bool -> [Json] -> [Doc]
33fcc19ef2b59493b4e91eebf701df95fd230765Christian MaederpJA omitOpBr l = case l of
33fcc19ef2b59493b4e91eebf701df95fd230765Christian Maeder j1 : r@(j2 : _) -> let md = getOpBr j2 in
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder (pJ omitOpBr j1 <> comma <+> fromMaybe empty md)
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder : pJA (isJust md) r
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder [j] -> [pJ omitOpBr j <> rbrack]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJStr :: String -> Json
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJStr = JString
2360728d4185c0c04279c999941c64d36626af79Christian MaedermkJPair :: String -> String -> JPair
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJPair a b = (a, mkJStr b)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkNameJPair :: String -> JPair
beff4152e9f0fe90885458d1a1733b183a2a8816Christian MaedermkNameJPair = mkJPair "name"
fdac680252d7347858bd67b4c2a2aaa52e623815Christian MaedermkPriorityJPair :: String -> JPair
a9e804dbec424ec36e34bab955cbe90edac5baa6Christian MaedermkPriorityJPair = mkJPair "priority"
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJNum :: Real b => b -> Json
b76d27eba526ecac2a20400fa505ec5c642ae7d2Dominik LueckemkJNum = JNumber . toRational
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus LuettichmkJBool :: Bool -> Json
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus LuettichmkJBool = JBool
2353f65833a3da763392f771223250cd50b8d873Christian MaedertoJson :: Pretty a => GlobalAnnos -> a -> Json
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedertoJson ga a = mkJStr $ showGlobalDoc ga a ""
2353f65833a3da763392f771223250cd50b8d873Christian MaedermkJObj :: [JPair] -> Json
2353f65833a3da763392f771223250cd50b8d873Christian MaedermkJObj l = if null l then JNull else JObject l
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJArr :: [Json] -> Json
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedermkJArr l = if null l then JNull else JArray l
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederrangeToJPair :: Range -> [JPair]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederrangeToJPair rg = case rangeToList rg of
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder ps -> [mkJPair "range" . show $ prettyRange ps]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederrangedToJson :: (GetRange a, Pretty a) => String -> GlobalAnnos -> a -> [JPair]
00df6fd583c19393fa141d5a0e21ac74c7bf5b19Christian MaederrangedToJson s ga a = (s, toJson ga a) : rangeToJPair (getRangeSpan a)
cb2044812811d66efe038d914966e04290be93faChristian MaederanToJson :: GlobalAnnos -> Annotation -> Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederanToJson ga = mkJObj . rangedToJson "annotation" ga
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedertagJson :: String -> Json -> Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedertagJson s j = mkJObj [(s, j)]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpStr :: CharParser st String
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder s <- getInput
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder case reads s of
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder [(s0, s1)] -> setInput s1 >> return s0
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJBool :: CharParser st Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJBool = choice
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder $ map (\ b -> let j = mkJBool b in string (show j) >> return j)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder [False, True]
966519955f5f7111abac20118563132b9dd41165Christian MaederpJNull :: CharParser st Json
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian MaederpJNull = string (show JNull) >> return JNull
d96bfd1d7a4595bfff87771b91797330fa939455Christian MaederpJNumber :: CharParser st Json
8c8545dd3bf34fbcbc16904b65d249658f8f9efcChristian Maeder s <- getInput
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder case readSigned readFloat s of
34d14197eb3dd643a8e6ef3ed8cba5629528e97fAivaras Jakubauskas [(n, s1)] -> setInput s1 >> return (JNumber n)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJson :: CharParser st Json
b6ff72be73dad3d1394cf2c71e29e67624ff030bChristian MaederpJson = tok $ choice [fmap mkJStr pStr, pJBool, pJNull, pJNumber, pJArr, pJObj]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maedertok :: CharParser st a -> CharParser st a
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maedertok p = p << spaces
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedercTok :: Char -> CharParser st ()
2360728d4185c0c04279c999941c64d36626af79Christian MaedercTok = forget . tok . char
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedercommaTok :: CharParser st ()
00df6fd583c19393fa141d5a0e21ac74c7bf5b19Christian MaedercommaTok = cTok ','
2360728d4185c0c04279c999941c64d36626af79Christian MaederpJArr :: CharParser st Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJArr = cTok '[' >> fmap JArray (sepBy1 pJson commaTok) << cTok ']'
2360728d4185c0c04279c999941c64d36626af79Christian MaederpJObj :: CharParser st Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJObj = cTok '{' >> fmap JObject (sepBy1 pJPair commaTok) << cTok '}'
2360728d4185c0c04279c999941c64d36626af79Christian MaederpJPair :: CharParser st JPair
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederpJPair = pair (tok pStr << cTok ':') pJson
2360728d4185c0c04279c999941c64d36626af79Christian Maeder{- | convert to json with special treatment for numbers, booleans, strings
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederand other lists. -}
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedermyDataToJson :: MyData -> Json
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaedermyDataToJson md =
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder recordFieldToObject :: (String, MyData) -> (String, Json)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder recordFieldToObject (fieldName, value) =
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder (toSnakeCase fieldName, myDataToJson value)
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian Maeder Builtin typ value -> case typ of
5a448e9be8c4482a978b174b744237757335140fChristian Maeder "number" -> case readSigned readFloat value of
d96bfd1d7a4595bfff87771b91797330fa939455Christian Maeder [(n, "")] -> JNumber n
8c8545dd3bf34fbcbc16904b65d249658f8f9efcChristian Maeder _ -> JString value
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maeder "bool" | value == "True" -> JBool True
34d14197eb3dd643a8e6ef3ed8cba5629528e97fAivaras Jakubauskas | value == "False" -> JBool False
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder "string" -> JString value
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder _ -> JString value
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ListOrTuple _ mds -> JArray $ map myDataToJson mds
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder -- Special cases
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder Cons c Nothing [] | c `elem` ["Nothing", "Just", "Left", "Right"] ->
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder error ("myDataToJson: Constructor should not have appeared: " ++ show c)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder Cons _ (Just fields) mds ->
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder in JObject $ zipWith (curry recordFieldToObject) fields mds
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder -- Data types
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder Cons constructor Nothing mds -> case map myDataToJson mds of
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder [] -> JString constructor
cb2044812811d66efe038d914966e04290be93faChristian Maeder ijs -> JArray ijs
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maederclass ToJson a where
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder asJson :: a -> Json
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maederinstance Data a => ToJson a where
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder asJson = myDataToJson . normalizeMyDataForSerialization . dataToMyData