diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0caeeda --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/.stack-work diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5c3c6f9 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright 2021 Owens Murray, LLC. + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the "Software"), +to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..4a8c5b5 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# exceptiont + +This package provides a monad transformer that implements `MonadError` +using IO exceptions. In particular, this is useful when you want your +stack to be an instance of both `MonadError` and `MonadUnliftIO`, which +you can't do with `ExceptT`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/exceptiont.cabal b/exceptiont.cabal new file mode 100644 index 0000000..2d338ac --- /dev/null +++ b/exceptiont.cabal @@ -0,0 +1,31 @@ +-- Initial exceptiont.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: exceptiont +version: 0.1.0.0 +synopsis: A monad transformer providing `MonadError` using the IO exception mechanism. +description: A monad transformer providing `MonadError` using the IO exception mechanism. +homepage: https://github.com/owensmurray/exceptiont +license: MIT +license-file: LICENSE +author: Rick Owens +maintainer: rick@owensmurray.com +copyright: 2021 Owens Murray, LLC. +-- category: +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + exposed-modules: + Control.Monad.ExceptionT + -- other-modules: + -- other-extensions: + build-depends: + base >= 4.13 && < 4.14, + mtl >= 2.2.2 && < 2.3, + transformers >= 0.5.6.2 && < 0.6, + unliftio >= 0.2.13.1 && < 0.3 + hs-source-dirs: src + default-language: Haskell2010 + diff --git a/src/Control/Monad/ExceptionT.hs b/src/Control/Monad/ExceptionT.hs new file mode 100644 index 0000000..2e12e06 --- /dev/null +++ b/src/Control/Monad/ExceptionT.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Control.Monad.ExceptionT ( + ExceptionT, + runExceptionT, +) where + + +import Control.Monad.Except (MonadError(catchError, throwError)) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Reader (MonadReader) +import Control.Monad.Trans.Class (MonadTrans, lift) +import Data.Coerce (Coercible) +import Data.Kind (Constraint) +import UnliftIO (UnliftIO(UnliftIO), Exception, MonadUnliftIO, catch, + throwIO, try) + + +{- | + A monad transformer whose `MonadError` isntances is implemented using + raw Haskell exceptions. This is particularly useful if you want + your transformer stack to be an instance of both `MonadError` and + `MonadUnliftIO`, which you can't do with `ExceptT`. +-} +newtype ExceptionT e m a = ExceptionT (m a) + deriving newtype + ( Applicative + , Functor + , Monad + , MonadIO + , MonadReader r + ) +type Repr m = forall a b. (Coercible a b) => Coercible (m a) (m b) :: Constraint +deriving newtype instance (MonadIO m, MonadUnliftIO m, Repr m) => MonadUnliftIO (ExceptionT e m) +instance MonadTrans (ExceptionT e) where + lift = ExceptionT +instance (MonadIO m, MonadUnliftIO m, Exception e, Repr m) => MonadError e (ExceptionT e m) where + throwError = throwIO + catchError = catch + + +runExceptionT + :: ( MonadUnliftIO m + , Exception e + ) + => ExceptionT e m a + -> m (Either e a) +runExceptionT (ExceptionT action) = try action + + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..93eb06c --- /dev/null +++ b/stack.yaml @@ -0,0 +1,5 @@ +flags: {} +packages: +- . +extra-deps: [] +resolver: lts-16.26