module Test.Serial (runAesonSerializationTest
, runBinarySerializationTest
, runCerealSerializationTest
, TestError (..) ) where
import qualified Data.Aeson as A
import qualified Data.Binary as B
import qualified Data.Serialize as C
import qualified Data.ByteString as BStrict
import qualified Data.ByteString.Lazy as BLazy
import GHC.Generics
import Data.String.Here.Interpolated (i)
import System.IO (withFile, IOMode(..),hIsEOF)
data TestError = NoFileFound |
AesonError String |
BinaryError String |
CerealError String
deriving (Generic,Read,Show,Eq,Ord)
instance A.ToJSON TestError where
newtype MockAesonInference a = MockAesonInference a
deriving (Generic)
instance A.ToJSON a => A.ToJSON (MockAesonInference a) where
makeMockAesonInference :: (A.ToJSON a, A.FromJSON a ) => a -> MockAesonInference a
makeMockAesonInference testVal = MockAesonInference testVal
runAesonSerializationTest :: (A.ToJSON a, A.FromJSON a) => a -> FilePath -> IO (Either TestError a)
runAesonSerializationTest dataUnderTest file = withFile file ReadWriteMode createAesonSerializeTest
where
createAesonSerializeTest h = do
aNewFile <- hIsEOF h
if aNewFile
then writeOutputAndExit h
else createAesonSerializeTest' h
createAesonSerializeTest' h = do
aesonByteString <- BLazy.hGetContents h
case A.eitherDecode aesonByteString of
(Left s) -> return . Left . AesonError $ s
(Right a)
|(A.toJSON . makeMockAesonInference $ a) == (A.toJSON.makeMockAesonInference $ dataUnderTest)
-> return . Right $ a
|otherwise -> return . Left . AesonError . explainError (A.toJSON . makeMockAesonInference $ a) $ (A.toJSON . makeMockAesonInference $ dataUnderTest)
writeOutputAndExit h = do
putStrLn "file not found, writing given serialization to disk, rerun tests"
BLazy.hPut h $ A.encode dataUnderTest
return . Left $ NoFileFound
explainError old new = [i|
JSON doesn't match:
old: ${old}
new: ${new}
|]
newtype MockBinaryInference a = MockBinaryInference a
deriving (Generic)
instance B.Binary a => B.Binary (MockBinaryInference a) where
makeMockBinaryInference :: (B.Binary a) => a -> MockBinaryInference a
makeMockBinaryInference testVal = MockBinaryInference testVal
runBinarySerializationTest :: (B.Binary a) => a -> FilePath -> IO (Either TestError a)
runBinarySerializationTest dataUnderTest file = withFile file ReadWriteMode createBinarySerializeTest
where
createBinarySerializeTest h = do
aNewFile <- hIsEOF h
if aNewFile
then writeOutputAndExit h
else createBinarySerializeTest' h
createBinarySerializeTest' h = do
binaryByteString <- BLazy.hGetContents h
case B.decodeOrFail binaryByteString of
(Left s) -> return . Left . BinaryError . show $ s
(Right (_,_,a) )
|(B.encode . makeMockBinaryInference $ a) == (B.encode.makeMockBinaryInference $ dataUnderTest)
-> return . Right $ a
|otherwise -> return . Left . BinaryError $ "Serializations do not match"
writeOutputAndExit h = do
putStrLn "file not found, writing given serialization to disk, rerun tests"
BLazy.hPut h $ B.encode dataUnderTest
return . Left $ NoFileFound
newtype MockCerealInference a = MockCerealInference a
deriving (Generic)
instance C.Serialize a => C.Serialize (MockCerealInference a) where
makeMockCerealInference :: (C.Serialize a) => a -> MockCerealInference a
makeMockCerealInference testVal = MockCerealInference testVal
runCerealSerializationTest :: (C.Serialize a) => a -> FilePath -> IO (Either TestError a)
runCerealSerializationTest dataUnderTest file = withFile file ReadWriteMode createCerealSerializeTest
where
createCerealSerializeTest h = do
aNewFile <- hIsEOF h
if aNewFile
then writeOutputAndExit h
else createCerealSerializeTest' h
createCerealSerializeTest' h = do
cerealByteString <- BStrict.hGetContents h
case C.decode cerealByteString of
(Left s) -> return . Left . CerealError $ s
(Right a)
|(C.encode . makeMockCerealInference $ a) == (C.encode.makeMockCerealInference $ dataUnderTest)
-> return . Right $ a
|otherwise -> return . Left . CerealError $ "Serializations do not match"
writeOutputAndExit h = do
putStrLn "file not found, writing given serialization to disk, rerun tests"
BStrict.hPut h $ C.encode dataUnderTest
return . Left $ NoFileFound