backtracking-exceptions (empty) → 0.1.0.0
raw patch · 5 files changed
+318/−0 lines, 5 filesdep +basedep +eitherdep +freesetup-changed
Dependencies added: base, either, free, kan-extensions, mtl, semigroupoids, semigroups, transformers
Files
- LICENSE +30/−0
- README.md +4/−0
- Setup.hs +2/−0
- backtracking-exceptions.cabal +75/−0
- src/Control/Monad/Except/Backtracking.hs +207/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, tapuu++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 tapuu 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.
+ README.md view
@@ -0,0 +1,4 @@+backtracking-exceptions+=======================++A monad transformer for backtracking exceptions
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ backtracking-exceptions.cabal view
@@ -0,0 +1,75 @@+-- Initial backtracking-exceptions.cabal generated by cabal init. For +-- further documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: backtracking-exceptions++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: A monad transformer for backtracking exceptions++-- A longer description of the package.+description: A monad transformer that adds backtracking exceptions to its base monad.++-- URL for the project homepage or repository.+homepage: https://github.com/tapuu/backtracking-exceptions++-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: tapuu++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: mjm540@york.ac.uk++-- A copyright notice.+-- copyright: ++category: Control++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files: README.md++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10+++source-repository head+ type: git+ location: https://github.com/tapuu/backtracking-exceptions.git+++library+ -- Modules exported by the library.+ exposed-modules: Control.Monad.Except.Backtracking+ + -- Modules included in this library but not exported.+ -- other-modules: + + -- LANGUAGE extensions used by modules in this package.+ -- other-extensions: + + -- Other library packages from which modules are imported.+ build-depends: base >=4.7 && <4.8, either >=4.3 && <4.4, kan-extensions >=4.1 && <4.2, transformers >=0.4 && <0.5, semigroupoids >=4.2 && <4.3, free >=4.9 && <4.10, mtl >=2.2 && <2.3, semigroups >=0.15 && <0.16+ + -- Directories containing source files.+ hs-source-dirs: src+ + -- Base language which the package is written in.+ default-language: Haskell2010+
+ src/Control/Monad/Except/Backtracking.hs view
@@ -0,0 +1,207 @@++{-# LANGUAGE+ FlexibleInstances,+ UndecidableInstances,+ MultiParamTypeClasses,+ GeneralizedNewtypeDeriving,+ RankNTypes #-}+{- |+Module : Control.Monad.Except.Backtracking+Copyright : (c) Jamaal Malek <mjm540@york.ac.uk> 2014+License : BSD3+Maintainer : mjm540@york.ac.uk+Stability : experimental+Portability : non-portable+-}+module Control.Monad.Except.Backtracking (+ -- * The BExceptT monad transformer+ BExceptT(),+ bExceptT,+ runBExceptT,+ hoistEither,+ module Control.Monad.Error.Class+ -- * Usage example and explanation+ -- $Example+ )where++ import Control.Monad.Trans.Either hiding (hoistEither)+ import Control.Monad.Codensity+ import Control.Monad.Trans.Class+ import Control.Applicative+ import Data.Functor.Bind+ import Control.Monad.Free.Class+ import Control.Monad.IO.Class+ import Control.Monad.Reader.Class+ import Control.Monad.State.Class+ import Control.Monad.State.Lazy+ import Control.Monad.Error.Class+ import Control.Monad.Writer.Class+ import Control.Monad.RWS.Class+ import Control.Monad.Except+ import Data.Functor.Alt+ import Data.Functor.Plus+ import Data.Semigroup+ import Control.Monad++++ {-|+ 'BExceptT' is a monad transformer that adds backtracking+ exception handling to its base monad.+ -}+ newtype BExceptT e m a = BExceptT {+ unwrapBExceptT' :: Codensity (EitherT e m) a } deriving+ (Functor, Applicative, Monad, Apply, MonadIO)++ {-|+ 'bExceptT' constructs a 'BExceptT' from the base monad.+ -}+ bExceptT :: (Monad m) => m (Either e a) -> BExceptT e m a+ bExceptT = BExceptT . lift . EitherT+ {-# INLINE bExceptT #-}++ {-|+ 'runBExceptT' does the opposite of 'bExceptT'+ -}+ runBExceptT :: (Monad m) => BExceptT e m a -> m (Either e a)+ runBExceptT = runEitherT . lowerCodensity . unwrapBExceptT'+ {-# INLINE runBExceptT #-}++++ unwrapBExceptT :: (Monad m) =>+ BExceptT e m a -> forall b. (a -> EitherT e m b) -> EitherT e m b+ unwrapBExceptT = runCodensity . unwrapBExceptT'+ {-# INLINE unwrapBExceptT #-}++++ instance (Functor f, MonadFree f m) =>+ MonadFree f (BExceptT e m) where+ wrap t = BExceptT $ Codensity $ \h -> wrap $+ fmap (\p -> unwrapBExceptT p h) t+ {-# INLINE wrap #-}++ instance MonadTrans (BExceptT e) where+ lift = BExceptT . lift . lift+ {-# INLINE lift #-}++ instance (MonadReader r m) => MonadReader r (BExceptT e m) where+ ask = lift ask+ {-# INLINE ask #-}+ local f = bExceptT . local f . runBExceptT+ {-# INLINE local #-}+ reader = lift . reader+ {-# INLINE reader #-}++ instance (MonadState s m) => MonadState s (BExceptT e m) where+ get = lift get+ {-# INLINE get #-}+ put = lift . put+ {-# INLINE put #-}+ state = lift . state+ {-# INLINE state #-}++ instance (Functor m, MonadWriter w m) => MonadWriter w (BExceptT e m) where+ writer = lift . writer+ {-# INLINE writer #-}+ tell = lift . tell+ {-# INLINE tell #-}+ listen = bExceptT . fmap f . listen . runBExceptT where+ f (Left e, _) = Left e+ f (Right a, w) = Right (a, w)+ {-# INLINE listen #-}+ pass = bExceptT . pass . fmap f . runBExceptT where+ f (Left e) = (Left e, id)+ f (Right (a, f)) = (Right a, f)+ {-# INLINE pass #-}++ instance (Functor m, MonadRWS r w s m) => MonadRWS r w s (BExceptT e m)++ instance (Monad m) => MonadError e (BExceptT e m) where+ throwError e = BExceptT $ lift $ throwError e+ {-# INLINE throwError #-}+ catchError m handler = BExceptT $ Codensity $ \c ->+ unwrapBExceptT m c `catchError` handler' c where+ handler' c e = unwrapBExceptT (handler e) c++ instance (Monad m, Semigroup e) => Alt (BExceptT e m) where+ a <!> b = catchError a $ \e -> catchError b $ \e' ->+ throwError $ e <> e'+ {-# INLINE (<!>) #-}++ instance (Monad m, Semigroup e, Monoid e) => Plus (BExceptT e m) where+ zero = throwError mempty+ {-# INLINE zero #-}++ instance (Monad m, Semigroup e, Monoid e) =>+ Alternative (BExceptT e m) where+ (<|>) = (<!>)+ empty = zero++ instance (Monad m, Semigroup e, Monoid e) =>+ MonadPlus (BExceptT e m) where+ mplus = (<!>)+ mzero = zero++++ {-|+ 'hoistEither' constructs a 'BExceptT' from an 'Either' value.+ -}+ hoistEither :: (Monad m) => Either e a -> BExceptT e m a+ hoistEither = bExceptT . return+ {-# INLINE hoistEither #-}++++ {- $Example+ The following example shows the basic operation of the 'BExceptT'+ monad.++ > example1 :: StateT Int (BExceptT String IO) ()+ > example1 = do+ > put 1+ > catchError (put 2) $ \e -> do+ > i <- get+ > liftIO $ do+ > putStrLn $ "caught an error: '" <|> e <|> "'"+ > putStrLn $ "setting i to 4, current value is " <|> show i+ > put 4+ > i <- get+ > when (i /= 4) $ put 3+ > liftIO $ putStrLn "reading i"+ > i <- get+ > when (i /= 4) $ throwError "i isnt 4"+ >+ > runexample1 :: IO (Either String ((), Int))+ > runexample1 = runBExceptT $ flip runStateT 0 example1++ The output produced is:++ > reading i+ > caught an error: 'i isnt 4'+ > setting i to 4, current value is 1+ > reading i+ > Right ((),4)++ At first, the execution proceeds normally, setting the state to 1,+ then 2, then 3. The final line throws an exception because the state+ is 3, not 4. The execution then backtracks to before @put 2@ was+ executed. The state has been restored to 1 at this stage. The exception+ handler applied to @put 2@ is executed, and execution continues from+ the line below.++ Replacing @when (i /= 4) $ put 3@ with @put 3@ will not+ create an infinite loop, after the failure of each exception handler+ (in this case there is only one) execution will stop and return an+ error.++ Using @'BExceptT' 'String' ('StateT' 'Int' 'IO') ()@ instead of+ @'StateT' 'Int' ('BExceptT' 'String' 'IO') ()@ means that the state+ will not be restored after an error.++ The 'Alternative' and 'MonadPlus' instances of 'BExceptT' can be used+ like the instances in a nondeterminism monad, such as the list monad,+ except only one successful result at most will be returned.+ -}