mirror of
https://github.com/facebook/Haxl.git
synced 2024-12-25 01:31:31 +03:00
80 lines
1.9 KiB
Haskell
80 lines
1.9 KiB
Haskell
{-# LANGUAGE RebindableSyntax, OverloadedStrings #-}
|
|
module CoreTests where
|
|
|
|
import Haxl.Prelude
|
|
import Prelude ()
|
|
|
|
import Haxl.Core
|
|
|
|
import Test.HUnit
|
|
|
|
import Data.Aeson
|
|
import qualified Data.ByteString.Lazy.Char8 as BS
|
|
|
|
import Control.Exception (Exception(..))
|
|
|
|
useless :: String -> GenHaxl u Bool
|
|
useless _ = throw (NotFound "ha ha")
|
|
|
|
en = error "no env"
|
|
|
|
exceptions :: Assertion
|
|
exceptions =
|
|
do
|
|
a <- runHaxl en $ try (useless "input")
|
|
assertBool "NotFound -> HaxlException" $
|
|
isLeft (a :: Either HaxlException Bool)
|
|
|
|
b <- runHaxl en $ try (useless "input")
|
|
assertBool "NotFound -> Logic Error" $
|
|
isLeft (b :: Either LogicError Bool)
|
|
|
|
c <- runHaxl en $ try (useless "input")
|
|
assertBool "NotFound -> NotFound" $
|
|
isLeft (c :: Either NotFound Bool)
|
|
|
|
-- Make sure TransientError -doesn't- catch our NotFound
|
|
d <- runHaxl en $
|
|
(useless "input"
|
|
`catch` \TransientError{} -> return False)
|
|
`catch` \LogicError{} -> return True
|
|
assertBool "Transient != NotFound" d
|
|
|
|
-- test catch
|
|
e <- runHaxl en $
|
|
throw (NotFound "haha") `catch` \NotFound{} -> return True
|
|
assertBool "catch1" e
|
|
|
|
f <- runHaxl en $
|
|
throw (NotFound "haha") `catch` \LogicError{} -> return True
|
|
assertBool "catch2" f
|
|
where
|
|
isLeft Left{} = True
|
|
isLeft _ = False
|
|
|
|
-- This is mostly a compile test, to make sure all the plumbing
|
|
-- makes the compiler happy.
|
|
base :: (Exception a) => a -> IO HaxlException
|
|
base e = runHaxl en $ throw e `catch` \x -> return x
|
|
|
|
printing :: Assertion
|
|
printing = do
|
|
a <- base $ NotFound "notfound!"
|
|
print a
|
|
|
|
b <- base $ CriticalError "ohthehumanity!"
|
|
print b
|
|
|
|
c <- base $ FetchError "timeout!"
|
|
print c
|
|
|
|
BS.putStrLn $ encode a
|
|
BS.putStrLn $ encode b
|
|
BS.putStrLn $ encode c
|
|
|
|
|
|
tests = TestList
|
|
[ TestLabel "exceptions" $ TestCase exceptions,
|
|
TestLabel "print_stuff" $ TestCase printing
|
|
]
|