safe-json-0.1.0: test/MigrationTests.hs
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module MigrationTests where
import Control.Applicative (Const)
import Control.Exception (try)
import Control.Monad (forM)
import Data.Aeson hiding (eitherDecodeFileStrict)
import Data.Aeson as A (decodeFileStrict)
import Data.Aeson.Types (parseEither)
import Data.DList (DList)
import Data.Functor.Identity (Identity)
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.IntMap as IntMap (IntMap, fromList)
import Data.List.NonEmpty (NonEmpty)
import Data.Map as Map (Map, fromList)
import Data.Maybe (fromJust)
import Data.Monoid (Dual)
import Data.Proxy
import Data.Semigroup (First, Last, Max, Min)
import Data.Set (Set)
import Data.Sequence (Seq)
import Data.Text (Text, pack)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.UUID as UUID
import qualified Data.Vector as V
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Data.Aeson.Safe (eitherDecodeFileStrict)
import Data.SafeJSON
import Data.SafeJSON.Test
import Instances()
import Types
migrationTests :: TestTree
migrationTests = testGroup "Migrations"
[ versionedPrimRoundTrip
-- Migrating
, testSafeParse "vNil-> v1" "Couldn't parse v1 from vNil" "noversion" $ Version1 "12345"
, testSafeParse "vNil-> v2" "Couldn't parse v2 from vNil" "noversion" $ Version2 ["12345"]
, testSafeParse "v1 -> v2" "Couldn't parse v2 from v1" "version1" $ Version2 ["success"]
, testSafeParse "vNil-> v3" "Couldn't parse v3 from vNil" "noversion" $ Version3 ["12345"] False
, testSafeParse "v1 -> v3" "Couldn't parse v3 from v1" "version1" $ Version3 ["success"] False
, testSafeParse "v2 -> v3" "Couldn't parse v3 from v2" "version2" $ Version3 ["success!","or","is","it?!"] False
, testSafeParse "vNil-> v4" "Couldn't parse v4 from vNil" "noversion" $ Version4 ["12345"] Nothing
, testSafeParse "v1 -> v4" "Couldn't parse v4 from v1" "version1" $ Version4 ["success"] Nothing
, testSafeParse "v2 -> v4" "Couldn't parse v4 from v2" "version2" $ Version4 ["success!","or","is","it?!"] Nothing
, testSafeParse "v3 -> v4" "Couldn't parse v4 from v3" "version3" $ Version4 ["success!","or","is","it?!"] (Just $ posixSecondsToUTCTime 0)
-- Reverse migrating
, testSafeParse "v1 -> v0" "Couldn't parse v0 from v1" "version1" $ Version0 "success"
, testSafeParse "v2 -> v1" "Couldn't parse v1 from v2" "version2" $ Version1 "success!, or, is, it?!"
, testSafeParse "v4 -> v3" "Couldn't parse v3 from v4" "version4" $ Version3 ["success!","or","is","it?!"] True
, testSafeParse "v4-2-> v3" "Couldn't parse v3 from v4-2" "version4-2" $ Version3 ["one","two","three"] False
-- Should not migrate
, testSafeNoParse @NoVersion "v2 -> vNil" "Shouldn't parse vNil from v2" "version2" vNilError
, testSafeNoParse @NoVersion "v3 -> vNil" "Shouldn't parse vNil from v3" "version3" vNilError
, testSafeNoParse @NoVersion "v4 -> vNil" "Shouldn't parse vNil from v4" "version4" vNilError
, testSafeNoParse @NoVersion "v4-2-> vNil" "Shouldn't parse vNil from v4" "version4-2" vNilError
, testSafeNoParse @Version1 "v3 -> v1" "Shouldn't parse v1 from v3" "version3" $ noParserError "Version 3"
, testSafeNoParse @Version1 "v4 -> v1" "Shouldn't parse v1 from v4" "version4" $ noParserError "Version 4"
, testSafeNoParse @Version1 "v4-2-> v1" "Shouldn't parse v1 from v4-2" "version4-2" $ noParserError "Version 4"
, testSafeNoParse @Version2 "v4 -> v2" "Shouldn't parse v2 from v4" "version4" $ noParserError "Version 4"
, testSafeNoParse @Version2 "v4-2-> v2" "Shouldn't parse v2 from v4-2" "version4-2" $ noParserError "Version 4"
-- Other
, testSafeParse "simple versioning" "Couldn't parse simple data v1 from UUID" "simpleversion" $ SimpleVersion1 UUID.nil ""
, testSafeNoParse @BadVersion "bad simple" "Shouldn't parse from bad format" "badsimpleversion" $ EE "Error in $: malformed simple data (Version 8)"
-- Container parsing
, parseCollection @[] @Version4 "[v4]" allVersioned singleList
, parseCollection @NonEmpty @Version4 "NonEmpty v4" allVersioned singleList
, parseCollection @DList @Version4 "DList v4" allVersioned singleList
, parseCollection @V.Vector @Version4 "V.Vector v4" allVersioned singleList
, parseCollection @IntMap @Version4 "IntMap v4" allVersioned $ toJSON . IntMap.fromList . zip [1..] . fmap snd
, parseCollection @(Map Text) @Version4 "Map v4" allVersioned objectList
, parseCollection @(HashMap Text) @Version4 "HashMap v4" allVersioned objectList
, parseCollection @Set @Version4 "Set v4" allVersioned singleList
, parseCollection @HashSet @Version4 "HashSet v4" allVersioned singleList
, parseCollection @Seq @Version4 "Seq v4" allVersioned singleList
, parseCollection @Maybe @Version4 "Maybe v4" allVersioned single
, parseCollection @Identity @Version4 "Identity v4" allVersioned single
, parseCollection @(Const Version4) @Version4 "Const v4" allVersioned single
, parseCollection @First @Version4 "First v4" allVersioned single
, parseCollection @Last @Version4 "Last v4" allVersioned single
, parseCollection @Min @Version4 "Min v4" allVersioned single
, parseCollection @Max @Version4 "Max v4" allVersioned single
, parseCollection @Dual @Version4 "Dual v4" allVersioned single
, parseCollection @((,) Version4) @Version4 "(v4,v4)" allVersioned $ toJSON . mkTup2 . fmap snd
, parseCollection @((,,) Version4 Version4) @Version4 "(v4,v4,v4)" allVersioned $ toJSON . mkTup3 . fmap snd
, parseCollection @((,,,) Version4 Version4 Version4) @Version4 "(v4,v4,v4,v4)" allVersioned $ toJSON . mkTup4 . fmap snd
, parseCollection @((,,,,) Version4 Version4 Version4 Version4) @Version4 "(v4,v4,v4,v4,v4)" allVersioned $ toJSON . mkTup5 . fmap snd
, parseCollection @[] @Version3 "[v3]" allVersioned singleList
, parseCollection @[] @Version1 "[v1]" ["noversion","version1","version2"] singleList
, parseCollectionFail @[] @NoVersion "[vNil] [FAIL]" allVersioned singleList
, parseCollectionFail @[] @Version1 "[v1] [FAIL]" allVersioned singleList
, parseCollectionFail @[] @Version2 "[v2] [FAIL]" allVersioned singleList
]
singleList :: ToJSON b => [(a,b)] -> Value
singleList = toJSON . fmap snd
objectList :: (Ord a, ToJSONKey a, ToJSON b) => [(a,b)] -> Value
objectList = toJSON . Map.fromList
single :: ToJSON b => [(a,b)] -> Value
single = toJSON . snd . mkSing
mkSing :: [a] -> a
mkSing (x:_) = x
mkTup2 :: [a] -> (a,a)
mkTup3 :: [a] -> (a,a,a)
mkTup4 :: [a] -> (a,a,a,a)
mkTup5 :: [a] -> (a,a,a,a,a)
mkTup2 (x:y:_) = (x,y)
mkTup3 (x:y:z:_) = (x,y,z)
mkTup4 (x:y:z:a:_) = (x,y,z,a)
mkTup5 (x:y:z:a:b:_) = (x,y,z,a,b)
----------------------------------------------------------
-- Versioned primitive round trip
----------------------------------------------------------
versionedPrimRoundTrip :: TestTree
versionedPrimRoundTrip = testRoundTripProp @VersionedPrim "Round trip (VersionedPrim)"
newtype VersionedPrim = VersionedPrim { unVersionedPrim :: Text } deriving (Eq, Show)
instance FromJSON VersionedPrim where parseJSON = withText "VersionedPrim" $ pure . VersionedPrim
instance ToJSON VersionedPrim where toJSON = String . unVersionedPrim
instance SafeJSON VersionedPrim where version = 2
instance Arbitrary VersionedPrim where arbitrary = VersionedPrim . pack <$> arbitrary
----------------------------------------------------------
-- Migration through versions
----------------------------------------------------------
newtype ExpectedError = EE String deriving (Eq, Show)
vNilError :: ExpectedError
vNilError = EE "Error in $: key \"int\" not present"
noParserError :: String -> ExpectedError
noParserError = EE . mappend "Error in $: Cannot find parser associated with: "
jsonPath :: FilePath
jsonPath = "test/json/"
testSafeParse :: (Eq a, Show a, SafeJSON a) => String -> String -> FilePath -> a -> TestTree
testSafeParse s a fp x = testCase s $ do
eVal <- eitherDecodeFileStrict $ jsonPath ++ fp ++ ".json"
case eVal of
Left err -> assertFailure err
Right val -> assertEqual a x val
testSafeNoParse :: forall a. SafeJSON a => String -> String -> FilePath -> ExpectedError -> TestTree
testSafeNoParse s a fp (EE ee) = testCase (s ++ " [FAIL]") $ do
eVal <- eitherDecodeFileStrict $ jsonPath ++ fp ++ ".json"
case eVal :: Either String a of
Left err -> assertEqual a ee err
Right{} -> assertFailure $ fp ++ ": should not have parsed a " ++ typeName (Proxy @a)
----------------------------------------------------------
-- Migration through collections
----------------------------------------------------------
allVersioned :: [String]
allVersioned = ["noversion","version1","version2","version3","version4"]
parseCollection' :: forall f a.
( SafeJSON a
, SafeJSON (f a)
)
=> (IO () -> IO ()) -> String -> [String] -> ([(Text,Value)] -> Value) -> TestTree
parseCollection' io s files f = testCase s $ io $ do
let fp x = jsonPath ++ x ++ ".json"
addFile x mA = (,) (pack x) <$> mA
mLs <- forM files $ \file -> addFile file <$> A.decodeFileStrict (fp file)
let ls = fromJust <$> mLs :: [(Text, Value)]
eVal = parseEither safeFromJSON $ f ls :: Either String (f a)
case eVal of
Right{} -> return ()
Left err -> assertFailure $ mconcat
["Could not parse collection of different versions (", typeName (Proxy :: Proxy a), "): ", err]
parseCollection :: forall f a.
( SafeJSON a
, SafeJSON (f a)
)
=> String -> [String] -> ([(Text,Value)] -> Value) -> TestTree
parseCollection = parseCollection' @f @a id
parseCollectionFail :: forall f a.
( SafeJSON a
, SafeJSON (f a)
)
=> String -> [String] -> ([(Text,Value)] -> Value) -> TestTree
parseCollectionFail = parseCollection' @f @a go
where go :: IO () -> IO ()
go io = try io >>= \case
Left e -> return () `const` (e :: HUnitFailure)
Right{} -> assertFailure "Should have failed"