diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ # :diamonds: throwable-exceptions :diamonds: [![Build Status](https://travis-ci.org/aiya000/hs-throwable-exceptions.svg?branch=master)](https://travis-ci.org/aiya000/hs-throwable-exceptions) -[![Hackage](https://img.shields.io/hackage/v/lens.svg)](https://hackage.haskell.org/package/throwable-exceptions) +[![Hackage](https://img.shields.io/badge/hackage-v0.1.0.x-blue.svg)](https://hackage.haskell.org/package/throwable-exceptions) -throwable-exceptions gives the easy way to create the data types of `Exception` instance with TemplateHaskell, -and gives the simple data types of `Exception` instance with its value constructor, +`throwable-exceptions` gives an easy way to create the data types of `Exception` instance with [TemplateHaskell](https://wiki.haskell.org/Template_Haskell), +and gives simple data types of `Exception` instance with its value constructor, for your haskell project :dog: - `throwable-exceptions` is available in @@ -16,21 +16,22 @@ - [throwable-exceptions - Hackage](https://hackage.haskell.org/package/throwable-exceptions) -# :muscle: Why we should use this ? :muscle: -We want to throw some exception frequently, but the mostly throwable exceptions are not given by base. -throwable-exceptions complements it :+1: +# :muscle: Why should we use this ? :muscle: +We want to throw some exception frequently, but the mostly throwable exceptions are not given by `base`. +`throwable-exceptions` complements it :+1: ## Examples - vvv The summary of the exact examples is available here vvv - - [example/Main.hs](https://github.com/aiya000/throwable-exceptions/blob/master/example/Main.hs) + - [example/Main.hs](https://github.com/aiya000/hs-throwable-exceptions/blob/master/example/Main.hs) - - - You can create a data type of `Exception` instance by **a line** :exclamation: ```haskell +{-# LANGUAGE TemplateHaskell #-} module Main where declareException "MyException" @@ -49,7 +50,7 @@ - - - -Several exception is defined by default :smile: +Several exceptions are defined by default :smile: For example, [IOException](https://hackage.haskell.org/package/base-4.9.1.0/docs/Control-Exception.html#t:IOException)'s value constructor is not given :cry: But you can use `Control.Exception.Throwable.IOException'` instead :dog: diff --git a/src/Control/Exception/Throwable.hs b/src/Control/Exception/Throwable.hs --- a/src/Control/Exception/Throwable.hs +++ b/src/Control/Exception/Throwable.hs @@ -38,7 +38,7 @@ -- | A constructor for GeneralException but doesn't take the clue generalException :: String -> String -> GeneralException () -generalException name cause = GeneralException name cause () +generalException name cause = GeneralException name cause () declareException "IOException'" diff --git a/src/Control/Exception/Throwable/TH.hs b/src/Control/Exception/Throwable/TH.hs --- a/src/Control/Exception/Throwable/TH.hs +++ b/src/Control/Exception/Throwable/TH.hs @@ -111,7 +111,6 @@ showInstanceDec <- defineShowInstanceFor typeNames exceptionInstancDec <- defineExceptionInstanceFor typeNames fakeConstructorDec <- defineFakeConstructorFor typeNames - return [ dataDec , showInstanceDec , exceptionInstancDec @@ -161,7 +160,7 @@ -- Define an instance of a data of @ExceptionDataNames@ for @Exception@. defineExceptionInstanceFor :: ExceptionDataNames -> Q Dec - defineExceptionInstanceFor exceptionDataNames@(ExceptionDataNames {..}) = do + defineExceptionInstanceFor ExceptionDataNames {..} = do let typeableClass = mkName "Typeable" showClass = mkName "Show" exceptionClass = mkName "Exception" diff --git a/test/Control/Exception/Throwable/THTest.hs b/test/Control/Exception/Throwable/THTest.hs new file mode 100644 --- /dev/null +++ b/test/Control/Exception/Throwable/THTest.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TemplateHaskell #-} + +module Control.Exception.Throwable.THTest where + +import Control.Exception.Safe (Exception) +import Control.Monad (void) +import Data.Typeable (Typeable) +import Test.DocTest (doctest) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (testCase, Assertion) +import qualified Control.Exception.Throwable.TH as ETH + +ETH.declareException "THTestException" + +-- Indicate `e ()` is Exception instance in the compile time +type IsException e = (Show (e ()), Typeable (e ()), Exception (e ())) => e () + + +refl :: IsException a +refl = undefined + +through :: a -> Assertion +through = void . return + + +test_doctest :: [TestTree] +test_doctest = + [ testCase "can through TH.hs" $ doctest ["src/Control/Exception/Throwable/TH.hs"] + ] + +test_generated_datatype :: [TestTree] +test_generated_datatype = + [ testCase "is Exception instance" $ through (refl :: IsException THTestException) + ] diff --git a/test/Control/Exception/ThrowableTest.hs b/test/Control/Exception/ThrowableTest.hs --- a/test/Control/Exception/ThrowableTest.hs +++ b/test/Control/Exception/ThrowableTest.hs @@ -1,60 +1,12 @@ module Control.Exception.ThrowableTest where -import Control.Exception.Safe (Exception) -import Control.Exception.Safe (MonadThrow, throwM, fromException, SomeException) -import Data.Either (isLeft) import Test.Tasty (TestTree) -import Test.Tasty.HUnit (testCase, Assertion, assertBool, (@?=)) +import Test.Tasty.HUnit (testCase, (@?=)) import qualified Control.Exception.Throwable as ET --- The message is never used in tasty-hunit -assertBool' :: Bool -> Assertion -assertBool' = assertBool "" - -canBeShown :: Exception e => e -> Assertion -canBeShown = assertBool' . not . null . show - -canBeThrown :: Exception e => e -> Assertion -canBeThrown e = assertBool' . isLeft $ throwM e - - -test_io_exception_prim :: [TestTree] -test_io_exception_prim = - [ testCase "can be shown in most cases" $ - canBeShown $ ET.ioException' "honoka-chan!" -- IOException' can be shown, because IOException' is an Exception instance - , testCase "can be thrown in all case" $ - canBeThrown $ ET.ioException' "kotori-chan ga!" -- IOException' can be thrown by throwM, because IOException' is an Exception instance ! - ] - - -test_index_out_of_bounds_exception :: [TestTree] -test_index_out_of_bounds_exception = - [ testCase "finds the perpetrator with the clue" $ - program -- You can find the perpetrator of some bug if you see the message ('.. looks like bad') - ] - where - program :: IO () - program = do - case someCalculation of - Right _ -> putStrLn "the calculation is succeed" - Left e -> case fromException' e of - Nothing -> putStrLn "!? I don't know !" - Just (ET.IndexOutOfBoundsException _ clue) -> putStrLn $ show clue ++ " looks like bad" - - -- monomorphic function - fromException' :: SomeException -> Maybe (ET.IndexOutOfBoundsException ([Int], Int)) - fromException' = fromException - - at :: MonadThrow m => [Int] -> Int -> m Int - xs `at` i | length xs <= i = throwM $ ET.IndexOutOfBoundsException "mmm..?" (xs, i) - | otherwise = return $ xs !! i - - someCalculation = [10..13] `at` 4 - - -test_general_exception :: [TestTree] -test_general_exception = - [ testCase "looks like other exception when GeneralException is executed `show`" $ - show (ET.generalException "MyTest" "nico-chan") @?= "MyTestException: nico-chan" +test_GeneralException :: [TestTree] +test_GeneralException = + [ testCase "can be shown" $ + show (ET.generalException "MyTestException" "nico-nico-ni-") @?= "MyTestException: nico-nico-ni-" ] diff --git a/throwable-exceptions.cabal b/throwable-exceptions.cabal --- a/throwable-exceptions.cabal +++ b/throwable-exceptions.cabal @@ -1,5 +1,5 @@ name: throwable-exceptions -version: 0.1.0.5 +version: 0.1.0.6 synopsis: throwable-exceptions gives the easy way to throw exceptions description: throwable-exceptions gives the easy way to throw exceptions homepage: https://github.com/aiya000/hs-throwable-exceptions#README.md @@ -31,7 +31,9 @@ default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wno-unused-top-binds other-modules: Control.Exception.ThrowableTest + , Control.Exception.Throwable.THTest build-depends: base + , doctest , either , safe-exceptions , tasty