{-# Language GADTs, ScopedTypeVariables, OverloadedStrings #-}
import Data.Bond
import Data.Bond.Internal.ZigZag
import Unittest.Compat.Another.Another
import Unittest.Compat.BasicTypes
import Unittest.Compat.Compat
import Unittest.Compat.EnumType1
import Unittest.Simple.Inner as Inner
import Unittest.Simple.Outer as Outer
import Unittest.Simple.Reqopt as ReqOpt
import Unittest.Simple.Intvec

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Either hiding (left, right)
import Data.Int
import Data.Proxy
import Data.Word
import System.FilePath
import Test.Tasty
import Test.Tasty.Golden
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.Map as M
import qualified Data.Vector as V

import DataPath

main :: IO ()
main = defaultMain tests

data ProtoWrapper = forall t. BondProto t => ProtoWrapper String t FilePath
                  | forall t. BondTaggedProto t => TaggedProtoWrapper String t FilePath

fromTagged :: ProtoWrapper -> ProtoWrapper
fromTagged (TaggedProtoWrapper n t dat) = ProtoWrapper n t dat
fromTagged w = w

taggedProtocols :: [ProtoWrapper]
taggedProtocols =
    [ TaggedProtoWrapper "CompactBinary" CompactBinaryProto "compat.compact2.dat"
    , TaggedProtoWrapper "CompactBinary v1" CompactBinaryV1Proto "compat.compact.dat"
    , TaggedProtoWrapper "FastBinary" FastBinaryProto "compat.fast.dat"
    ]

simpleProtocols :: [ProtoWrapper]
simpleProtocols =
    [ ProtoWrapper "SimpleBinary" SimpleBinaryProto "compat.simple2.dat"
    , ProtoWrapper "SimpleBinary v1" SimpleBinaryV1Proto "compat.simple.dat"
    ]

jsonProtocol :: ProtoWrapper
jsonProtocol = ProtoWrapper "JSON" JsonProto "compat.json.dat"

untaggedProtocols :: [ProtoWrapper]
untaggedProtocols = jsonProtocol : simpleProtocols

allProtocols :: [ProtoWrapper]
allProtocols = untaggedProtocols ++ taggedProtocols

compatDataPath :: String
compatDataPath = "test" </> "compat" </> "data"

brokenSchemasPath :: String
brokenSchemasPath = "test" </> "broken_schemas"

tests :: TestTree
tests = testGroup "Haskell runtime tests"
    [ testGroup "Enum tests"
        [ testCase "check enum value to name conversion" checkEnumNames
        ]
    , testGroup "Runtime schema tests"
        [ testCase "check saved Compat schema matching our schema" matchCompatSchemaDef,
          testCase "check gbc-generated SchemaDef schema matching our schema" matchGeneratedSchemaDef,
          testCase "check compile/decompile schema is identity" checkCompileIdentity,
          testCase "defaultStruct is correct" checkDefaultStruct
        ]
    , testGroup "Runtime schema validation tests"
        [ testCaseInfo "loop in inheritance chain" $ checkSchemaError "inheritance_loop.json"
        , testCaseInfo "non-struct in inheritance chain" $ checkSchemaError "inherit_from_int.json"
        , testCaseInfo "index out of range" $ checkSchemaError "index_out_of_range.json"
        , testCaseInfo "field type mismatch" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)]
        , testCaseInfo "field type mismatch in field struct" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $ Struct Nothing $ M.fromList
              [ (Ordinal 20, STRUCT $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)])
              ]
        , testCaseInfo "type mismatch in list" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 40, LIST bT_BOOL [])]
        , testCaseInfo "type mismatch in list element struct" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 40, LIST bT_STRUCT
                  [ STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)]
                  ])]
        , testCaseInfo "type mismatch in set" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 50, SET bT_BOOL [])]
        , testCaseInfo "type mismatch in map key" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_BOOL bT_STRUCT [])]
        , testCaseInfo "type mismatch in map value" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_BOOL [])]
        , testCaseInfo "type mismatch in map element key" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT
                  [ (BOOL True, STRUCT $ Struct (Just $ Struct Nothing M.empty) M.empty)
                  ])]
        , testCaseInfo "type mismatch in map element value" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT
                  [ (UINT32 42, BOOL True)
                  ])]
        , testCaseInfo "type mismatch in map element field" $
            checkSchemaMismatch (Proxy :: Proxy Outer) $
                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT
                  [ (UINT32 42, STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)])
                  ])]
        , testCaseInfo "schema too deep for struct" $
            checkSchemaMismatch (Proxy :: Proxy Inner) $ Struct Nothing M.empty
        , testCase "shallow schema" checkShallowSchema
        ]
    , testGroup "Protocol tests" $
        map testTagged taggedProtocols ++
        map testSimple simpleProtocols ++
            [ testGroup "JSON"
                [ testJson "read/write original Compat value" "compat.json.dat"
                ,  testJson "read/write golden Compat value" "golden.json.dat"
--              , testJsonWithSchema "read/write original Compat value with schema" "compat.json.dat"
                , testJsonWithSchema "read/write golden Compat value with schema" "golden.json.dat"
--              , testJsonWithRuntimeSchema "read/write original Compat value with runtime schema" "compat.json.dat"
                , testJsonWithRuntimeSchema "read/write golden Compat value with runtime schema" "golden.json.dat"
                , testCase "read BasicTypes value" $
                    readAsType JsonProto (Proxy :: Proxy BasicTypes) "compat.json.dat"
                , testCase "read Another value" $
                    readAsType JsonProto (Proxy :: Proxy Another) "compat.json.dat"
                , testCaseInfo "fail to read with required field missing" jsonFailToReadMissingRequired
                , testCaseInfo "fail to write nothing to required field" $ failToWriteRequiredNothing JsonProto
                ]
            , testGroup "Marshalling"
                [ testCase "read/write SchemaDef value" readSchema
                , testCase "read/write SchemaDef value with schema" readSchemaWithSchema
                , testCase "read/write SchemaDef value w/o schema" readSchemaTagged
                ]
            , testGroup "Cross-tests" crossTests
            , testGroup "Bonded recoding" bondedRecodeTests
            ]
    , testGroup "ZigZag encoding"
        [ testProperty "Int16" zigzagInt16
        , testProperty "Int32" zigzagInt32
        , testProperty "Int64" zigzagInt64
        , testProperty "Word64" zigzagWord64
        ]
    , testProperty "VarInt" varIntTest
    ]
    where
    testTagged (TaggedProtoWrapper name proto dat) = testGroup name
        [ testCase "read/write Compat value" $ readCompat proto dat
        , testCase "read BasicTypes value" $ readAsType proto (Proxy :: Proxy BasicTypes) dat
        , testCase "read Another value" $ readAsType proto (Proxy :: Proxy Another) dat
        , testCase "read Compat w/o schema" $ readCompatTagged proto dat
        , testCase "read Compat with compile-time schema" $ readCompatWithSchema proto dat
        , testCase "read Compat with runtime schema" $ readCompatWithRuntimeSchema proto dat
        , testCaseInfo "fail to read with required field missing" $ failToReadMissingRequired proto
        , testCaseInfo "fail to read with schema and required field missing" $ failToReadMissingRequiredWithSchema proto
        , testCaseInfo "fail to write nothing to required field" $ failToWriteRequiredNothing proto
        , testCaseInfo "fail to write nothing to required field with schema" $ failToWriteRequiredNothingWithSchema proto
        , invalidTaggedWriteTests proto
        ]
    testTagged _ = error "invalid protocol"

    testSimple (ProtoWrapper name proto dat) = testGroup name
        [ testCase "read/write Compat value" $ readCompat proto dat
        , testCase "read Compat with compile-time schema" $ readCompatWithSchema proto dat
        , testCase "read Compat with runtime schema" $ readCompatWithRuntimeSchema proto dat
        , testCaseInfo "fail to save default nothing" $ failToSaveDefaultNothing proto
        ]
    testSimple _ = error "invalid protocol"

