packages feed

throwable-exceptions 0.1.0.4 → 0.1.0.5

raw patch · 5 files changed

+337/−72 lines, 5 filesdep +template-haskellnew-component:exe:throwable-exception-example

Dependencies added: template-haskell

Files

README.md view
@@ -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:
+ example/Main.hs view
@@ -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 !?" ()`
src/Control/Exception/Throwable.hs view
@@ -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"
+ src/Control/Exception/Throwable/TH.hs view
@@ -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 []))+          []+        ]
throwable-exceptions.cabal view
@@ -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