diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +# 0.1 +* Initial commit diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Ryan Scott + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ryan Scott nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# `mtl-compat` +Orphan [`mtl`](http://hackage.haskell.org/package/mtl) instances for `ExceptT` from [`transformers-compat`](http://hackage.haskell.org/package/transformers-compat) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/mtl-compat.cabal b/mtl-compat.cabal new file mode 100644 --- /dev/null +++ b/mtl-compat.cabal @@ -0,0 +1,58 @@ +name: mtl-compat +version: 0.1 +synopsis: Orphan mtl instances for ExceptT from transformers-compat +description: This package backports the "Control.Monad.Except" module (if + using @mtl-2.2.0.1@ or earlier) and monad class instances for + @ExceptT@ from @transformers-compat@ (if using @mtl-2.1.3.1@ + or earlier). + . + Note that unlike how @mtl-2.2@ or later works, the + "Control.Monad.Except" module defined in this package exports + all of @ExceptT@'s monad class instances. Therefore, you may + have to declare @import Control.Monad.Except ()@ at the top of + your file to get all of the @ExceptT@ instances in scope. +homepage: https://github.com/RyanGlScott/mtl-compat +bug-reports: https://github.com/RyanGlScott/mtl-compat/issues +stability: Provisional +license: BSD3 +license-file: LICENSE +author: Ryan Scott +maintainer: Ryan Scott +copyright: (C) 2015 Ryan Scott +category: Compatibility +build-type: Simple +extra-source-files: CHANGELOG.md, README.md +cabal-version: >=1.8 + +source-repository head + type: git + location: git://github.com/RyanGlScott/mtl-compat.git + +flag two-point-one + default: False + manual: True + description: Use @mtl-2.1.3.1@ or earlier with @transformers-compat@. + +flag two-point-two + default: False + manual: True + description: Use mtl-2.2.0.1. + +library + build-depends: base >= 4.3 && < 5 + + if flag(two-point-one) || flag(two-point-two) + exposed-modules: Control.Monad.Except + hs-source-dirs: src + + if flag(two-point-one) + build-depends: mtl >= 2.0.1 && < 2.2 + , transformers-compat >= 0.3 && < 0.4 + else + if flag(two-point-two) + build-depends: mtl >= 2.2.0.1 && < 2.2.1 + , transformers >= 0.4.1 && < 0.5 + else + build-depends: mtl >= 2.2.1 && < 2.3 + + ghc-options: -Wall diff --git a/src/Control/Monad/Except.hs b/src/Control/Monad/Except.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Except.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE CPP #-} +#if !(MIN_VERSION_mtl(2,2,0)) +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +#endif +{- | +Module : Control.Monad.Error +Copyright : (c) Michael Weber 2001, + (c) Jeff Newbern 2003-2006, + (c) Andriy Palamarchuk 2006 +License : BSD-style (see the file LICENSE) + +Maintainer : libraries@haskell.org +Stability : experimental +Portability : non-portable (multi-parameter type classes) + +[Computation type:] Computations which may fail or throw exceptions. + +[Binding strategy:] Failure records information about the cause\/location +of the failure. Failure values bypass the bound function, +other values are used as inputs to the bound function. + +[Useful for:] Building computations from sequences of functions that may fail +or using exception handling to structure error handling. + +[Example type:] @'Data.Either' String a@ + +The Error monad (also called the Exception monad). +-} + +{- + Rendered by Michael Weber , + inspired by the Haskell Monad Template Library from + Andy Gill () +-} +module Control.Monad.Except + ( + -- * Monads with error handling + MonadError(..), + -- * The ErrorT monad transformer + ExceptT(ExceptT), + Except, + + runExceptT, + mapExceptT, + withExceptT, + runExcept, + mapExcept, + withExcept, + + module Control.Monad, + module Control.Monad.Fix, + module Control.Monad.Trans, + -- * Example 1: Custom Error Data Type + -- $customErrorExample + + -- * Example 2: Using ExceptT Monad Transformer + -- $ExceptTExample + ) where + +import Control.Monad.Error.Class +import Control.Monad.Trans +import Control.Monad.Trans.Except + ( ExceptT(ExceptT), Except + , runExcept, runExceptT + , mapExcept, mapExceptT + , withExcept, withExceptT + ) + +import Control.Monad +import Control.Monad.Fix + +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 +import Control.Monad.Instances () +#endif + +#if MIN_VERSION_mtl(2,2,0) +import Control.Monad.Cont.Class () +import Control.Monad.RWS.Class () +import Control.Monad.Reader.Class () +import Control.Monad.State.Class () +import Control.Monad.Writer.Class () +#else +import Control.Monad.Cont.Class (MonadCont(..)) +import Control.Monad.Reader.Class (MonadReader(..)) +import Control.Monad.RWS.Class (MonadRWS) +import Control.Monad.State.Class (MonadState(..)) +import Control.Monad.Writer.Class (MonadWriter(..)) +import Control.Monad.Trans.Except + ( liftCallCC, throwE, catchE, liftListen, liftPass ) + +instance MonadCont m => MonadCont (ExceptT e m) where + callCC = liftCallCC callCC + +instance Monad m => MonadError e (ExceptT e m) where + throwError = throwE + catchError = catchE + +instance MonadRWS r w s m => MonadRWS r w s (ExceptT e m) + +instance MonadReader r m => MonadReader r (ExceptT e m) where + ask = lift ask + local = mapExceptT . local + reader = lift . reader + +instance MonadState s m => MonadState s (ExceptT e m) where + get = lift get + put = lift . put + state = lift . state + +instance MonadWriter w m => MonadWriter w (ExceptT e m) where + writer = lift . writer + tell = lift . tell + listen = liftListen listen + pass = liftPass pass +#endif + +{- $customErrorExample +Here is an example that demonstrates the use of a custom error data type with +the 'throwError' and 'catchError' exception mechanism from 'MonadError'. +The example throws an exception if the user enters an empty string +or a string longer than 5 characters. Otherwise it prints length of the string. + +>-- This is the type to represent length calculation error. +>data LengthError = EmptyString -- Entered string was empty. +> | StringTooLong Int -- A string is longer than 5 characters. +> -- Records a length of the string. +> | OtherError String -- Other error, stores the problem description. +> +>-- Converts LengthError to a readable message. +>instance Show LengthError where +> show EmptyString = "The string was empty!" +> show (StringTooLong len) = +> "The length of the string (" ++ (show len) ++ ") is bigger than 5!" +> show (OtherError msg) = msg +> +>-- For our monad type constructor, we use Either LengthError +>-- which represents failure using Left LengthError +>-- or a successful result of type a using Right a. +>type LengthMonad = Either LengthError +> +>main = do +> putStrLn "Please enter a string:" +> s <- getLine +> reportResult (calculateLength s) +> +>-- Wraps length calculation to catch the errors. +>-- Returns either length of the string or an error. +>calculateLength :: String -> LengthMonad Int +>calculateLength s = (calculateLengthOrFail s) `catchError` Left +> +>-- Attempts to calculate length and throws an error if the provided string is +>-- empty or longer than 5 characters. +>-- The processing is done in Either monad. +>calculateLengthOrFail :: String -> LengthMonad Int +>calculateLengthOrFail [] = throwError EmptyString +>calculateLengthOrFail s | len > 5 = throwError (StringTooLong len) +> | otherwise = return len +> where len = length s +> +>-- Prints result of the string length calculation. +>reportResult :: LengthMonad Int -> IO () +>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len)) +>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e)) +-} + +{- $ExceptTExample +@'ExceptT'@ monad transformer can be used to add error handling to another monad. +Here is an example how to combine it with an @IO@ monad: + +>import Control.Monad.Except +> +>-- An IO monad which can return String failure. +>-- It is convenient to define the monad type of the combined monad, +>-- especially if we combine more monad transformers. +>type LengthMonad = ExceptT String IO +> +>main = do +> -- runExceptT removes the ExceptT wrapper +> r <- runExceptT calculateLength +> reportResult r +> +>-- Asks user for a non-empty string and returns its length. +>-- Throws an error if user enters an empty string. +>calculateLength :: LengthMonad Int +>calculateLength = do +> -- all the IO operations have to be lifted to the IO monad in the monad stack +> liftIO $ putStrLn "Please enter a non-empty string: " +> s <- liftIO getLine +> if null s +> then throwError "The string was empty!" +> else return $ length s +> +>-- Prints result of the string length calculation. +>reportResult :: Either String Int -> IO () +>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len)) +>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e)) +-}