diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,46 +2,66 @@ [![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) -throwable-exceptions gives the exception's value constructors for your haskell project :dog: +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, +for your haskell project :dog: +- `throwable-exceptions` is available in + - [Hackage](https://hackage.haskell.org/package/throwable-exceptions) + - [stackage (nightly build)](https://www.stackage.org/nightly-2017-06-18/package/throwable-exceptions) -## Document is available in here +## :books: Document is available in here :books: + - [throwable-exceptions - Hackage](https://hackage.haskell.org/package/throwable-exceptions) -- [the simulation of the use case](https://github.com/aiya000/hs-throwable-exceptions/blob/master/test/Control/Exception/ThrowableTest.hs) # :muscle: Why we should use this ? :muscle: -The situation that we want to throw the specific exception is happened frequently, -but many general exceptions are not given by base. +We want to throw some exception frequently, but the mostly throwable exceptions are not given by base. +throwable-exceptions complements it :+1: -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. +## 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) + +- - - + +You can create a data type of `Exception` instance by **a line** :exclamation: + ```haskell -import Control.Exception.Safe (MonadThrow, throwM, IOException(..), try, Exception, SomeException) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Either (runEitherT) +module Main where -readFileOrError :: (MonadThrow m, MonadIO m) => FilePath -> m String -readFileOrError path = do - xOrErr <- liftIO . try $ readFile path - case xOrErr of - Left e -> throwM . IOException $ show (e :: SomeException) - Right a -> return a +declareException "MyException" +-- ^^^ +-- This is same to write below line yourself +-- data MyException a = MyException +-- { myExceptionCause :: String +-- , MyExceptionClue :: a -- } deriving (Show, Typeable) +-- instance (Typeable a, Show a) => Exception (MyException a) main :: IO () main = do - xOrErr <- runEitherT $ readFileOrError "Main.hs" - case xOrErr of - Left e -> putStrLn $ "oops: " ++ show (e :: SomeException) - Right a -> putStrLn a - --- Result output vv --- Data constructor not in scope: IOException :: [Char] -> e1 + print $ MyException "hi" 10 + print $ myException "poi" ``` -But you have not to define a specific exception yourself -if you use this :muscle: +- - - + +Several exception is 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: + +```haskell +module Main where + +main :: IO () +main = do + throwM $ IOException' "oops!" "in main" + throwM $ ioException' "oops!" +``` # :+1: diff --git a/example/Main.hs b/example/Main.hs new file mode 100644 --- /dev/null +++ b/example/Main.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE TemplateHaskell #-} + +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 (Show, Typeable) +-- instance (Typeable a, Show a) => Exception (MyException a) +-- +declareException "MyException" + + +main :: IO () +main = do + print $ ([1..4] `at` 5 :: Either SomeException Int) + print $ MyException "hi" 10 + print $ myException "poi" + print (foo :: Either SomeException Int) +-- +-- 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 !?" ()` 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- | -- The mostly exceptions has the field for its cause, and its clue. -- @@ -7,61 +9,21 @@ -- the clue can be omitted if you don't need it. -- (e.g. @ioException'@, @illegalArgumentException@) module Control.Exception.Throwable - ( IOException' (..) + ( GeneralException (..) + , generalException + , IOException' (..) , ioException' , IllegalArgumentException (..) , illegalArgumentException - , GeneralException (..) - , generalException , IndexOutOfBoundsException (..) , indexOutOfBoundsException ) where import Control.Exception.Safe (Exception) +import Control.Exception.Throwable.TH (declareException) import Data.Typeable (Typeable) --- | Simular to @Control.Exception.IOException@ -data IOException' a = IOException' { ioExceptionCause :: String, ioExceptionClue :: a } - | FileNotFoundException { fileNotFoundCause :: String, fileNotFoundClue :: a } - -instance Show a => Show (IOException' a) where - show (IOException' cause _) = "IOException': " ++ show cause - show (FileNotFoundException cause _) = "FileNotFoundException: " ++ show cause - -instance (Typeable a, Show a) => Exception (IOException' a) - --- | A constructor for IOException' but doesn't take the clue -ioException' :: String -> IOException' () -ioException' = flip IOException' () - - --- | Like java.lang.IllegalArgumentException -data IllegalArgumentException a = IllegalArgumentException { illegalArgumentCause :: String, illegalArgumentClue :: a } - -instance Show a => Show (IllegalArgumentException a) where - show (IllegalArgumentException cause _) = "IllegalArgumentException: " ++ show cause - -instance (Typeable a, Show a) => Exception (IllegalArgumentException a) - --- | A constructor for IllegalArgumentException but doesn't take the clue -illegalArgumentException :: String -> IllegalArgumentException () -illegalArgumentException = flip IllegalArgumentException () - - --- | Like java.lang.IndexOutOfBoundsException -data IndexOutOfBoundsException a = IndexOutOfBoundsException { indexOutOfBoundsCause :: String, indexOutOfBoundsArgumentClue :: a } - -instance Show a => Show (IndexOutOfBoundsException a) where - show (IndexOutOfBoundsException cause _) = "IndexOutOfBoundsException: " ++ show cause - -instance (Typeable a, Show a) => Exception (IndexOutOfBoundsException a) - --- | A constructor for IndexOutOfBoundsException but doesn't take the clue -indexOutOfBoundsException :: String -> IndexOutOfBoundsException () -indexOutOfBoundsException = flip IndexOutOfBoundsException () - - -- | An other of these exceptions data GeneralException a = GeneralException { exceptionName :: String -- ^ This should be named by 'PascalCase' for show, for example: "MyOperation", "Database" @@ -70,10 +32,15 @@ } instance Show a => Show (GeneralException a) where - show (GeneralException name cause _) = name ++ "Exception: " ++ cause + show (GeneralException name cause _) = name ++ ": " ++ cause instance (Typeable a, Show a) => Exception (GeneralException a) -- | A constructor for GeneralException but doesn't take the clue generalException :: String -> String -> GeneralException () generalException name cause = GeneralException name cause () + + +declareException "IOException'" +declareException "IndexOutOfBoundsException" +declareException "IllegalArgumentException" diff --git a/src/Control/Exception/Throwable/TH.hs b/src/Control/Exception/Throwable/TH.hs new file mode 100644 --- /dev/null +++ b/src/Control/Exception/Throwable/TH.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- The data types creator of exceptions in the compile type. +-- +-- It has the record of "cause" and "clue". +module Control.Exception.Throwable.TH + ( declareException + ) 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(..) + ) + +-- | +-- @ +-- data IOException' a = IOException +-- { ioExceptionCause :: String +-- , ioExceptionClue :: a +-- } +-- ==> do +-- a <- newName "a" +-- ExceptionDataNames { typeName = mkName "IOException'" +-- , causeRecordName = mkName "ioExceptionCause" +-- , clueRecordName = mkName "ioExceptionClue" +-- } +-- @ +data ExceptionDataNames = ExceptionDataNames + { typeName :: String + , causeRecordName :: String + , clueRecordName :: String + } + + +-- | +-- Convert string of 'PascalCase' to 'camelCase'. +-- If no 'PascalCase' string or multi byte string is given, undefined behavior is happended. +-- +-- >>> pascalToCamelCase "IOException" +-- "ioException" +-- >>> pascalToCamelCase "IOException'" +-- "ioException'" +-- >>> pascalToCamelCase "FOO2BarException" +-- "foO2BarException" +-- >>> pascalToCamelCase "I2SException" +-- "i2SException" +-- >>> pascalToCamelCase "Foo2BarException" +-- "foo2BarException" +-- >>> pascalToCamelCase "IndexOutOfBoundsException" +-- "indexOutOfBoundsException" +-- >>> pascalToCamelCase "IllegalArgumentException'" +-- "illegalArgumentException'" +-- >>> pascalToCamelCase "Exception1" +-- "exception1" +pascalToCamelCase :: String -> String +pascalToCamelCase pascalCase + | upperIsCont pascalCase = forUpperContCase pascalCase -- e.g. "IOException'", "FOOBarException", "FOO2BarException" + | signInMiddle pascalCase = forSignMiddleCase pascalCase -- e.g. "I2SException", "Foo2BarException" ("Exception1" is not) + | otherwise = forCasualCase pascalCase -- e.g. "IndexOutOfBoundsException", "Exception1", + where + -- Are the upper characters continuing ? + upperIsCont :: String -> Bool + upperIsCont "" = False + upperIsCont (_:a:_) = isUpper a + upperIsCont (_:_) = False + + -- Is the sign put in the middle ? + signInMiddle :: String -> Bool + signInMiddle = any isNumber . init . tail + + forUpperContCase :: String -> String + forUpperContCase pascalCase = -- IOException' + let (pascalCase', signs) = span (not . isPunctuation) pascalCase -- ("IOException", "'") + (p:ascalCase) = pascalCase' -- ('I':"OException) + p' = toLower p -- 'i' + (ascal, case_) = span isUpper ascalCase -- ("OE", "xception") + (l:acsa) = reverse ascal -- ('E':"O") + asca = map toLower $ reverse acsa -- "o" + in p':asca ++ l:case_ ++ signs -- ('i':"o") ++ ('E':xception) ++ "'" == "ioException'" ;P + + forSignMiddleCase :: String -> String + forSignMiddleCase pascal0Case = + let (pascal, _0Case) = span (not . isNumber) pascal0Case + pascal' = map toLower pascal + in pascal' ++ _0Case + + forCasualCase :: String -> String + forCasualCase pascalCase = + let (p:ascalCase) = pascalCase + p' = toLower p + in p' : ascalCase + + +-- | +-- Declare simple concrete exception datat type in the compile time. +-- +-- @exceptionName@ must be PascalCase +-- (e.g> "IOException'", "IndexOutOfBoundsException". NG> "ioException'", "indexOutOfBoundsException") . +-- +-- And @exceptionName@ should have the suffix of "Exception". +declareException :: String -> DecsQ +declareException exceptionName = do + typeParam <- newName "a" + let typeNames = getTypeNames exceptionName + dataDec = defineDatatype typeNames typeParam + showInstanceDec <- defineShowInstanceFor typeNames + exceptionInstancDec <- defineExceptionInstanceFor typeNames + fakeConstructorDec <- defineFakeConstructorFor typeNames + + return [ dataDec + , showInstanceDec + , exceptionInstancDec + , fakeConstructorDec + ] + where + -- The natural strategy of the evaluation + noBang :: Bang + noBang = Bang NoSourceUnpackedness NoSourceStrictness + + -- Create the value of @ExceptionDataNames@ by the type name. + -- That type name will be executed the instantiation for @Exception@. + getTypeNames :: String -> ExceptionDataNames + getTypeNames exceptionName = + let (e:xceptionName) = exceptionName --TODO: Guard empty pattern + camelExceptionName = (toLower e) : xceptionName + in ExceptionDataNames { typeName = exceptionName + , causeRecordName = camelExceptionName ++ "Cause" + , clueRecordName = camelExceptionName ++ "Clue" + } + + -- Define a data of an exception. + -- the data is defined by @ExceptionDataNames@. + defineDatatype :: ExceptionDataNames -> Name -> Dec + defineDatatype (ExceptionDataNames {..}) a = + let exception = mkName typeName + causeRecord = mkName causeRecordName + clueRecord = mkName clueRecordName + in DataD [] + exception [PlainTV a] Nothing + [ RecC exception [ (causeRecord, noBang, ConT $ mkName "String") + , (clueRecord, noBang, VarT a) + ] + ] [] + + -- Define an instance of a data of @ExceptionDataNames@ for @Show@. + defineShowInstanceFor :: ExceptionDataNames -> Q Dec + defineShowInstanceFor exceptionDataNames@(ExceptionDataNames {..}) = do + let showClass = mkName "Show" + exception = mkName typeName + a <- newName "a" + showImpl <- declareShowFunc exceptionDataNames + return $ InstanceD Nothing + [AppT (ConT showClass) (VarT a)] + (AppT (ConT showClass) (AppT (ConT exception) (VarT a))) + [showImpl] + + -- Define an instance of a data of @ExceptionDataNames@ for @Exception@. + defineExceptionInstanceFor :: ExceptionDataNames -> Q Dec + defineExceptionInstanceFor exceptionDataNames@(ExceptionDataNames {..}) = do + let typeableClass = mkName "Typeable" + showClass = mkName "Show" + exceptionClass = mkName "Exception" + exception = mkName typeName + a <- newName "a" + return $ InstanceD Nothing + [ AppT (ConT typeableClass) (VarT a) + , AppT (ConT showClass) (VarT a) + ] + (AppT (ConT exceptionClass) (AppT (ConT exception) (VarT a))) + [] + + -- Define @show@ function implementation for @defineShowInstanceFor@. + declareShowFunc :: ExceptionDataNames -> Q Dec + declareShowFunc ExceptionDataNames {..} = do + let exception = mkName typeName + showFunc = mkName "show" + cause <- newName "cause" + return $ FunD showFunc [ -- show + Clause [ConP exception [VarP cause, WildP]] (NormalB -- (FooException cause _) = + (InfixE (Just . LitE . StringL $ typeName ++ ": ") (VarE $ mkName "++") (Just $ AppE (VarE showFunc) (VarE cause))) -- show ("FooException: " ++ show cause) + ) [] + ] + + -- Define the casual data constructor. + -- Like @Control.Exception.Throwable.generalException@ without name field. + defineFakeConstructorFor :: ExceptionDataNames -> Q Dec + defineFakeConstructorFor ExceptionDataNames {..} = do + let fConstructor = mkName $ pascalToCamelCase exceptionName + exception = mkName typeName + a <- newName "a" + return $ FunD fConstructor [ + Clause [VarP a] (NormalB $ AppE (AppE (ConE exception) (VarE a)) (TupE [])) + [] + ] diff --git a/throwable-exceptions.cabal b/throwable-exceptions.cabal --- a/throwable-exceptions.cabal +++ b/throwable-exceptions.cabal @@ -1,7 +1,7 @@ name: throwable-exceptions -version: 0.1.0.4 -synopsis: throwable-exceptions gives the exception's value constructors -description: throwable-exceptions gives the exception's value constructors +version: 0.1.0.5 +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 license: MIT license-file: LICENSE @@ -18,8 +18,10 @@ default-language: Haskell2010 ghc-options: -Wall -Wno-name-shadowing -Wno-unused-do-bind -Wno-unused-top-binds exposed-modules: Control.Exception.Throwable + , Control.Exception.Throwable.TH build-depends: base >= 4.7 && < 5 , safe-exceptions + , template-haskell test-suite test @@ -36,4 +38,13 @@ , 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