aeson-extra-0.2.2.0: test/Tests.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
module Main (main) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Data.Aeson.Extra
import qualified Data.HashMap.Lazy as H
import Data.Map (Map)
import Data.Maybe (isJust)
import Data.String (fromString)
import Data.Time (zonedTimeToUTC)
import Data.Vector (Vector)
import Test.QuickCheck.Instances ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
#if MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
import Orphans ()
main :: IO ()
main = defaultMain $ testGroup "Tests"
[ dotColonMark
, mTests
#if MIN_VERSION_base(4,7,0)
, symTests
, singObjectTests
#endif
, collapsedListTests
, utctimeTests
, zonedtimeTests
]
------------------------------------------------------------------------------
-- M
------------------------------------------------------------------------------
mTests :: TestTree
mTests = testGroup "M"
[ testCase "decode" $ let lhs = decode "{\"1\": 1, \"2\": 2}" :: Maybe (M (H.HashMap Int Int))
rhs = Just result
in lhs @?= rhs
, testProperty "decode . encode" $
let prop :: Map Int Int -> Property
prop m = let lhs = fmap getMap . decode . encode . M $ m
rhs = Just m
in lhs === rhs
in prop
]
where result = M $ H.fromList [(1,1),(2,2)]
#if MIN_VERSION_base(4,7,0)
------------------------------------------------------------------------------
-- SymTag
------------------------------------------------------------------------------
symTests :: TestTree
symTests = testGroup "SymTag"
[ testCase "encode" $ encode (SymTag :: SymTag "foobar") @?= "\"foobar\""
, testCase "decode success" $ (decode "\"foobar\"" :: Maybe (SymTag "foobar")) @?= Just SymTag
, testCase "decode failure" $ (decode "\"foobar\"" :: Maybe (SymTag "barfoo")) @?= Nothing
]
------------------------------------------------------------------------------
-- SingObject
------------------------------------------------------------------------------
-- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)
-- > Just (SingObject 42)
singObjectTests :: TestTree
singObjectTests = testGroup "SingObject"
[ testCase "decode success" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)) @?= Just (SingObject 42)
, testCase "decode failure" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "key" Int)) @?= Nothing
, testProperty "decode . encode" $
let prop :: Int -> Property
prop n = let rhs = fmap (getSingObject p) . decode . encode . mkSingObject p $ n
lhs = Just n
in lhs === rhs
p :: Proxy "value"
p = Proxy
in prop
]
#endif
------------------------------------------------------------------------------
-- parseCollapsedList
------------------------------------------------------------------------------
newtype V = V [Int] deriving (Show, Eq)
instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value"
collapsedListTests :: TestTree
collapsedListTests = testGroup "collapsedList"
[ testCase "empty" $ (decode "{}" :: Maybe V) @?= Just (V [])
, testCase "null" $ (decode "{\"value\": null}" :: Maybe V) @?= Just (V [])
, testCase "singleton" $ (decode "{\"value\": 42}" :: Maybe V) @?= Just (V [42])
, testCase "array" $ (decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V) @?= Just (V [1,2,3,4])
, testProperty "decode . encode" $
let prop :: [Int] -> Property
prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l
lhs = Just l
in lhs === rhs
in prop
, testProperty "Vector decode . encode" $
let prop :: Vector Int -> Property
prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l
lhs = Just l
in lhs === rhs
in prop
]
------------------------------------------------------------------------------
-- Comparison (.:?) and (.:!)
------------------------------------------------------------------------------
newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
dotColonMark :: TestTree
dotColonMark = testGroup "Operators" $ fmap t [
assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
, assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
, assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
, assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)
, assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
, assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
, assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)
, assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
, assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
]
where ex1 = "{}"
ex2 = "{\"value\": 42 }"
ex3 = "{\"value\": null }"
t = testCase "-"
------------------------------------------------------------------------------
-- U & Z
------------------------------------------------------------------------------
utctimeTests :: TestTree
utctimeTests = testGroup "U" $
[ testCase "base case" $ assertBool "base case" $ isJust simple
] ++ map t timeStrings
where simple = decode "\"2015-09-07T08:16:40.807Z\"" :: Maybe U
t str = testCase str
. assertEqual str simple
. decode
. fromString
$ "\"" ++ str ++ "\""
zonedtimeTests :: TestTree
zonedtimeTests = testGroup "Z" $
[ testCase "base case" $ assertBool "base case" $ isJust simple
] ++ map t timeStrings
where simple = decode "\"2015-09-07T08:16:40.807Z\"" :: Maybe Z
t str = testCase str
. assertEqual str (fmap z simple)
. fmap z
. decode
. fromString
$ "\"" ++ str ++ "\""
z (Z z') = zonedTimeToUTC z'
timeStrings :: [String]
timeStrings =
[ "2015-09-07T08:16:40.807Z"
, "2015-09-07T11:16:40.807+0300"
, "2015-09-07 08:16:40.807Z"
, "2015-09-07 08:16:40.807 Z"
, "2015-09-07 08:16:40.807 +0000"
, "2015-09-07 08:16:40.807 +00:00"
, "2015-09-07 11:16:40.807 +03:00"
, "2015-09-07 05:16:40.807 -03:00"
]