|
Packit |
9a2dfb |
{-# LANGUAGE CPP #-}
|
|
Packit |
9a2dfb |
{-# LANGUAGE DeriveGeneric #-}
|
|
Packit |
9a2dfb |
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
Packit |
9a2dfb |
{-# LANGUAGE OverloadedStrings #-}
|
|
Packit |
9a2dfb |
{-# LANGUAGE ScopedTypeVariables #-}
|
|
Packit |
9a2dfb |
{-# LANGUAGE TemplateHaskell #-}
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- For Data.Aeson.Types.camelTo
|
|
Packit |
9a2dfb |
{-# OPTIONS_GHC -fno-warn-deprecations #-}
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
#if MIN_VERSION_base(4,9,0)
|
|
Packit |
9a2dfb |
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
|
Packit |
9a2dfb |
#endif
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
module UnitTests
|
|
Packit |
9a2dfb |
(
|
|
Packit |
9a2dfb |
ioTests
|
|
Packit |
9a2dfb |
, tests
|
|
Packit |
9a2dfb |
, withEmbeddedJSONTest
|
|
Packit |
9a2dfb |
) where
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
import Prelude ()
|
|
Packit |
9a2dfb |
import Prelude.Compat
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
import Control.Monad (forM, forM_)
|
|
Packit |
9a2dfb |
import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject, withEmbeddedJSON)
|
|
Packit |
9a2dfb |
import Data.Aeson.Internal (JSONPathElement(..), formatError)
|
|
Packit |
9a2dfb |
import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)
|
|
Packit |
9a2dfb |
import Data.Aeson.Text (encodeToTextBuilder)
|
|
Packit |
9a2dfb |
import Data.Aeson.Types (Options(..), Result(Success), ToJSON(..), Value(Null), camelTo, camelTo2, defaultOptions, omitNothingFields, parse)
|
|
Packit |
9a2dfb |
import Data.Char (toUpper)
|
|
Packit |
9a2dfb |
import Data.Either.Compat (isLeft, isRight)
|
|
Packit |
9a2dfb |
import Data.Hashable (hash)
|
|
Packit |
9a2dfb |
import Data.List (sort)
|
|
Packit |
9a2dfb |
import Data.Maybe (fromMaybe)
|
|
Packit |
9a2dfb |
import Data.Sequence (Seq)
|
|
Packit |
9a2dfb |
import Data.Tagged (Tagged(..))
|
|
Packit |
9a2dfb |
import Data.Text (Text)
|
|
Packit |
9a2dfb |
import Data.Time (UTCTime)
|
|
Packit |
9a2dfb |
import Data.Time.Format (parseTime)
|
|
Packit |
9a2dfb |
import Data.Time.Locale.Compat (defaultTimeLocale)
|
|
Packit |
9a2dfb |
import GHC.Generics (Generic)
|
|
Packit |
9a2dfb |
import Instances ()
|
|
Packit |
9a2dfb |
import System.Directory (getDirectoryContents)
|
|
Packit |
9a2dfb |
import System.FilePath ((), takeExtension, takeFileName)
|
|
Packit |
9a2dfb |
import Test.Framework (Test, testGroup)
|
|
Packit |
9a2dfb |
import Test.Framework.Providers.HUnit (testCase)
|
|
Packit |
9a2dfb |
import Test.HUnit (Assertion, assertBool, assertFailure, assertEqual)
|
|
Packit |
9a2dfb |
import Text.Printf (printf)
|
|
Packit |
9a2dfb |
import UnitTests.NullaryConstructors (nullaryConstructors)
|
|
Packit |
9a2dfb |
import qualified Data.ByteString.Base16.Lazy as LBase16
|
|
Packit |
9a2dfb |
import qualified Data.ByteString.Lazy.Char8 as L
|
|
Packit |
9a2dfb |
import qualified Data.HashSet as HashSet
|
|
Packit |
9a2dfb |
import qualified Data.Text.Lazy as LT
|
|
Packit |
9a2dfb |
import qualified Data.Text.Lazy.Builder as TLB
|
|
Packit |
9a2dfb |
import qualified Data.Text.Lazy.Encoding as LT
|
|
Packit |
9a2dfb |
import qualified Data.Text.Lazy.Encoding as TLE
|
|
Packit |
9a2dfb |
import qualified ErrorMessages
|
|
Packit |
9a2dfb |
import qualified SerializationFormatSpec
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Asserts that we can use both modules at once in the test suite.
|
|
Packit |
9a2dfb |
import Data.Aeson.Parser.UnescapeFFI ()
|
|
Packit |
9a2dfb |
import Data.Aeson.Parser.UnescapePure ()
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
tests :: Test
|
|
Packit |
9a2dfb |
tests = testGroup "unit" [
|
|
Packit |
9a2dfb |
testGroup "SerializationFormatSpec" SerializationFormatSpec.tests
|
|
Packit |
9a2dfb |
, testGroup "ErrorMessages" ErrorMessages.tests
|
|
Packit |
9a2dfb |
, testGroup "camelCase" [
|
|
Packit |
9a2dfb |
testCase "camelTo" $ roundTripCamel "aName"
|
|
Packit |
9a2dfb |
, testCase "camelTo" $ roundTripCamel "another"
|
|
Packit |
9a2dfb |
, testCase "camelTo" $ roundTripCamel "someOtherName"
|
|
Packit |
9a2dfb |
, testCase "camelTo" $
|
|
Packit |
9a2dfb |
assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")
|
|
Packit |
9a2dfb |
, testCase "camelTo2" $ roundTripCamel2 "aName"
|
|
Packit |
9a2dfb |
, testCase "camelTo2" $ roundTripCamel2 "another"
|
|
Packit |
9a2dfb |
, testCase "camelTo2" $ roundTripCamel2 "someOtherName"
|
|
Packit |
9a2dfb |
, testCase "camelTo2" $
|
|
Packit |
9a2dfb |
assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
, testGroup "encoding" [
|
|
Packit |
9a2dfb |
testCase "goodProducer" goodProducer
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
, testGroup "utctime" [
|
|
Packit |
9a2dfb |
testCase "good" utcTimeGood
|
|
Packit |
9a2dfb |
, testCase "bad" utcTimeBad
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
, testGroup "formatError" [
|
|
Packit |
9a2dfb |
testCase "example 1" formatErrorExample
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
, testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
|
|
Packit |
9a2dfb |
, testGroup "JSONPath" $ fmap (testCase "-") jsonPath
|
|
Packit |
9a2dfb |
, testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
|
|
Packit |
9a2dfb |
, testGroup "Issue #351" $ fmap (testCase "-") issue351
|
|
Packit |
9a2dfb |
, testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
|
|
Packit |
9a2dfb |
, testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
|
|
Packit |
9a2dfb |
, testCase "PR #455" pr455
|
|
Packit |
9a2dfb |
, testCase "Unescape string (PR #477)" unescapeString
|
|
Packit |
9a2dfb |
, testCase "Show Options" showOptions
|
|
Packit |
9a2dfb |
, testGroup "SingleMaybeField" singleMaybeField
|
|
Packit |
9a2dfb |
, testCase "withEmbeddedJSON" withEmbeddedJSONTest
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
roundTripCamel :: String -> Assertion
|
|
Packit |
9a2dfb |
roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
roundTripCamel2 :: String -> Assertion
|
|
Packit |
9a2dfb |
roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
camelFrom :: Char -> String -> String
|
|
Packit |
9a2dfb |
camelFrom c s = let (p:ps) = split c s
|
|
Packit |
9a2dfb |
in concat $ p : map capitalize ps
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
split c' s' = map L.unpack $ L.split c' $ L.pack s'
|
|
Packit |
9a2dfb |
capitalize t = toUpper (head t) : tail t
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
data Wibble = Wibble {
|
|
Packit |
9a2dfb |
wibbleString :: String
|
|
Packit |
9a2dfb |
, wibbleInt :: Int
|
|
Packit |
9a2dfb |
} deriving (Generic, Show, Eq)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance FromJSON Wibble
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance ToJSON Wibble where
|
|
Packit |
9a2dfb |
toJSON = genericToJSON defaultOptions
|
|
Packit |
9a2dfb |
toEncoding = genericToEncoding defaultOptions
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Test that if we put a bomb in a data structure, but only demand
|
|
Packit |
9a2dfb |
-- part of it via lazy encoding, we do not unexpectedly fail.
|
|
Packit |
9a2dfb |
goodProducer :: Assertion
|
|
Packit |
9a2dfb |
goodProducer = assertEqual "partial encoding should not explode on undefined"
|
|
Packit |
9a2dfb |
'{' (L.head (encode wibble))
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
wibble = Wibble {
|
|
Packit |
9a2dfb |
wibbleString = replicate k 'a'
|
|
Packit |
9a2dfb |
, wibbleInt = 1
|
|
Packit |
9a2dfb |
}
|
|
Packit |
9a2dfb |
k | arch32bit = 4047
|
|
Packit |
9a2dfb |
| otherwise = 4030
|
|
Packit |
9a2dfb |
arch32bit = (maxBound :: Int) == 2147483647
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Test decoding various UTC time formats
|
|
Packit |
9a2dfb |
--
|
|
Packit |
9a2dfb |
-- Note: the incomplete pattern matches for UTCTimes are completely
|
|
Packit |
9a2dfb |
-- intentional. The test expects these parses to succeed. If the
|
|
Packit |
9a2dfb |
-- pattern matches fails, there's a bug in either the test or in aeson
|
|
Packit |
9a2dfb |
-- and needs to be investigated.
|
|
Packit |
9a2dfb |
utcTimeGood :: Assertion
|
|
Packit |
9a2dfb |
utcTimeGood = do
|
|
Packit |
9a2dfb |
let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
|
|
Packit |
9a2dfb |
let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
|
|
Packit |
9a2dfb |
-- 'T' between date and time is not required, can be space
|
|
Packit |
9a2dfb |
let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
|
|
Packit |
9a2dfb |
let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
|
|
Packit |
9a2dfb |
let (Just (t1 :: UTCTime)) = parseWithAeson ts1
|
|
Packit |
9a2dfb |
let (Just (t2 :: UTCTime)) = parseWithAeson ts2
|
|
Packit |
9a2dfb |
let (Just (t3 :: UTCTime)) = parseWithAeson ts3
|
|
Packit |
9a2dfb |
let (Just (t4 :: UTCTime)) = parseWithAeson ts4
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
|
|
Packit |
9a2dfb |
-- Time zones. Both +HHMM and +HH:MM are allowed for timezone
|
|
Packit |
9a2dfb |
-- offset, and MM may be omitted.
|
|
Packit |
9a2dfb |
let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
|
|
Packit |
9a2dfb |
let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
|
|
Packit |
9a2dfb |
let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
|
|
Packit |
9a2dfb |
let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
|
|
Packit |
9a2dfb |
let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
|
|
Packit |
9a2dfb |
let (Just (t5 :: UTCTime)) = parseWithAeson ts5
|
|
Packit |
9a2dfb |
let (Just (t6 :: UTCTime)) = parseWithAeson ts6
|
|
Packit |
9a2dfb |
let (Just (t7 :: UTCTime)) = parseWithAeson ts7
|
|
Packit |
9a2dfb |
let (Just (t8 :: UTCTime)) = parseWithAeson ts8
|
|
Packit |
9a2dfb |
let (Just (t9 :: UTCTime)) = parseWithAeson ts9
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
|
|
Packit |
9a2dfb |
-- ts8 wraps around to the next day in UTC
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Seconds in Time can be omitted
|
|
Packit |
9a2dfb |
let ts10 = "2015-01-03T12:13Z" :: LT.Text
|
|
Packit |
9a2dfb |
let ts11 = "2015-01-03 12:13Z" :: LT.Text
|
|
Packit |
9a2dfb |
let ts12 = "2015-01-01T12:30-02" :: LT.Text
|
|
Packit |
9a2dfb |
let (Just (t10 :: UTCTime)) = parseWithAeson ts10
|
|
Packit |
9a2dfb |
let (Just (t11 :: UTCTime)) = parseWithAeson ts11
|
|
Packit |
9a2dfb |
let (Just (t12 :: UTCTime)) = parseWithAeson ts12
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
|
|
Packit |
9a2dfb |
assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
parseWithRead :: String -> LT.Text -> UTCTime
|
|
Packit |
9a2dfb |
parseWithRead f s =
|
|
Packit |
9a2dfb |
fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s
|
|
Packit |
9a2dfb |
parseWithAeson :: LT.Text -> Maybe UTCTime
|
|
Packit |
9a2dfb |
parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Test that a few non-timezone qualified timestamp formats get
|
|
Packit |
9a2dfb |
-- rejected if decoding to UTCTime.
|
|
Packit |
9a2dfb |
utcTimeBad :: Assertion
|
|
Packit |
9a2dfb |
utcTimeBad = do
|
|
Packit |
9a2dfb |
verifyFailParse "2000-01-01T12:13:00" -- missing Zulu time not allowed (some TZ required)
|
|
Packit |
9a2dfb |
verifyFailParse "2000-01-01 12:13:00" -- missing Zulu time not allowed (some TZ required)
|
|
Packit |
9a2dfb |
verifyFailParse "2000-01-01" -- date only not OK
|
|
Packit |
9a2dfb |
verifyFailParse "2000-01-01Z" -- date only not OK
|
|
Packit |
9a2dfb |
verifyFailParse "2015-01-01T12:30:00.00+00Z" -- no Zulu if offset given
|
|
Packit |
9a2dfb |
verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
|
|
Packit |
9a2dfb |
verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
|
|
Packit |
9a2dfb |
verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
verifyFailParse (s :: LT.Text) =
|
|
Packit |
9a2dfb |
let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] in
|
|
Packit |
9a2dfb |
assertEqual "verify failure" Nothing dec
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Non identifier keys should be escaped & enclosed in brackets
|
|
Packit |
9a2dfb |
formatErrorExample :: Assertion
|
|
Packit |
9a2dfb |
formatErrorExample =
|
|
Packit |
9a2dfb |
let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
|
|
Packit |
9a2dfb |
lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
|
|
Packit |
9a2dfb |
in assertEqual "formatError example" lhs rhs
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- Comparison (.:?) and (.:!)
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
|
|
Packit |
9a2dfb |
newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
|
|
Packit |
9a2dfb |
newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
|
|
Packit |
9a2dfb |
instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
|
|
Packit |
9a2dfb |
instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
dotColonMark :: [Assertion]
|
|
Packit |
9a2dfb |
dotColonMark = [
|
|
Packit |
9a2dfb |
assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
|
|
Packit |
9a2dfb |
, assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
|
|
Packit |
9a2dfb |
, assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
, assertEqual ".:? not-present" (Just (T2 Nothing)) (decode ex1 :: Maybe T2)
|
|
Packit |
9a2dfb |
, assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
|
|
Packit |
9a2dfb |
, assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
, assertEqual ".:! not-present" (Just (T3 Nothing)) (decode ex1 :: Maybe T3)
|
|
Packit |
9a2dfb |
, assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
|
|
Packit |
9a2dfb |
, assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
where ex1 = "{}"
|
|
Packit |
9a2dfb |
ex2 = "{\"value\": 42 }"
|
|
Packit |
9a2dfb |
ex3 = "{\"value\": null }"
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- These tests check that JSONPath is tracked correctly
|
|
Packit |
9a2dfb |
-----------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
jsonPath :: [Assertion]
|
|
Packit |
9a2dfb |
jsonPath = [
|
|
Packit |
9a2dfb |
-- issue #356
|
|
Packit |
9a2dfb |
assertEqual "Either"
|
|
Packit |
9a2dfb |
(Left "Error in $[1].Left[1]: expected Bool, encountered Number")
|
|
Packit |
9a2dfb |
(eitherDecode "[1,{\"Left\":[2,3]}]"
|
|
Packit |
9a2dfb |
:: Either String (Int, Either (Int, Bool) ()))
|
|
Packit |
9a2dfb |
-- issue #358
|
|
Packit |
9a2dfb |
, assertEqual "Seq a"
|
|
Packit |
9a2dfb |
(Left "Error in $[2]: expected Int, encountered Boolean")
|
|
Packit |
9a2dfb |
(eitherDecode "[0,1,true]" :: Either String (Seq Int))
|
|
Packit |
9a2dfb |
, assertEqual "Wibble"
|
|
Packit |
9a2dfb |
(Left "Error in $.wibbleInt: expected Int, encountered Boolean")
|
|
Packit |
9a2dfb |
(eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"
|
|
Packit |
9a2dfb |
:: Either String Wibble)
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- Check that the hashes of two equal Value are the same
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
hashableLaws :: [Assertion]
|
|
Packit |
9a2dfb |
hashableLaws = [
|
|
Packit |
9a2dfb |
assertEqual "Hashable Object" (hash a) (hash b)
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
a = object ["223" .= False, "807882556" .= True]
|
|
Packit |
9a2dfb |
b = object ["807882556" .= True, "223" .= False]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- ToJSONKey
|
|
Packit |
9a2dfb |
-------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
newtype MyText = MyText Text
|
|
Packit |
9a2dfb |
deriving (FromJSONKey)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
newtype MyText' = MyText' Text
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance FromJSONKey MyText' where
|
|
Packit |
9a2dfb |
fromJSONKey = fmap MyText' fromJSONKey
|
|
Packit |
9a2dfb |
fromJSONKeyList = error "not used"
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
fromJSONKeyAssertions :: [Assertion]
|
|
Packit |
9a2dfb |
fromJSONKeyAssertions =
|
|
Packit |
9a2dfb |
[ assertIsCoerce "Text" (fromJSONKey :: FromJSONKeyFunction Text)
|
|
Packit |
9a2dfb |
, assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
|
|
Packit |
9a2dfb |
, assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
#if __GLASGOW_HASKELL__ >= 710
|
|
Packit |
9a2dfb |
, assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
|
|
Packit |
9a2dfb |
#endif
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
assertIsCoerce _ (FromJSONKeyCoerce _) = pure ()
|
|
Packit |
9a2dfb |
assertIsCoerce n _ = assertFailure n
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
#if __GLASGOW_HASKELL__ >= 710
|
|
Packit |
9a2dfb |
assertIsCoerce' _ (FromJSONKeyCoerce _) = pure ()
|
|
Packit |
9a2dfb |
assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ())
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- | Pick the first when RULES are enabled, e.g. optimisations are on
|
|
Packit |
9a2dfb |
pickWithRules
|
|
Packit |
9a2dfb |
:: a -- ^ Pick this when RULES are on
|
|
Packit |
9a2dfb |
-> a -- ^ use this otherwise
|
|
Packit |
9a2dfb |
-> a
|
|
Packit |
9a2dfb |
pickWithRules _ = id
|
|
Packit |
9a2dfb |
{-# NOINLINE pickWithRules #-}
|
|
Packit |
9a2dfb |
{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}
|
|
Packit |
9a2dfb |
#endif
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- Regressions
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- A regression test for: https://github.com/bos/aeson/issues/351
|
|
Packit |
9a2dfb |
overlappingRegression :: FromJSON a => L.ByteString -> [a]
|
|
Packit |
9a2dfb |
overlappingRegression bs = fromMaybe [] $ decode bs
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
issue351 :: [Assertion]
|
|
Packit |
9a2dfb |
issue351 = [
|
|
Packit |
9a2dfb |
assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
|
|
Packit |
9a2dfb |
, assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
|
|
Packit |
9a2dfb |
, assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
-- Comparison between bytestring and text encoders
|
|
Packit |
9a2dfb |
------------------------------------------------------------------------------
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
ioTests :: IO [Test]
|
|
Packit |
9a2dfb |
ioTests = do
|
|
Packit |
9a2dfb |
enc <- encoderComparisonTests
|
|
Packit |
9a2dfb |
js <- jsonTestSuite
|
|
Packit |
9a2dfb |
return [enc, js]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
encoderComparisonTests :: IO Test
|
|
Packit |
9a2dfb |
encoderComparisonTests = do
|
|
Packit |
9a2dfb |
encoderTests <- forM testFiles $ \file0 -> do
|
|
Packit |
9a2dfb |
let file = "benchmarks/json-data/" ++ file0
|
|
Packit |
9a2dfb |
return $ testCase file $ do
|
|
Packit |
9a2dfb |
inp <- L.readFile file
|
|
Packit |
9a2dfb |
case eitherDecode inp of
|
|
Packit |
9a2dfb |
Left err -> assertFailure $ "Decoding failure: " ++ err
|
|
Packit |
9a2dfb |
Right val -> assertEqual "" (encode val) (encodeViaText val)
|
|
Packit |
9a2dfb |
return $ testGroup "encoders" encoderTests
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
encodeViaText :: Value -> L.ByteString
|
|
Packit |
9a2dfb |
encodeViaText =
|
|
Packit |
9a2dfb |
TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
testFiles =
|
|
Packit |
9a2dfb |
[ "example.json"
|
|
Packit |
9a2dfb |
, "integers.json"
|
|
Packit |
9a2dfb |
, "jp100.json"
|
|
Packit |
9a2dfb |
, "numbers.json"
|
|
Packit |
9a2dfb |
, "twitter10.json"
|
|
Packit |
9a2dfb |
, "twitter20.json"
|
|
Packit |
9a2dfb |
, "geometry.json"
|
|
Packit |
9a2dfb |
, "jp10.json"
|
|
Packit |
9a2dfb |
, "jp50.json"
|
|
Packit |
9a2dfb |
, "twitter1.json"
|
|
Packit |
9a2dfb |
, "twitter100.json"
|
|
Packit |
9a2dfb |
, "twitter50.json"
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- A regression test for: https://github.com/bos/aeson/issues/293
|
|
Packit |
9a2dfb |
data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
|
|
Packit |
9a2dfb |
deriving Generic
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance ToJSON MyRecord2
|
|
Packit |
9a2dfb |
instance FromJSON MyRecord2
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- A regression test for: https://github.com/bos/aeson/pull/477
|
|
Packit |
9a2dfb |
unescapeString :: Assertion
|
|
Packit |
9a2dfb |
unescapeString = do
|
|
Packit |
9a2dfb |
assertEqual "Basic escaping"
|
|
Packit |
9a2dfb |
(Right ("\" / \\ \b \f \n \r \t" :: String))
|
|
Packit |
9a2dfb |
(eitherDecode "\"\\\" \\/ \\\\ \\b \\f \\n \\r \\t\"")
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
forM_ [minBound .. maxBound :: Char] $ \ c ->
|
|
Packit |
9a2dfb |
let s = LT.pack [c] in
|
|
Packit |
9a2dfb |
assertEqual (printf "UTF-16 encoded '\\x%X'" c)
|
|
Packit |
9a2dfb |
(Right s) (eitherDecode $ utf16Char s)
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
utf16Char = formatString . LBase16.encode . LT.encodeUtf16BE
|
|
Packit |
9a2dfb |
formatString s
|
|
Packit |
9a2dfb |
| L.length s == 4 = L.concat ["\"\\u", s, "\""]
|
|
Packit |
9a2dfb |
| L.length s == 8 =
|
|
Packit |
9a2dfb |
L.concat ["\"\\u", L.take 4 s, "\\u", L.drop 4 s, "\""]
|
|
Packit |
9a2dfb |
| otherwise = error "unescapeString: can't happen"
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- JSONTestSuite
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
jsonTestSuiteTest :: FilePath -> Test
|
|
Packit |
9a2dfb |
jsonTestSuiteTest path = testCase fileName $ do
|
|
Packit |
9a2dfb |
payload <- L.readFile path
|
|
Packit |
9a2dfb |
let result = eitherDecode payload :: Either String Value
|
|
Packit |
9a2dfb |
assertBool fileName $ case take 2 fileName of
|
|
Packit |
9a2dfb |
"i_" -> isRight result
|
|
Packit |
9a2dfb |
"n_" -> isLeft result
|
|
Packit |
9a2dfb |
"y_" -> isRight result
|
|
Packit |
9a2dfb |
_ -> isRight result -- test_transform tests have inconsistent names
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
fileName = takeFileName path
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- Build a collection of tests based on the current contents of the
|
|
Packit |
9a2dfb |
-- JSONTestSuite test directories.
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
jsonTestSuite :: IO Test
|
|
Packit |
9a2dfb |
jsonTestSuite = do
|
|
Packit |
9a2dfb |
let suitePath = "tests/JSONTestSuite"
|
|
Packit |
9a2dfb |
let suites = ["test_parsing", "test_transform"]
|
|
Packit |
9a2dfb |
testPaths <- fmap (sort . concat) . forM suites $ \suite -> do
|
|
Packit |
9a2dfb |
let dir = suitePath suite
|
|
Packit |
9a2dfb |
entries <- getDirectoryContents dir
|
|
Packit |
9a2dfb |
let ok name = takeExtension name == ".json" &&
|
|
Packit |
9a2dfb |
not (name `HashSet.member` blacklist)
|
|
Packit |
9a2dfb |
return . map (dir ) . filter ok $ entries
|
|
Packit |
9a2dfb |
return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- The set expected-to-be-failing JSONTestSuite tests.
|
|
Packit |
9a2dfb |
-- Not all of these failures are genuine bugs.
|
|
Packit |
9a2dfb |
-- Of those that are bugs, not all are worth fixing.
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
blacklist :: HashSet.HashSet String
|
|
Packit |
9a2dfb |
-- blacklist = HashSet.empty
|
|
Packit |
9a2dfb |
blacklist = _blacklist
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
_blacklist :: HashSet.HashSet String
|
|
Packit |
9a2dfb |
_blacklist = HashSet.fromList [
|
|
Packit |
9a2dfb |
"i_object_key_lone_2nd_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_1st_surrogate_but_2nd_missing.json"
|
|
Packit |
9a2dfb |
, "i_string_1st_valid_surrogate_2nd_invalid.json"
|
|
Packit |
9a2dfb |
, "i_string_UTF-16LE_with_BOM.json"
|
|
Packit |
9a2dfb |
, "i_string_UTF-16_invalid_lonely_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_UTF-16_invalid_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_UTF-8_invalid_sequence.json"
|
|
Packit |
9a2dfb |
, "i_string_incomplete_surrogate_and_escape_valid.json"
|
|
Packit |
9a2dfb |
, "i_string_incomplete_surrogate_pair.json"
|
|
Packit |
9a2dfb |
, "i_string_incomplete_surrogates_escape_valid.json"
|
|
Packit |
9a2dfb |
, "i_string_invalid_lonely_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_invalid_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_inverted_surrogates_U+1D11E.json"
|
|
Packit |
9a2dfb |
, "i_string_lone_second_surrogate.json"
|
|
Packit |
9a2dfb |
, "i_string_not_in_unicode_range.json"
|
|
Packit |
9a2dfb |
, "i_string_truncated-utf-8.json"
|
|
Packit |
9a2dfb |
, "i_structure_UTF-8_BOM_empty_object.json"
|
|
Packit |
9a2dfb |
, "n_string_unescaped_crtl_char.json"
|
|
Packit |
9a2dfb |
, "n_string_unescaped_newline.json"
|
|
Packit |
9a2dfb |
, "n_string_unescaped_tab.json"
|
|
Packit |
9a2dfb |
, "string_1_escaped_invalid_codepoint.json"
|
|
Packit |
9a2dfb |
, "string_1_invalid_codepoint.json"
|
|
Packit |
9a2dfb |
, "string_1_invalid_codepoints.json"
|
|
Packit |
9a2dfb |
, "string_2_escaped_invalid_codepoints.json"
|
|
Packit |
9a2dfb |
, "string_2_invalid_codepoints.json"
|
|
Packit |
9a2dfb |
, "string_3_escaped_invalid_codepoints.json"
|
|
Packit |
9a2dfb |
, "string_3_invalid_codepoints.json"
|
|
Packit |
9a2dfb |
, "y_string_utf16BE_no_BOM.json"
|
|
Packit |
9a2dfb |
, "y_string_utf16LE_no_BOM.json"
|
|
Packit |
9a2dfb |
]
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
-- A regression test for: https://github.com/bos/aeson/pull/455
|
|
Packit |
9a2dfb |
data Foo a = FooNil | FooCons (Foo Int)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
pr455 :: Assertion
|
|
Packit |
9a2dfb |
pr455 = assertEqual "FooCons FooNil"
|
|
Packit |
9a2dfb |
(toJSON foo) (liftToJSON undefined undefined foo)
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
foo :: Foo Int
|
|
Packit |
9a2dfb |
foo = FooCons FooNil
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
showOptions :: Assertion
|
|
Packit |
9a2dfb |
showOptions =
|
|
Packit |
9a2dfb |
assertEqual
|
|
Packit |
9a2dfb |
"Show Options"
|
|
Packit |
9a2dfb |
( "Options {"
|
|
Packit |
9a2dfb |
++ "fieldLabelModifier =~ \"exampleField\""
|
|
Packit |
9a2dfb |
++ ", constructorTagModifier =~ \"ExampleConstructor\""
|
|
Packit |
9a2dfb |
++ ", allNullaryToStringTag = True"
|
|
Packit |
9a2dfb |
++ ", omitNothingFields = False"
|
|
Packit |
9a2dfb |
++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
|
|
Packit |
9a2dfb |
++ ", unwrapUnaryRecords = False"
|
|
Packit |
9a2dfb |
++ ", tagSingleConstructors = False"
|
|
Packit |
9a2dfb |
++ "}")
|
|
Packit |
9a2dfb |
(show defaultOptions)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
newtype SingleMaybeField = SingleMaybeField { smf :: Maybe Int }
|
|
Packit |
9a2dfb |
deriving (Eq, Show, Generic)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
singleMaybeField :: [Test]
|
|
Packit |
9a2dfb |
singleMaybeField = do
|
|
Packit |
9a2dfb |
(gName, gToJSON, gToEncoding, gFromJSON) <-
|
|
Packit |
9a2dfb |
[ ("generic", genericToJSON opts, genericToEncoding opts, parse (genericParseJSON opts))
|
|
Packit |
9a2dfb |
, ("th", toJSON, toEncoding, fromJSON) ]
|
|
Packit |
9a2dfb |
return $
|
|
Packit |
9a2dfb |
testCase gName $ do
|
|
Packit |
9a2dfb |
assertEqual "toJSON" Null (gToJSON v)
|
|
Packit |
9a2dfb |
assertEqual "toEncoding" (toEncoding (gToJSON v)) (gToEncoding v)
|
|
Packit |
9a2dfb |
assertEqual "fromJSON" (Success v) (gFromJSON Null)
|
|
Packit |
9a2dfb |
where
|
|
Packit |
9a2dfb |
v = SingleMaybeField Nothing
|
|
Packit |
9a2dfb |
opts = defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True}
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
newtype EmbeddedJSONTest = EmbeddedJSONTest Int
|
|
Packit |
9a2dfb |
deriving (Eq, Show)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
instance FromJSON EmbeddedJSONTest where
|
|
Packit |
9a2dfb |
parseJSON =
|
|
Packit |
9a2dfb |
withObject "Object" $ \o ->
|
|
Packit |
9a2dfb |
EmbeddedJSONTest <$> (o .: "prop" >>= withEmbeddedJSON "Quoted Int" parseJSON)
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
withEmbeddedJSONTest :: Assertion
|
|
Packit |
9a2dfb |
withEmbeddedJSONTest =
|
|
Packit |
9a2dfb |
assertEqual "Unquote embedded JSON" (Right $ EmbeddedJSONTest 1) (eitherDecode "{\"prop\":\"1\"}")
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
deriveToJSON defaultOptions ''Foo
|
|
Packit |
9a2dfb |
deriveToJSON1 defaultOptions ''Foo
|
|
Packit |
9a2dfb |
|
|
Packit |
9a2dfb |
deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField
|