{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
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 qualified Data.Aeson as Aeson
import Data.Aeson ((.=))
import Test.HUnit
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
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
import Data.Monoid
#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