bondedRecodeTests :: [TestTree]
bondedRecodeTests = [testCase (name1 ++ " - " ++ name2) (recodeFromTo t1 t2)
                        | ProtoWrapper name1 t1 _ <- map fromTagged allProtocols
                        , ProtoWrapper name2 t2 _ <- map fromTagged allProtocols
                    ]

invalidTaggedWriteTests :: BondTaggedProto t => t -> TestTree
invalidTaggedWriteTests t = testGroup "invalid tagged write tests"
  [
    testCaseInfo "type mismatch in list" $
        testInvalidTaggedWrite t $ Struct Nothing $ M.fromList [(Ordinal 1, LIST bT_BOOL [INT16 42, BOOL True])],
    testCaseInfo "type mismatch inside list element" $
        testInvalidTaggedWrite t $ Struct Nothing
            $ M.fromList [(Ordinal 1, LIST bT_SET [SET bT_INT32 [INT32 5, UINT32 6]])],
    testCaseInfo "type mismatch in set" $
        testInvalidTaggedWrite t $ Struct Nothing
            $ M.fromList [(Ordinal 1, SET bT_STRUCT [STRUCT $ Struct Nothing M.empty, BOOL True])],
    testCaseInfo "type mismatch in map key" $
        testInvalidTaggedWrite t $ Struct Nothing
            $ M.fromList [(Ordinal 1, MAP bT_UINT32 bT_STRING [(UINT64 1, STRING "bar")])],
    testCaseInfo "type mismatch in map value" $
        testInvalidTaggedWrite t $ Struct Nothing
            $ M.fromList [(Ordinal 1, MAP bT_UINT64 bT_WSTRING [(UINT64 1, STRING "foo")])]
  ]

-- Simple protocol has different m_defaults from all others. Also some enum values differ.
-- Json differs in uint64 values.
-- See comments in https://github.com/Microsoft/bond/blob/master/cpp/test/compat/serialization.cpp
crossTests :: [TestTree]
crossTests =
    [crossTest left right
        | left <- simpleProtocols
        , right <- simpleProtocols
        , getName left < getName right
    ] ++
    [crossTest left right
        | left <- taggedProtocols
        , right <- taggedProtocols
        , getName left < getName right
    ] ++
    [crossTestTagged left right
        | left <- taggedProtocols
        , right <- taggedProtocols
        , getName left < getName right
    ]
    where
    getName (ProtoWrapper name _ _) = name
    getName (TaggedProtoWrapper name _ _) = name

    crossTest (ProtoWrapper lname lproto lfile) (ProtoWrapper rname rproto rfile)
        = testCase (lname ++ " - " ++ rname) $ assertEither $ do
            ldata <- readData (compatDataPath </> lfile)
            left <- hoistEither (bondRead lproto ldata :: Either String Compat)
            rdata <- readData (compatDataPath </> rfile)
            right <- hoistEither $ bondRead rproto rdata
            checkEqual "values do not match" left right
            lout <- hoistEither $ bondWrite lproto right
            checkEqual ("value saved with " ++ lname ++ " do not match original") ldata lout
            rout <- hoistEither $ bondWrite rproto left
            checkEqual ("value saved with " ++ rname ++ " do not match original") rdata rout
    crossTest left right  = crossTest (fromTagged left) (fromTagged right)

    crossTestTagged (TaggedProtoWrapper lname lproto lfile) (TaggedProtoWrapper rname rproto rfile)
        = testCase ("w/o schema: " ++ lname ++ " - " ++ rname) $ assertEither $ do
            ldata <- readData (compatDataPath </> lfile)
            left <- hoistEither $ bondReadTagged lproto ldata
            rdata <- readData (compatDataPath </> rfile)
            right <- hoistEither $ bondReadTagged rproto rdata
            checkEqual "values do not match" left right
            lout <- hoistEither $ bondWriteTagged lproto right
            checkEqual ("value saved with " ++ lname ++ " do not match original") ldata lout
            rout <- hoistEither $ bondWriteTagged rproto left
            checkEqual ("value saved with " ++ rname ++ " do not match original") rdata rout
    crossTestTagged _ _ = error "invalid protocols"

readCompat :: BondProto t => t -> String -> Assertion
readCompat p f = assertEither $ do
    dat <- readData (compatDataPath </> f)
    s <- hoistEither (bondRead p dat :: Either String Compat)
    d' <- hoistEither $ bondWrite p s
    checkEqual "serialized value do not match original" dat d'

