Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixes for latest GHC. #10

Merged
merged 3 commits into from
Jul 6, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
.stack-work/
dist/
39 changes: 36 additions & 3 deletions Control/Monad/Exception/Base.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,12 @@ module Control.Monad.Exception.Base where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Base
import Control.Monad.Exception.Catch
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Loc
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
Expand Down Expand Up @@ -62,18 +66,33 @@ instance Monad m => Functor (EMT l m) where
instance Monad m => Monad (EMT l m) where
return = EMT . return . Right

fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)

emt >>= f = EMT $ do
v <- unEMT emt
case v of
Left e -> return (Left e)
Right x -> unEMT (f x)

#if !MIN_VERSION_base(4,13,0)
#if MIN_VERSION_base(4,9,0)
fail = Fail.fail
#else
fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)
#endif
#endif

instance Monad m => Applicative (EMT l m) where
pure = return
(<*>) = ap

#if MIN_VERSION_base(4,9,0)
#if MIN_VERSION_base(4,13,0)
instance Monad m => MonadFail (EMT l m) where
#else
instance Monad m => Fail.MonadFail (EMT l m) where
#endif
fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)
#endif

instance (Exception e, Throws e l, Monad m) => Failure e (EMT l m) where
failure = throw

Expand All @@ -96,14 +115,28 @@ instance MonadBase b m => MonadBase b (EMT l m) where
liftBase = liftBaseDefault

instance MonadBaseControl b m => MonadBaseControl b (EMT l m) where
#if MIN_VERSION_monad_control(1,0,0)
type StM (EMT l m) a = ComposeSt (EMT l) m a
liftBaseWith = defaultLiftBaseWith
restoreM = defaultRestoreM
#else
newtype StM (EMT l m) a = StmEMT {unStmEMT :: ComposeSt (EMT l) m a}
liftBaseWith = defaultLiftBaseWith StmEMT
restoreM = defaultRestoreM unStmEMT
#endif

-- newtype EMT l m a = EMT {unEMT :: m (Either (CallTrace, CheckedException l) a)}

instance MonadTransControl (EMT l) where
#if MIN_VERSION_monad_control(1,0,0)
type StT (EMT l) a = Either (CallTrace, CheckedException l) a
liftWith f = EMT $ fmap return $ f $ unEMT
restoreT = EMT
#else
newtype StT (EMT l) a = StEMT {unStEMT :: Either (CallTrace, CheckedException l) a}
liftWith f = EMT $ liftM return $ f $ liftM StEMT . unEMT
restoreT = EMT . liftM unStEMT
restoreT = EMT . liftM unStEMT
#endif

instance Monad m => MonadLoc (EMT l m) where
withLoc loc (EMT emt) = EMT $ do
Expand Down
5 changes: 4 additions & 1 deletion Control/Monad/Exception/Pure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,10 @@ module Control.Monad.Exception.Pure (
FailException(..), MonadZeroException(..), mplusDefault,

-- * Reexports
Exception(..), SomeException(..), Typeable1,
Exception(..), SomeException(..),
#if !MIN_VERSION_base(4,7,0)
Typeable1,
#endif
Failure(..),
#if !MIN_VERSION_failure(0,2,0)
Try(..), NothingException(..),
Expand Down
74 changes: 74 additions & 0 deletions stack.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/

# A warning or info to be displayed to the user on config load.
user-message: |
Warning (added by new or init): Some packages were found to be incompatible with the resolver and have been left commented out in the packages section.
You can omit this message by removing it from stack.yaml

# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: nightly-2020-06-29

# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .

# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
extra-deps:
- failure-0.2.0.3
- monadloc-0.7.1

# Override default flag values for local packages and extra-deps
# flags: {}

# Extra package databases containing global packages
# extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.3"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor