throwable-exceptions 0.1.0.7 → 0.1.0.8
raw patch · 5 files changed
+163/−134 lines, 5 filesdep +silently
Dependencies added: silently
Files
- README.md +1/−1
- example/Main.hs +0/−96
- src/Control/Exception/Throwable/TH.hs +48/−26
- test/MainTest.hs +110/−0
- throwable-exceptions.cabal +4/−11
README.md view
@@ -24,7 +24,7 @@ ## Examples - vvv The summary of the exact examples is available here vvv- - [example/Main.hs](https://github.com/aiya000/hs-throwable-exceptions/blob/master/example/Main.hs)+ - [test/MainTest.hs](https://github.com/aiya000/hs-throwable-exceptions/blob/master/test/MainTest.hs) - - -
− example/Main.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}---- | This is referenced from README.md-module Main where--import Control.Exception.Safe (throwM, MonadCatch, catch, SomeException)-import Control.Exception.Throwable (GeneralException(..), generalException, IndexOutOfBoundsException(..))-import Control.Exception.Throwable.TH (declareException)--{- !! These line is needed by declareException !! -}-import Control.Exception.Safe (Exception)-import Data.Typeable (Typeable)-{- ---------------------------------------------- -}----- This is same as------ data MyException a = MyException--- { myExceptionCause :: String--- , myExceptionClue :: a--- } deriving (Typeable)------ instance Show a => Show (MyException a) where--- ...--- instance (Typeable a, Show a) => Exception (MyException a)----declareException "MyException" ["MyException"]--- ^ the second argument (the list of String) will be made as a value constructor.---- This is same as------ data TwoException a =--- FirstException--- { firstExceptionCause :: String--- , firstExceptionClue :: a--- } |--- SecondException--- { secondExceptionCause :: String--- , secondExceptionClue :: a--- } deriving (Typeable)------ instance Show a => (TwoException a) where--- ...--- instance (Typeable a, Show a) => Exception (TwoException a)----declareException "TwoException" ["FirstException", "SecondException"]---main :: IO ()-main = do- print $ ([1..4] `at` 5 :: Either SomeException Int)- print $ MyException "hi" 10- print $ myException "poi"- -- ^ a (fake) value constructor,- -- this is same as `MyException` but without a clue value.- print (foo :: Either SomeException Int)- print $ FirstException "chino" 20- print $ firstException "cocoa"- print $ secondException "rize"------ vvv output result vvv------ Left IndexOutOfBoundsException: "index is too big"--- MyException: "hi"--- MyException: "poi"--- Left FooException: poi poi poi !?----- IndexOutOfBoundsException,--- IOException',--- IllegalArgumentException,--- and GeneralException is presented by default.-at :: (MonadCatch m, Typeable a, Show a) => [a] -> Int -> m a-at xs index = do- if index < length xs- then return $ xs !! index- else throwM $ IndexOutOfBoundsException "index is too big" (xs, index)- --else throwM $ indexOutOfBoundsException' "index is too big"- -- You can use above code without some clue----- If you don't want to use TemplateHaskell (Control.Exception.Throwable.TH),--- you can use GeneralException and generalException instead !------ data GeneralException a = GeneralException--- { exceptionName :: String -- ^ This should be named by 'PascalCase' for show, for example: "MyOperation", "Database"--- , exceptionCause :: String -- ^ The message for the cause of the exception--- , exceptionClue :: a -- ^ The clue of the exception. This can be anything of Show instance--- }--- --- generalException :: String -> String -> GeneralException ()--- generalException name cause = GeneralException name cause () ----foo :: (MonadCatch m, Typeable a, Show a) => m a-foo = throwM $ generalException "FooException" "poi poi poi !?"--- This is same as `GeneralException "FooException" "poi poi poi !?" ()`
src/Control/Exception/Throwable/TH.hs view
@@ -10,7 +10,7 @@ ) where import Data.Char (toLower, isUpper, isPunctuation, isNumber)-import Language.Haskell.TH ( Bang(..), DecsQ, newName, mkName, Dec(..), TyVarBndr(..), Con(..), Type(..), SourceUnpackedness(..), SourceStrictness(..), Q, Name, Exp(..), Lit(..), Pat(..), Clause(..), Body(..))+import Language.Haskell.TH (Bang(..), DecsQ, newName, mkName, Dec(..), TyVarBndr(..), Con(..), Type(..), SourceUnpackedness(..), SourceStrictness(..), Q, Name, Exp(..), Lit(..), Pat(..), Clause(..), Body(..)) -- | -- Mean names of a data type and its value constructors@@ -70,14 +70,28 @@ where toValueConstructorName :: ValueConstructorName -> Maybe ValueConstructor toValueConstructorName [] = Nothing- toValueConstructorName constrName@(c:onstrName) =- let constrName' = (toLower c) : onstrName -- camelCase+ toValueConstructorName constrName =+ let constrName' = pascalToCamelCase constrName in Just ValueConstructor { constructorName = constrName- , causeRecordName = constrName' ++ "Cause"- , clueRecordName = constrName' ++ "Clue"+ , causeRecordName = causeRecordName constrName'+ , clueRecordName = clueRecordName constrName' } + -- "ioException'" -> ("ioException", "'")+ splitBodyAndSigns :: String -> (String, String)+ splitBodyAndSigns = span $ not . isPunctuation + -- recordName "Cause" "ioException'" -> "ioExceptionCause'",+ -- signs is important.+ recordName :: String -> String -> String+ recordName suffix constrName' =+ let (name, signs) = splitBodyAndSigns constrName'+ in name ++ suffix ++ signs++ causeRecordName = recordName "Cause"+ clueRecordName = recordName "Clue"++ -- | A natural strategy of the evaluation noBang :: Bang noBang = Bang NoSourceUnpackedness NoSourceStrictness@@ -99,11 +113,11 @@ let dataDec = defineDatatype typeNames typeParam showInstanceDec <- defineShowInstanceFor typeNames exceptionInstancDec <- defineExceptionInstanceFor typeNames- fakeConstructorDecs <- mapM defineFakeConstructor $ constructors typeNames+ fakeconstructorDecs <- concat <$> mapM (defineFakeConstructor $ datatypeName typeNames) (constructors typeNames) return $ [ dataDec , showInstanceDec , exceptionInstancDec- ] ++ fakeConstructorDecs+ ] ++ fakeconstructorDecs where -- Define a data of an exception. -- the data is defined by @DatatypeNames@.@@ -128,15 +142,16 @@ -- Define an instance of a data of @DatatypeNames@ for @Show@. defineShowInstanceFor :: DatatypeNames -> Q Dec- defineShowInstanceFor dataTypeNames@(DatatypeNames {..}) = do+ defineShowInstanceFor datatypeNames@(DatatypeNames {..}) = do let showClass = mkName "Show" exception = mkName typeName a <- newName "a"- showFuncDec <- declareShowFunc dataTypeNames- return $ InstanceD Nothing- [AppT (ConT showClass) (VarT a)]- (AppT (ConT showClass) (AppT (ConT exception) (VarT a)))- [showFuncDec]+ showFuncDec <- declareShowFunc datatypeNames+ return $+ InstanceD Nothing [ConT showClass `AppT` VarT a]+ (ConT showClass `AppT` ParensT (ConT exception `AppT` VarT a)) [+ showFuncDec+ ] -- Make a @show@ function definition. declareShowFunc :: DatatypeNames -> Q Dec@@ -151,9 +166,9 @@ makeShowFuncClause (ValueConstructor {..}) showFunc = do let constructor = mkName constructorName cause <- newName "cause"- return $ Clause [ConP constructor [VarP cause, WildP]] -- (FooException cause _) =+ return $ Clause [ConP constructor [VarP cause, WildP]] (NormalB- (InfixE (Just . LitE . StringL $ typeName ++ ": ") (VarE $ mkName "++") (Just $ AppE (VarE showFunc) (VarE cause))) -- show ("FooException: " ++ show cause)+ (InfixE (Just . LitE . StringL $ typeName ++ ": ") (VarE $ mkName "++") (Just $ AppE (VarE showFunc) (VarE cause))) ) [] -- Define an instance of a data of @DatatypeNames@ for @Exception@.@@ -165,23 +180,30 @@ exception = mkName typeName a <- newName "a" return $ InstanceD Nothing- [ AppT (ConT typeableClass) (VarT a)- , AppT (ConT showClass) (VarT a)+ [ ConT typeableClass `AppT` VarT a+ , ConT showClass `AppT` VarT a ]- (AppT (ConT exceptionClass) (AppT (ConT exception) (VarT a)))+ (ConT exceptionClass `AppT` ParensT (ConT exception `AppT` VarT a)) [] -- Define the casual data constructor. -- Like @Control.Exception.Throwable.generalException@ without name field.- defineFakeConstructor :: ValueConstructor -> Q Dec- defineFakeConstructor ValueConstructor {..} = do- let fConstructor = mkName $ pascalToCamelCase constructorName+ --+ -- Take a name of the target value constructor, and a name of its data type.+ --+ -- Why @DecsQ@ is returned, because splicing type signature should be avoided.+ defineFakeConstructor :: String -> ValueConstructor -> DecsQ+ defineFakeConstructor typeName (ValueConstructor {..}) = do+ let datatype = mkName typeName+ fConstructor = mkName $ pascalToCamelCase constructorName constructor = mkName constructorName- a <- newName "a"- return $ FunD fConstructor [- Clause [VarP a] (NormalB $ AppE (AppE (ConE constructor) (VarE a)) (TupE []))- []- ]+ x <- newName "x"+ let sig = SigD fConstructor $ ArrowT `AppT` ConT (mkName "String") `AppT` (ConT datatype `AppT` TupleT 0)+ let impl = FunD fConstructor [+ Clause [VarP x] (NormalB $ ConE constructor `AppE` VarE x `AppE` TupE [])+ []+ ]+ return [sig, impl] -- |
+ test/MainTest.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Basic specs.+-- And this is an example code.+--+-- This should be compiled without the compile error.+module MainTest where++import Control.Exception.Safe (throwM, MonadCatch, catch, SomeException)+import Control.Exception.Throwable (GeneralException(..), generalException, IndexOutOfBoundsException(..))+import Control.Exception.Throwable.TH (declareException)++{- !! These line is needed by declareException !! -}+import Control.Exception.Safe (Exception)+import Data.Typeable (Typeable)+{- ---------------------------------------------- -}++-- For test+import System.IO.Silently (silence)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase, (@?=))+++-- This is same as+--+-- data MyException a = MyException+-- { myExceptionCause :: String+-- , myExceptionClue :: a+-- } deriving (Typeable)+--+-- instance Show a => Show (MyException a) where+-- ...+-- instance (Typeable a, Show a) => Exception (MyException a)+--+declareException "MyException" ["MyException"]+-- ^ the second argument (the list of String) will be made as a value constructor.++-- This is same as+--+-- data TwoException a =+-- FirstException+-- { firstExceptionCause :: String+-- , firstExceptionClue :: a+-- } |+-- SecondException+-- { secondExceptionCause :: String+-- , secondExceptionClue :: a+-- } deriving (Typeable)+--+-- instance Show a => (TwoException a) where+-- ...+-- instance (Typeable a, Show a) => Exception (TwoException a)+--+declareException "TwoException" ["FirstException", "SecondException"]+++-- A context of IO+main' :: IO ()+main' = do+ print $ ([1..4] `at` 5 :: Either SomeException Int)+ print $ MyException "hi" (10 :: Int)+ print $ myException "poi"+ -- ^ a (fake) value constructor,+ -- this is same as `MyException` but without a clue value.+ print (foo :: Either SomeException Int)+ print $ FirstException "chino" (20 :: Int)+ print $ firstException "cocoa"+ print $ secondException "rize"+--+-- vvv output result vvv+--+-- Left IndexOutOfBoundsException: "index is too big"+-- MyException: "hi"+-- MyException: "poi"+-- Left FooException: poi poi poi !?+++-- IndexOutOfBoundsException,+-- IOException',+-- IllegalArgumentException,+-- and GeneralException is presented by default.+at :: (MonadCatch m, Typeable a, Show a) => [a] -> Int -> m a+at xs index = do+ if index < length xs+ then return $ xs !! index+ else throwM $ IndexOutOfBoundsException "index is too big" (xs, index)+ --else throwM $ indexOutOfBoundsException' "index is too big"+ -- You can use above code without some clue+++-- If you don't want to use TemplateHaskell (Control.Exception.Throwable.TH),+-- you can use GeneralException and generalException instead !+--+-- data GeneralException a = GeneralException+-- { exceptionName :: String -- ^ This should be named by 'PascalCase' for show, for example: "MyOperation", "Database"+-- , exceptionCause :: String -- ^ The message for the cause of the exception+-- , exceptionClue :: a -- ^ The clue of the exception. This can be anything of Show instance+-- }+-- +-- generalException :: String -> String -> GeneralException ()+-- generalException name cause = GeneralException name cause () +--+foo :: (MonadCatch m, Typeable a, Show a) => m a+foo = throwM $ generalException "FooException" "poi poi poi !?"+-- This is same as `GeneralException "FooException" "poi poi poi !?" ()`+++test_this_code_should_be_compiled_without_the_compile_error :: [TestTree]+test_this_code_should_be_compiled_without_the_compile_error = [testCase "" $ silence main']
throwable-exceptions.cabal view
@@ -1,5 +1,5 @@ name: throwable-exceptions-version: 0.1.0.7+version: 0.1.0.8 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@@ -30,23 +30,16 @@ main-is: Tasty.hs default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wno-unused-top-binds- other-modules: Control.Exception.ThrowableTest+ other-modules: MainTest , Control.Exception.Throwable.THTest+ , Control.Exception.ThrowableTest build-depends: base , doctest , either , safe-exceptions+ , silently , tasty , tasty-discover , tasty-hunit , text- , throwable-exceptions--executable throwable-exception-example- hs-source-dirs: example- main-is: Main.hs- default-language: Haskell2010- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wno-name-shadowing -Wno-unused-do-bind- build-depends: base >= 4.7 && < 5- , safe-exceptions , throwable-exceptions