diff --git a/snap-core.cabal b/snap-core.cabal --- a/snap-core.cabal +++ b/snap-core.cabal @@ -1,5 +1,5 @@ name: snap-core -version: 1.0.4.0 +version: 1.0.4.1 synopsis: Snap: A Haskell Web Framework (core interfaces and types) description: @@ -35,7 +35,8 @@ bug-reports: https://github.com/snapframework/snap-core/issues category: Web, Snap, IO-Streams Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, - GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 + GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3, + GHC == 8.8.1 extra-source-files: test/TestSuite.hs, @@ -140,7 +141,7 @@ filepath >= 1.1 && < 2.0, lifted-base >= 0.1 && < 0.3, io-streams >= 1.3 && < 1.6, - hashable >= 1.2.0.6 && < 1.3, + hashable >= 1.2.0.6 && < 1.4, monad-control >= 1.0 && < 1.1, mtl >= 2.0 && < 2.3, random >= 1 && < 2, @@ -178,14 +179,16 @@ ghc-options: -Wall -fwarn-tabs -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0 - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances - else - build-depends: fail == 4.9.*, semigroups == 0.18.* + if impl(ghc < 8.8) + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + else + build-depends: fail == 4.9.*, semigroups == 0.18.* + if flag(network-uri) build-depends: network-uri >= 2.6 && < 2.7, - network >= 2.6 && < 3.1 + network >= 2.6 && < 3.2 else build-depends: network-uri >= 2.5 && < 2.6, network >= 2.3 && < 2.6 @@ -283,10 +286,11 @@ -fno-warn-unused-do-bind -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0 - if impl(ghc >= 8.0) - ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances - else - build-depends: fail == 4.9.*, semigroups == 0.18.* + if impl(ghc < 8.8) + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances + else + build-depends: fail == 4.9.*, semigroups == 0.18.* other-extensions: BangPatterns, diff --git a/src/Snap/Internal/Core.hs b/src/Snap/Internal/Core.hs --- a/src/Snap/Internal/Core.hs +++ b/src/Snap/Internal/Core.hs @@ -311,7 +311,9 @@ return = pure {-# INLINE return #-} #endif +#if !MIN_VERSION_base(4,13,0) fail = Fail.fail +#endif instance Fail.MonadFail Snap where fail = snapFail diff --git a/src/Snap/Internal/Test/RequestBuilder.hs b/src/Snap/Internal/Test/RequestBuilder.hs --- a/src/Snap/Internal/Test/RequestBuilder.hs +++ b/src/Snap/Internal/Test/RequestBuilder.hs @@ -75,6 +75,9 @@ deriving ( Applicative , Functor , Monad +#if MIN_VERSION_base(4,13,0) + , MonadFail +#endif , MonadIO , MonadState Request , MonadTrans diff --git a/test/Snap/Core/Tests.hs b/test/Snap/Core/Tests.hs --- a/test/Snap/Core/Tests.hs +++ b/test/Snap/Core/Tests.hs @@ -19,7 +19,7 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.DeepSeq (deepseq) import Control.Exception.Lifted (ErrorCall (..), Exception, SomeException (..), catch, fromException, mask, throwIO, try) -import Control.Monad (Functor (fmap), Monad ((>>), (>>=), fail, return), MonadPlus (mplus, mzero), forM_, liftM, void) +import Control.Monad (Functor (fmap), Monad ((>>), (>>=), return), MonadPlus (mplus, mzero), forM_, liftM, void) import Control.Monad.Base (MonadBase (liftBase)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Error (ErrorT (runErrorT)) @@ -47,7 +47,7 @@ import Data.Text (Text) import qualified Data.Text.Encoding as T (encodeUtf8) import Data.Text.Lazy () -import Prelude (Bool (..), Either (..), Enum (..), Eq (..), IO, Int, Maybe (Just, Nothing), Num (..), Show (..), String, const, either, flip, id, map, maybe, not, seq, undefined, ($), ($!), (&&), (++), (.)) +import Prelude (Bool (..), Either (..), Enum (..), Eq (..), IO, Int, Maybe (Just, Nothing), Num (..), Show (..), String, const, either, fail, flip, id, map, maybe, not, seq, undefined, ($), ($!), (&&), (++), (.)) import Snap.Internal.Core (EscapeSnap (..), MonadSnap (..), NoHandlerException (NoHandlerException), Snap, addToOutput, bracketSnap, catchFinishWith, dir, escapeHttp, evalSnap, finishWith, getParam, getParams, getPostParam, getPostParams, getQueryParam, getQueryParams, getRequest, getResponse, getsResponse, ifTop, ipHeaderFilter, localRequest, logError, method, methods, modifyResponse, pass, path, pathArg, putRequest, putResponse, readRequestBody, redirect, redirect', runRequestBody, runSnap, setTimeout, terminateConnection, transformRequestBody, updateContextPath, withRequest, withResponse, writeBS, writeLBS, writeLazyText, writeText) import Snap.Internal.Http.Types (Cookie (Cookie), Method (..), Request (rqBody, rqClientAddr, rqContextPath, rqIsSecure, rqURI), Response (rspContentLength, rspStatus, rspStatusReason, rspTransformingRqBody), addHeader, deleteHeader, emptyResponse, getHeader, rqRemoteAddr, setContentLength, setHeader, setResponseCode, setResponseStatus, statusReasonMap) import Snap.Internal.Parsing (urlDecode, urlEncode) @@ -285,7 +285,7 @@ (_,resp) <- go (pass <|> setFoo "Bar") assertEqual "foo present" (Just "Bar") $ getHeader "Foo" resp - (_,resp2) <- go (fail "" + (_,resp2) <- go (fail "fail should not error" <|> fail2 <|> setFoo "Bar" <|> setFoo "Baz") diff --git a/test/Snap/Test/Common.hs b/test/Snap/Test/Common.hs --- a/test/Snap/Test/Common.hs +++ b/test/Snap/Test/Common.hs @@ -23,14 +23,14 @@ import Control.Concurrent (threadDelay) import Control.DeepSeq (deepseq) import Control.Exception.Lifted (SomeException (..), catch, evaluate, try) -import Control.Monad (Monad ((>>), fail, return), liftM, replicateM) +import Control.Monad (Monad ((>>), return), liftM, replicateM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString as S import Data.ByteString.Internal (c2w) import qualified Data.ByteString.Lazy as L import Data.Typeable (Typeable, typeOf) -import Prelude (Either (..), Eq (..), IO, Int, Num (..), Ord (..), Ordering (..), Read (..), Show (..), map, seq, ($), (.), (^)) +import Prelude (Either (..), Eq (..), IO, Int, Num (..), Ord (..), Ordering (..), Read (..), Show (..), fail, map, seq, ($), (.), (^)) import Test.QuickCheck (Arbitrary (arbitrary), choose) import Test.QuickCheck.Monadic (PropertyM) import qualified Test.QuickCheck.Monadic as QC