readCompatTagged :: BondTaggedProto t => t -> String -> Assertion
readCompatTagged p f = assertEither $ do
    dat <- readData (compatDataPath </> f)
    s <- hoistEither $ bondReadTagged p dat
    outdat <- hoistEither $ bondWriteTagged p s
    checkEqual "serialized value do not match original" dat outdat

readCompatWithSchema :: BondProto t => t -> String -> Assertion
readCompatWithSchema p f = assertEither $ do
    dat <- readData (compatDataPath </> f)
    let schema = getSchema (Proxy :: Proxy Compat)
    s <- hoistEither $ bondReadWithSchema p schema dat
    outdat <- hoistEither $ bondWriteWithSchema p schema s
    checkEqual "serialized value do not match original" dat outdat

readCompatWithRuntimeSchema :: BondProto t => t -> String -> Assertion
readCompatWithRuntimeSchema p f = assertEither $ do
    schemadat <- readData (compatDataPath </> "compat.schema.dat")
    schemadef <- hoistEither (bondUnmarshal schemadat :: Either String SchemaDef)
    schema <- hoistEither $ parseSchema schemadef
    dat <- readData (compatDataPath </> f)
    s <- hoistEither $ bondReadWithSchema p schema dat
    outdat <- hoistEither $ bondWriteWithSchema p schema s
    checkEqual "serialized value do not match original" dat outdat

readSchema :: Assertion
readSchema = assertEither $ do
    dat <- readData (compatDataPath </> "compat.schema.dat")
    s <- hoistEither (bondUnmarshal dat :: Either String SchemaDef)
    d' <- hoistEither $ bondMarshal CompactBinaryV1Proto s
    checkEqual "serialized value do not match original" dat d'

readSchemaWithSchema :: Assertion
readSchemaWithSchema = assertEither $ do
    let schema = getSchema (Proxy :: Proxy SchemaDef)
    dat <- readData (compatDataPath </> "compat.schema.dat")
    struct <- hoistEither $ bondUnmarshalWithSchema schema dat
    out <- hoistEither $ bondMarshalWithSchema CompactBinaryV1Proto schema struct
    checkEqual "serialized value do not match original" dat out

readSchemaTagged :: Assertion
readSchemaTagged = assertEither $ do
    dat <- readData (compatDataPath </> "compat.schema.dat")
    struct <- hoistEither $ bondUnmarshalTagged dat
    let schema = getSchema (Proxy :: Proxy SchemaDef)
    checked <- hoistEither $ checkStructSchema schema struct
    out <- hoistEither $ bondMarshalTagged CompactBinaryV1Proto checked
    checkEqual "serialized value do not match original" dat out

-- compat.json.dat file has several properties making it incompatible with usual test:
-- all float values saved with extra precision
-- double values are saved in a way different from one used by scientific
-- fields are saved in declaration order, while aeson saves them in pseudorandom hash order
-- optional fields with default values are present

-- Golden file is manually checked to match compat data as best as it could

testJson :: String -> FilePath -> TestTree
testJson name f = goldenVsString name (compatDataPath </> "golden.json.dat") $ do
    dat <- BL.readFile (compatDataPath </> f)
    let parse = bondRead JsonProto dat :: Either String Compat
    case parse of
        Left msg -> assertFailure msg >> return BL.empty
        Right s -> case bondWrite JsonProto s of
            Left msg -> assertFailure msg >> return BL.empty 
            Right out -> return out

testJsonWithSchema :: String -> FilePath -> TestTree
testJsonWithSchema name f = goldenVsString name (compatDataPath </> "golden.json.dat") $
    eitherT (\ msg -> assertFailure msg >> return BL.empty) return $ do
        let schema = getSchema (Proxy :: Proxy Compat)
        dat <- readData (compatDataPath </> f)
        s <- hoistEither $ bondReadWithSchema JsonProto schema dat
        hoistEither $ bondWriteWithSchema JsonProto schema s

