unjson-0.15.0.0: test/Test.hs
{-# LANGUAGE CPP #-}
module Main where
import qualified Data.Text as Text
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Int
import Data.Typeable
import Data.Unjson
import Control.Applicative
import qualified Data.Aeson as Aeson
import Data.Aeson ((.=))
import Control.Exception
import Test.HUnit
import Data.Monoid
import Data.List
import Data.Data
import Data.Functor.Invariant
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashMap.Lazy as LazyHashMap
import qualified Data.Map as Map
import System.Exit (ExitCode (..), exitWith)
#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif
default (Text.Text, String, Int, Double)
-- As an example we will use a hypothetical configuration data.
-- There are some mandatory fields and some optional fields.
data Konfig =
Konfig { konfigHostname :: Text.Text
, konfigPort :: Integer
, konfigCredentials :: Credentials
, konfigComment :: Maybe Text.Text
, konfigOptions :: [Text.Text]
, konfigAlternates :: Maybe (Text.Text,Credentials)
, konfigInt32 :: Int32
}
deriving (Eq,Ord,Show,Typeable)
data Credentials =
Credentials { credentialsUsername :: Text.Text
, credentialsPassword :: Text.Text
, credentialsDomain :: Maybe Text.Text
}
deriving (Eq,Ord,Show,Typeable)
unjsonKonfig :: UnjsonDef Konfig
unjsonKonfig = objectOf $ pure Konfig
<*> field "hostname"
konfigHostname
"The hostname this service is visible as"
<*> fieldDef "port" 80
konfigPort
"Port to listen on, defaults to 80"
<*> fieldBy "credentials"
konfigCredentials
"User admin credentials"
unjsonCredentials
<*> fieldOpt "comment"
konfigComment
"Optional comment, free text"
<*> fieldDef "options" []
konfigOptions
"Additional options, defaults to empty"
<*> fieldOpt "alternates"
konfigAlternates
"Alternate names for this server"
<*> field "int32"
konfigInt32
"A bounded integer fieldd."
unjsonCredentials :: UnjsonDef Credentials
unjsonCredentials = objectOf $ pure Credentials
<*> field "username"
credentialsUsername
"Name of the user"
<*> field "password"
credentialsPassword
"Password for the user"
<*> fieldOpt "domain"
credentialsDomain
"Domain for user credentials"
instance Unjson Credentials where
unjsonDef = unjsonCredentials
test_proper_parse :: Test
test_proper_parse = "Proper parsing of a complex structure" ~: do
let json = Aeson.object
[ "hostname" .= "www.example.com"
, "comment" .= "nice server"
, "credentials" .= Aeson.object
[ "username" .= "usr1"
, "password" .= "pass1"
]
, "int32" .= 42
]
let expect = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 80
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" Nothing
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 42
}
let Result val iss = parse unjsonKonfig json
assertEqual "There are no issues in parsing" [] iss
assertEqual "Value parsed is the one expected" expect val
return ()
test_missing_key :: Test
test_missing_key = "Key missing" ~: do
-- Note:
--
-- This test is strange with respect to what is returned as
-- exceptions. We would expect to have whole path to problematic
-- place returned, for some reason only last part of the path is
-- returned. This is good enough to keep this mechanism in place but
-- overall it is unknown why not everything is returned.
--
-- Underlying mechanism is supposed to use mapException inside of
-- mapException and that should stack them on top concatenating the
-- path. Tests with external setup prove this is really the case,
-- but for some reason does not happen in general scenario.
--
-- *Data.Unjson> resultPrependKey "a" (resultPrependKey "b" (fail "d" :: Result ()))
-- Result *** Exception: a.b: "d"
--
let json1 = Aeson.object
[ "hostname" .= "www.example.com"
, "port" .= 12345
, "comment" .= "nice server"
, "credentials" .= Aeson.object
[ "username" .= "usr1"
]
, "int32" .= 999
]
let json = Aeson.object
[ "payload" .= json1
]
let unjsonEnvelope :: UnjsonDef Konfig
unjsonEnvelope = objectOf $ pure id
<*> fieldBy "payload"
id
"Enveloped Konfig"
unjsonKonfig
do
let Result val iss = parse unjsonEnvelope json
assertEqual "There is one issue in parsing" [Anchored (Path [ PathElemKey "payload"
, PathElemKey "credentials"
, PathElemKey "password"
]) "missing key"] iss
do
let Result val iss = parse unjsonKonfig json1
assertEqual "There is one issue in parsing" [Anchored (Path [ PathElemKey "credentials"
, PathElemKey "password"
]) "missing key"] iss
test_wrong_value_type :: Test
test_wrong_value_type = "Value at key is wrong type" ~: do
let json = Aeson.object
[ "hostname" .= 12345
, "port" .= Aeson.object
[ "username" .= "usr1"
]
, "credentials" .= "www.example.com"
, "int32" .= 999
]
let Result val iss = parse unjsonKonfig json
assertEqual "Number of issues in parsing" 3 (length iss)
assertEqual "Hostname must be string error info is present"
(Anchored (Path [ PathElemKey "hostname"
]) "expected Text, encountered Number") (iss!!0)
assertEqual "Port must be number error info is present"
(Anchored (Path [ PathElemKey "port"
]) "expected Integer, encountered Object") (iss!!1)
assertEqual "Credentials must be object error info is present"
(Anchored (Path [ PathElemKey "credentials"
]) "Error in $: expected HashMap ~Text v, encountered String") (iss!!2)
return ()
test_tuple_parsing :: Test
test_tuple_parsing = "Tuple parsing" ~: do
let json = Aeson.toJSON
[ ("hostname" :: Aeson.Value)
, ("port" :: Aeson.Value)
, (Aeson.toJSON 123)
]
let Result (val1 :: String, val2 :: Text.Text, val3 ::Integer) iss = parse unjsonDef json
assertEqual "Number of issues in parsing" [] iss
assertEqual "First element of tuple" "hostname" val1
assertEqual "Second element of tuple" "port" val2
assertEqual "Third element of tuple" 123 val3
let Result (_ :: (String, Text.Text, Int, Int)) iss = parse unjsonDef json
assertEqual "Issue in parsing" [Anchored mempty "cannot parse array of length 3 into tuple of size 4"
,Anchored (Path [PathElemIndex 3]) "missing key"] iss
let Result (_ :: (Integer, Integer, Text.Text)) iss = parse unjsonDef json
assertEqual "Issues in parsing"
[ Anchored (Path [PathElemIndex 0]) "expected Integer, encountered String"
, Anchored (Path [PathElemIndex 1]) "expected Integer, encountered String"
, Anchored (Path [PathElemIndex 2]) "expected Text, encountered Number"
] iss
let Result (_ :: (String, Text.Text)) iss = parse unjsonDef json
assertEqual "Array too long for 2-tuple" [Anchored mempty "cannot parse array of length 3 into tuple of size 2"] iss
return ()
test_symmetry_of_serialization :: Test
test_symmetry_of_serialization = "Key missing" ~: do
let expect = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 12345
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" Nothing
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 42
}
let json = unjsonToJSON unjsonKonfig expect
let Result val iss = parse unjsonKonfig json
assertEqual "Serialize-parse produces no problems" expect val
assertEqual "Serialize-parse is identity" expect val
return ()
test_pretty_serialization :: Test
test_pretty_serialization = "Pretty serialization" ~: do
let konfig = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 12345
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" Nothing
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 42
}
let jsonstr = BSL.unpack $ unjsonToByteStringLazy' (Options { nulls = False, indent = 4, pretty = True }) unjsonKonfig konfig
let expect = intercalate "\n"
[ "{"
, " \"hostname\": \"www.example.com\","
, " \"port\": 12345,"
, " \"credentials\": {"
, " \"username\": \"usr1\","
, " \"password\": \"pass1\""
, " },"
, " \"comment\": \"nice server\","
, " \"options\": [],"
, " \"int32\": 42"
, "}"
]
assertEqual "Serialize pretty prints proper indents" expect jsonstr
let jsonstr5 = BSL.unpack $ unjsonToByteStringLazy' (Options { nulls = False, indent = 5, pretty = True }) unjsonKonfig konfig
let expect5 = intercalate "\n"
[ "{"
, " \"hostname\": \"www.example.com\","
, " \"port\": 12345,"
, " \"credentials\": {"
, " \"username\": \"usr1\","
, " \"password\": \"pass1\""
, " },"
, " \"comment\": \"nice server\","
, " \"options\": [],"
, " \"int32\": 42"
, "}"
]
assertEqual "Serialize pretty prints proper indents" expect5 jsonstr5
let jsonstr3 = BSL.unpack $ unjsonToByteStringLazy' (Options { nulls = False, indent = 3, pretty = False }) unjsonKonfig konfig
let expect3 = concat
[ "{"
, "\"hostname\":\"www.example.com\","
, "\"port\":12345,"
, "\"credentials\":{"
, "\"username\":\"usr1\","
, "\"password\":\"pass1\""
, "},"
, "\"comment\":\"nice server\","
, "\"options\":[],"
, "\"int32\":42"
, "}"
]
assertEqual "Serialize pretty prints proper indents" expect3 jsonstr3
return ()
test_serialize_with_nulls :: Test
test_serialize_with_nulls = "Serialize with nulls" ~: do
let konfig = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 12345
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" Nothing
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 42
}
let jsonstr = BSL.unpack $ unjsonToByteStringLazy' (Options { nulls = True, indent = 4, pretty = True }) unjsonKonfig konfig
let expect = intercalate "\n"
[ "{"
, " \"hostname\": \"www.example.com\","
, " \"port\": 12345,"
, " \"credentials\": {"
, " \"username\": \"usr1\","
, " \"password\": \"pass1\","
, " \"domain\": null"
, " },"
, " \"comment\": \"nice server\","
, " \"options\": [],"
, " \"alternates\": null,"
, " \"int32\": 42"
, "}"
]
assertEqual "Serialize pretty prints proper indents" expect jsonstr
unjsonButThirteen :: UnjsonDef Int
unjsonButThirteen = objectOf $ pure id
<*> fieldBy "value" id "Integer but god forbid 13" (unjsonInvmapR whenParse id $ unjsonDef)
where
whenParse 13 = fail "13 is a bad luck number"
whenParse x = return x
test_semantic_errors_on_values :: Test
test_semantic_errors_on_values = "test_semantic_errors_on_values" ~: do
do
let json = Aeson.object
[ "value" .= (13 :: Int)
]
let Result _val iss = parse unjsonButThirteen json
assertEqual "Problem is reported" [Anchored (Path [PathElemKey "value"]) "13 is a bad luck number"] iss
-- assertEqual "Just numerical_value present" (13) val
unjsonEitherIntText :: UnjsonDef (Either Int Text.Text)
unjsonEitherIntText = disjointUnionOf "mode"
[ ("number", unjsonIsConstrByName "Left",
pure Left
<*> field "numerical_value"
fromLeft
"Numerical value")
, ("text", unjsonIsConstrByName "Right",
pure Right
<*> field "text_value"
fromRight
"Text value")]
where fromLeft ~(Left x) = x
fromRight ~(Right x) = x
test_parse_either_field :: Test
test_parse_either_field = "test_parse_either_field" ~: do
do
let json = Aeson.object
[ "mode" .= "number"
, "numerical_value" .= 12345
]
let Result val iss = parse unjsonEitherIntText json
assertEqual "No problems" [] iss
assertEqual "Just numerical_value present" (Left 12345) val
do
let json = Aeson.object
[ "mode" .= "text"
, "text_value" .= "asfsdfaf"
]
let Result val iss = parse unjsonEitherIntText json
assertEqual "No problems" [] iss
assertEqual "Just text_value present" (Right "asfsdfaf") val
do
let json = Aeson.object
[ "text_value" .= False
, "numerical_value" .= 12345
]
let Result val iss = parse unjsonEitherIntText json
assertEqual "Problem when mode is missing" [Anchored (Path [PathElemKey "mode"]) "missing key"] iss
do
let json = Aeson.object
[ "mode" .= "something else"
]
let Result val iss = parse unjsonEitherIntText json
assertEqual "Problem when mode is missing" [Anchored (Path [PathElemKey "mode"]) "value 'something else' is not one of the allowed for enumeration [number,text]"] iss
do
let json = Aeson.object
[ "mode" .= "number"
, "numerical_value" .= 123
]
let ex = Left 123
let js = unjsonToJSON unjsonEitherIntText ex
assertEqual "Serialized makes what expected" json js
do
let docstr = render unjsonEitherIntText
assertBool "Documentation generates" (length docstr > 0)
return ()
data AB = A | B
deriving (Show, Eq, Ord)
unjsonEnumAB :: UnjsonDef AB
unjsonEnumAB = enumOf "mode"
[ ("A", A)
, ("B", B)]
test_enum_field :: Test
test_enum_field = "test_enum_field" ~: do
do
let json = Aeson.object
[ "mode" .= "A"
]
let Result val iss = parse unjsonEnumAB json
assertEqual "No problems" [] iss
assertEqual "Proper value present" A val
do
let json = Aeson.object
[ "mode" .= "B"
]
let Result val iss = parse unjsonEnumAB json
assertEqual "No problems" [] iss
assertEqual "Proper value present" B val
do
let json = Aeson.object
[ "mode" .= "wrong"
]
let Result val iss = parse unjsonEnumAB json
assertEqual "No problems" [Anchored (Path [PathElemKey "mode"]) "value 'wrong' is not one of the allowed for enumeration [A,B]"] iss
data AutoAB = AutoA | AutoB
deriving (Show, Eq, Ord, Enum, Bounded, Data, Typeable)
unjsonAutoEnumAB :: UnjsonDef AutoAB
unjsonAutoEnumAB = enumUnjsonDef
test_auto_enum_field :: Test
test_auto_enum_field = "test_auto_enum_field" ~: do
do
let json = Aeson.object
[ "AutoAB" .= "AutoA"
]
let Result val iss = parse unjsonAutoEnumAB json
assertEqual "No problems" [] iss
assertEqual "Proper value present" AutoA val
do
let json = Aeson.object
[ "AutoAB" .= "AutoB"
]
let Result val iss = parse unjsonAutoEnumAB json
assertEqual "No problems" [] iss
assertEqual "Proper value present" AutoB val
do
let json = Aeson.object
[ "AutoAB" .= "wrong"
]
let Result val iss = parse unjsonAutoEnumAB json
assertEqual "No problems" [Anchored (Path [PathElemKey "AutoAB"]) "value 'wrong' is not one of the allowed for enumeration [AutoA,AutoB]"] iss
test_update_from_serialization :: Test
test_update_from_serialization = "test_update_from_serialization" ~: do
let initial = Konfig
{ konfigHostname = "old-www.server.com"
, konfigPort = 12345
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" Nothing
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 42
}
let expect = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 999
, konfigComment = Just "a better server"
, konfigCredentials = Credentials "usr2" "pass1" (Just "domain")
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 256
}
let json = Aeson.object
[ "hostname" .= "www.example.com" -- mandatory field
, "port" .= 999 -- optional with default
, "comment" .= "a better server" -- optional field
, "credentials" .= Aeson.object
[ "domain" .= "domain"
, "username" .= "usr2" ]
, "int32" .= 256
]
let Result val iss = update initial unjsonKonfig json
assertEqual "No problems" [] iss
assertEqual "Object updated with json" expect val
return ()
test_update_from_serialization_with_reset_to_default :: Test
test_update_from_serialization_with_reset_to_default = "test_update_from_serialization_with_reset_to_default" ~: do
let initial = Konfig
{ konfigHostname = "old-www.server.com"
, konfigPort = 12345
, konfigComment = Just "nice server"
, konfigCredentials = Credentials "usr1" "pass1" (Just "domain")
, konfigAlternates = Nothing
, konfigOptions = []
, konfigInt32 = 0
}
let expect = Konfig
{ konfigHostname = "www.example.com"
, konfigPort = 80
, konfigComment = Nothing
, konfigCredentials = Credentials "usr1" "pass1" (Nothing)
, konfigAlternates = Just ("abc", Credentials "usrx" "passx" Nothing)
, konfigOptions = []
, konfigInt32 = 256
}
let json = Aeson.object
[ "hostname" .= Aeson.Null -- mandatory field
, "port" .= Aeson.Null -- optional with default
, "comment" .= Aeson.Null -- optional field
, "credentials" .= Aeson.object
[ "domain" .= Aeson.Null ]
, "alternates" .= [ Aeson.toJSON "abc"
, Aeson.object
[ "username" .= "usrx"
, "password" .= "passx"
]
]
]
let Result _ iss = update initial unjsonKonfig json
assertEqual "Cannot reset mandatory field without default"
[Anchored (Path [PathElemKey "hostname"]) "expected Text, encountered Null"] iss
return ()
test_array_modes :: Test
test_array_modes = "test_array_modes" ~: do
let json = Aeson.object
[ "hostname" .= ("www.example.com" ::Text.Text)
]
let json1 = Aeson.object
[ "hostname" .= ["www.example.com" ::Text.Text]
]
let p0 :: UnjsonDef [Text.Text]
p0 = objectOf $ pure id
<*> fieldBy "hostname" id
"Single value or array"
(arrayOf unjsonDef)
let p1 :: UnjsonDef [Text.Text]
p1 = objectOf $ pure id
<*> fieldBy "hostname" id
"Single value or array"
(arrayWithModeOf ArrayModeParseSingle unjsonAeson)
let p2 :: UnjsonDef [Text.Text]
p2 = objectOf $ pure id
<*> fieldBy "hostname" id
"Single value or array"
(arrayWithModeOf ArrayModeParseAndOutputSingle unjsonDef)
let Result val0 iss0 = parse p0 json
assertEqual "Does not parse value in strict array mode"
[Anchored (Path [PathElemKey "hostname"])
"Error in $: expected Vector a, encountered String"] iss0
let Result val1 iss1 = parse p1 json
assertEqual "No problems" [] iss1
assertEqual "Accepts singel value in ArrayModeParseSingle" ["www.example.com"] val1
let sjson1 = unjsonToJSON p1 val1
assertEqual "Same json" json1 sjson1
let Result val2 iss2 = parse p2 json
assertEqual "No problems" [] iss2
assertEqual "Array fetch produced result" ["www.example.com"] val2
let sjson2 = unjsonToJSON p2 val2
assertEqual "Same json" json sjson2
return ()
test_array_update_by_primary_key :: Test
test_array_update_by_primary_key = "test_array_update_by_primary_key" ~: do
let json = Aeson.object
[ "array" .= [ Aeson.object
[ "id" .= 12
, "value" .= "for 12"
]
, Aeson.object
[ "id" .= 17
, "value" .= "for 17"
]
, Aeson.object
[ "id" .= 3
, "value" .= "for 3"
]
, Aeson.object
[ "id" .= 17
, "value" .= "wrong value for 17"
]
]
]
let json1 = Aeson.object
[ "array" .= [ Aeson.object -- 17 is first now, value left intact
[ "id" .= 17
]
, Aeson.object -- 3 is not there, but 4 is new
[ "id" .= 4
, "value" .= "for 4"
]
, Aeson.object
[ "id" .= 12 -- 12 got new value
, "value" .= "for 12 new value"
]
]
]
let unjsonPair = objectOf $ pure (,)
<*> field "id"
fst
"Unique id"
<*> field "value"
snd
"Value"
let pk1 = fst
pk2 = objectOf $ field "id" id "Unique id"
let p0 :: UnjsonDef [(Int,Text.Text)]
p0 = objectOf $ pure id
<*> fieldBy "array"
id
"Array updated by primary key"
(arrayWithPrimaryKeyOf pk1 pk2 unjsonPair)
let Result val0 iss0 = parse p0 json
assertEqual "No problems" [] iss0
assertEqual "Parsing keeps proper order" [(12,"for 12"),(17,"for 17"),(3,"for 3"),(17,"wrong value for 17")] val0
let Result val1 iss1 = update val0 p0 json1
assertEqual "No problems" [] iss1
assertEqual "Update keeps proper order" [(17,"for 17"),(4,"for 4"),(12,"for 12 new value")] val1
return ()
test_maps :: Test
test_maps = "test_maps" ~: do
let json = Aeson.object
[ "k1" .= (12 :: Int)
, "k2" .= (1122 :: Int)
, "a4" .= (666 :: Int)
]
jsonEmbedded = Aeson.object
[ "a_map" .= json ]
let unjsonMapByInstance :: (Unjson a, Typeable a) => UnjsonDef a
unjsonMapByInstance = objectOf $ pure id
<*> field "a_map"
id
"The only map"
let unjsonMapByExplicit :: (Unjson a, Typeable a) => UnjsonDef (HashMap.HashMap Text.Text a)
unjsonMapByExplicit = objectOf $ pure id
<*> fieldBy "a_map"
id
"The only map"
(mapOf unjsonDef)
let Result val0 iss0 = parse unjsonMapByInstance jsonEmbedded
assertEqual "No problems" [] iss0
assertEqual "Parsing keeps proper order in Data.Map" (Map.fromList [("k1"::String, 12::Int),("k2", 1122), ("a4", 666)]) val0
let Result val1 iss1 = parse unjsonMapByInstance jsonEmbedded
assertEqual "No problems" [] iss1
assertEqual "Parsing keeps proper order" (HashMap.fromList [("k1"::String, 12::Int),("k2", 1122), ("a4", 666)]) val1
let Result val2 iss2 = parse unjsonMapByExplicit jsonEmbedded
assertEqual "No problems" [] iss2
assertEqual "Parsing keeps proper order" (LazyHashMap.fromList [("k1"::Text.Text, 12::Int),("k2", 1122), ("a4", 666)]) val2
return ()
data PlainUnion
= PlainUnionA
{ plainUnionKey1 :: String
, plainUnionKey2 :: Maybe Int
}
| PlainUnionB
{ plainUnionKey3 :: Int
, plainUnionKey4 :: Int
}
deriving (Eq, Show, Typeable, Data)
unjsonPlainUnion :: UnjsonDef PlainUnion
unjsonPlainUnion = unionOf
[ (unjsonIsConstrByName "PlainUnionA",
pure PlainUnionA
<*> field "key1" plainUnionKey1 ""
<*> fieldOpt "key2" plainUnionKey2 "")
, (unjsonIsConstrByName "PlainUnionB",
pure PlainUnionB
<*> field "key3" plainUnionKey3 ""
<*> fieldDef "key4" 123 plainUnionKey4 "")
]
test_plain_unions :: Test
test_plain_unions = "test_maps" ~: do
-- simplest case
let json1 = Aeson.object
[ "key1" .= ("abc" :: String)
]
let Result val1 iss1 = parse unjsonPlainUnion json1
assertEqual "No problems" [] iss1
assertEqual "Got expected value" (PlainUnionA "abc" Nothing) val1
-- anyway choose first object on list, because 'key1' is present
let json2 = Aeson.object
[ "key1" .= ("abc" :: String)
, "key3" .= ("abc" :: String)
, "key4" .= ("abc" :: String)
]
let Result val2 iss2 = parse unjsonPlainUnion json2
assertEqual "No problems" [] iss2
assertEqual "Got expected value" (PlainUnionA "abc" Nothing) val2
-- key is present so PlainUnionA will be chosen and then fail
-- because of wrong types
let json3 = Aeson.object
[ "key1" .= (123 :: Int)
]
let Result val3 iss3 = parse unjsonPlainUnion json3
assertEqual "Cannot parse PlainUnionA" [Anchored (Path [PathElemKey "key1"]) "expected String, encountered Number"] iss3
-- choose PlainUnionB
let json4 = Aeson.object
[ "xx" .= (123 :: Int)
, "key3" .= (15523 :: Int)
, "key4" .= (13 :: Int)
]
let Result val4 iss4 = parse unjsonPlainUnion json4
assertEqual "No issues" [] iss4
assertEqual "Got expected value" (PlainUnionB 15523 13) val4
return ()
data ROTest = ROTest
{ roTestF1 :: Int
, roTestF2 :: String
}
deriving (Eq,Ord,Show)
unjsonROTest :: UnjsonDef ROTest
unjsonROTest = objectOf $
pure (\f2 -> ROTest 444 f2)
<*> field "f2" roTestF2 "f2 is a normal field"
<* fieldReadonly "f1" roTestF1 "f1 is readonly field"
test_readonly_fields :: Test
test_readonly_fields = "test_readonly_fields" ~: do
-- simplest case
let json1 = Aeson.object
[ "f2" .= ("abc" :: String)
, "f1" .= (123 :: Int)
]
let Result val1 iss1 = parse unjsonROTest json1
assertEqual "No problems" [] iss1
assertEqual "Got expected value" (ROTest 444 "abc") val1
let json2 = Aeson.object
[ "f2" .= ("abc" :: String)
]
let Result val2 iss2 = parse unjsonROTest json2
assertEqual "No problems" [] iss2
assertEqual "Got expected value" (ROTest 444 "abc") val2
let json3 = Aeson.object
[ "f2x" .= ("abc" :: String)
, "f1" .= ("should not be inspected" :: String)
]
let Result _val3 iss3 = parse unjsonROTest json3
assertEqual "There are problems" [Anchored (Path [ PathElemKey "f2"
]) "missing key"] iss3
return ()
tests :: Test
tests = test [ test_proper_parse
, test_missing_key
, test_wrong_value_type
, test_tuple_parsing
, test_symmetry_of_serialization
, test_serialize_with_nulls
, test_parse_either_field
, test_enum_field
, test_update_from_serialization
, test_update_from_serialization_with_reset_to_default
, test_array_modes
, test_array_update_by_primary_key
, test_pretty_serialization
, test_semantic_errors_on_values
, test_maps
, test_plain_unions
, test_readonly_fields
]
main :: IO Counts
main = do results <- runTestTT tests
if (errors results + failures results == 0)
then exitWith ExitSuccess
else exitWith (ExitFailure 1)
updateExampleRendering :: IO ()
updateExampleRendering = do
contents <- readFile "src/Data/Unjson.hs"
let (before,exampleAndRest) = break (=="-- Example rendering:") (lines contents)
(example,after) = break ("render ::" `isPrefixOf`) exampleAndRest
_ <- return $! length after
writeFile "src/Data/Unjson.hs"
(unlines (before ++ ["-- Example rendering:", "--"] ++
(map ((++)"-- > ") $ lines $ filterOutAnsi $ render unjsonKonfig) ++
after))
filterOutAnsi :: String -> String
filterOutAnsi "" = ""
filterOutAnsi ('\ESC' : '[' : rest) = filterOutAnsiTillEndOfMulticharSequence rest
filterOutAnsi ('\ESC' : _ : rest) = filterOutAnsi rest
filterOutAnsi (c : rest) = c : filterOutAnsi rest
filterOutAnsiTillEndOfMulticharSequence :: String -> String
filterOutAnsiTillEndOfMulticharSequence (c : rest) | c >= '@' = filterOutAnsi rest
filterOutAnsiTillEndOfMulticharSequence (c : rest) =
filterOutAnsiTillEndOfMulticharSequence rest
filterOutAnsiTillEndOfMulticharSequence [] = []
data Example = Example
{ exampleName :: Text.Text,
exampleArray :: [Int],
exampleOptional :: Maybe Bool,
exampleIntAsString :: Int }
unjsonExample :: UnjsonDef Example
unjsonExample = objectOf $ pure Example
<*> field "name"
exampleName
"Name used for example"
<*> fieldDefBy "array_of_ints" []
exampleArray
"Array of integers, optional, defaults to empty list"
(arrayOf unjsonDef)
<*> fieldOpt "optional_bool"
exampleOptional
"Optional boolean"
<*> fieldBy "int_as_string"
exampleIntAsString
"Integer value serialized as a string value in json"
(invmap (read :: String -> Int) (show :: Int -> String) unjsonDef)
newtype Theme = Theme { unTheme :: Int }
unjsonTheme :: UnjsonDef Theme
unjsonTheme = invmap (Theme . read :: String -> Theme) (show . unTheme :: Theme -> String) unjsonDef
instance Unjson Theme where
unjsonDef = unjsonTheme