testJsonWithRuntimeSchema :: String -> FilePath -> TestTree
testJsonWithRuntimeSchema name f = goldenVsString name (compatDataPath </> "golden.json.dat") $
    eitherT (\ msg -> assertFailure msg >> return BL.empty) return $ do
        schemadat <- readData (compatDataPath </> "compat.schema.dat")
        schemadef <- hoistEither (bondUnmarshal schemadat :: Either String SchemaDef)
        schema <- hoistEither $ parseSchema schemadef
        dat <- readData (compatDataPath </> f)
        s <- hoistEither $ bondReadWithSchema JsonProto schema dat
        hoistEither $ bondWriteWithSchema JsonProto schema s

readAsType :: forall t a. (Show a, BondProto t, BondStruct a) => t -> Proxy a -> String -> Assertion
readAsType p _ f = assertEither $ do
    dat <- readData (compatDataPath </> f)
    void $ hoistEither (bondRead p dat :: Either String a)

matchCompatSchemaDef :: Assertion
matchCompatSchemaDef = assertEither $ do
    dat <- readData (compatDataPath </> "compat.schema.dat")
    fileSchema <- hoistEither $ bondUnmarshal dat
    let schema = getSchema (Proxy :: Proxy Compat)
    let assembledSchema = assembleSchema schema
    checkEqual "schemas do not match" fileSchema assembledSchema

-- gbc's json schemas differ slightly from bond.bond definition,
-- so tests can't compare json representations.
matchGeneratedSchemaDef :: Assertion
matchGeneratedSchemaDef = assertEither $ do
    dat <- readData (autogenPath </> "bond.SchemaDef.json")
    fileSchema <- hoistEither $ bondRead JsonProto dat
    let schema = getSchema (Proxy :: Proxy SchemaDef)
    let assembledSchema = assembleSchema schema
    checkEqual "schemas do not match" fileSchema assembledSchema

checkSchemaError :: FilePath -> IO String
checkSchemaError f = assertWithMsg $ do
    dat <- readData (brokenSchemasPath </> f)
    schema <- hoistEither $ bondRead JsonProto dat
    checkHasError $ parseSchema schema

checkSchemaMismatch :: BondStruct a => Proxy a -> Struct -> IO String
checkSchemaMismatch a s = assertWithMsg $ do
    let schema = getSchema a
    checkHasError $ checkStructSchema schema s

checkShallowSchema :: Assertion
checkShallowSchema = assertEither $ do
    let schema = getSchema (Proxy :: Proxy Outer)
    void $ hoistEither $ checkStructSchema schema $ Struct (Just $ Struct Nothing M.empty) M.empty

testInvalidTaggedWrite :: BondTaggedProto t => t -> Struct -> IO String
testInvalidTaggedWrite p s = assertWithMsg $ checkHasError $ bondWriteTagged p s

failToSaveDefaultNothing :: BondProto t => t -> IO String
failToSaveDefaultNothing p =
    let struct = Struct (Just $ Struct Nothing M.empty)
            $ M.fromList [(Ordinal 13, UINT8 0), (Ordinal 16, INT32 0)]
        schema = getSchema (Proxy :: Proxy BasicTypes)
     in assertWithMsg $ checkHasError $ bondWriteWithSchema p schema struct

failToReadMissingRequired :: BondTaggedProto t => t -> IO String
failToReadMissingRequired p = assertWithMsg $ do
    let struct = Struct Nothing M.empty
    out <- hoistEither $ bondWriteTagged p struct
    checkHasError (bondRead p out :: Either String Reqopt)

jsonFailToReadMissingRequired :: IO String
jsonFailToReadMissingRequired = assertWithMsg $ do
    let dat = BL8.pack "{}"
    checkHasError (bondRead JsonProto dat :: Either String Reqopt)

failToReadMissingRequiredWithSchema :: BondTaggedProto t => t -> IO String
failToReadMissingRequiredWithSchema p = assertWithMsg $ do
    let struct = Struct Nothing M.empty
    out <- hoistEither $ bondWriteTagged p struct
    let schema = getSchema (Proxy :: Proxy Reqopt)
    checkHasError $ bondReadWithSchema p schema out

failToWriteRequiredNothing :: BondProto t => t -> IO String
failToWriteRequiredNothing p = assertWithMsg $ do
    let struct = defaultValue :: Reqopt
    checkHasError $ bondWrite p struct

failToWriteRequiredNothingWithSchema :: BondTaggedProto t => t -> IO String
failToWriteRequiredNothingWithSchema p = assertWithMsg $ do
    let struct = Struct Nothing $ M.fromList [(Ordinal 10, INT8 5)]
    let schema = getSchema (Proxy :: Proxy Reqopt)
    checkHasError $ bondWriteWithSchema p schema struct

recodeFromTo :: forall t1 t2. (BondProto t1, BondProto t2) => t1 -> t2 -> Assertion
recodeFromTo t1 t2 = assertEither $ do
    let inner = defaultValue{ Inner.m_uint64 = 5, Inner.m_uint32 = [12, 34] } :: Inner
    bonded <- hoistEither $ marshalValue t1 inner
    let outer = defaultValue{ m_bonded_inner = bonded }
    saved <- hoistEither $ bondWrite t2 outer
    v <- hoistEither (bondRead t2 saved :: Either String Outer)
    unpacked <- hoistEither $ getValue (m_bonded_inner v)
    checkEqual "deserialized value do not match with original" inner unpacked

checkCompileIdentity :: Assertion
checkCompileIdentity = assertEither $ do
    schemadat <- readData (compatDataPath </> "compat.schema.dat")
    schemadef <- hoistEither (bondUnmarshal schemadat :: Either String SchemaDef)
    parsedSchema <- hoistEither $ parseSchema schemadef
    let assembledSchema = assembleSchema parsedSchema
    checkEqual "original and decompiled schema do not match" schemadef assembledSchema
--    reparsedSchema <- hoistEither $ parseSchema assembledSchema
--    checkEqual "original and parsed schema do not match" parsedSchema reparsedSchema

checkDefaultStruct :: Assertion
checkDefaultStruct = do
    let schema = getSchema (Proxy :: Proxy Reqopt)
    let defStruct = defaultStruct schema
    assertEqual "struct is not as expected"
        (Struct Nothing $ M.fromList [(Ordinal 10, INT8 5), (Ordinal 20, STRING "")])
        defStruct

checkEnumNames :: Assertion
checkEnumNames = do
    assertEqual "positive enum value not translated to name" (Just "EnumValue1") (toName (EnumType1 5))
    assertEqual "negative enum value not translated to name" (Just "EnumValue3") (toName (EnumType1 (-10)))
    assertEqual "unknown enum value translated to name" Nothing (toName (EnumType1 42))
    assertEqual "enum name not translated to positive value" (Just (EnumType1 5)) (fromName "EnumValue1")
    assertEqual "enum name not translated to negative value" (Just (EnumType1 (-10))) (fromName "EnumValue3")
    assertEqual "unknown enum name translated to value" Nothing (fromName "undefined" :: Maybe EnumType1)

zigzagInt16 :: Int16 -> Bool
zigzagInt16 x = x == fromZigZag (toZigZag x)

zigzagInt32 :: Int32 -> Bool
zigzagInt32 x = x == fromZigZag (toZigZag x)

zigzagInt64 :: Int64 -> Bool
zigzagInt64 x = x == fromZigZag (toZigZag x)

zigzagWord64 :: Word64 -> Bool
zigzagWord64 x = x == toZigZag (fromZigZag x :: Int64)

varIntTest :: [Word64] -> Bool
varIntTest xs = let srcStruct = defaultValue { ints = V.fromList xs }
                    Right stream = bondWrite CompactBinaryProto srcStruct
                    Right dstStruct = bondRead CompactBinaryProto stream
                    ys = V.toList $ ints dstStruct
                 in xs == ys

assertEither :: EitherT String IO () -> Assertion
assertEither = eitherT assertFailure (const $ return ())

assertWithMsg :: EitherT String IO String -> IO String
assertWithMsg = eitherT (\ msg -> assertFailure msg >> return "") (\ msg -> return $ "error caught: " ++ msg)

readData :: FilePath -> EitherT String IO BL.ByteString
readData = lift . BL.readFile

checkEqual :: (Eq a, Show a, MonadTrans t) => String -> a -> a -> t IO ()
checkEqual m a b = lift $ assertEqual m a b

checkHasError :: Either String a -> EitherT String IO String
checkHasError = bimapEitherT (const "error not found") id . swapEitherT . hoistEither