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

Remove warnings if mtl ≥ 2.2.1 #102

Merged
merged 2 commits into from Jul 16, 2014
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.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
24 changes: 16 additions & 8 deletions Web/Scotty/Action.hs
@@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# LANGUAGE CPP, OverloadedStrings, RankNTypes #-}
module Web.Scotty.Action
( addHeader
, body
Expand Down Expand Up @@ -29,10 +29,14 @@ module Web.Scotty.Action
, runAction
) where

import Blaze.ByteString.Builder (Builder, fromLazyByteString)
import Blaze.ByteString.Builder (Builder, fromLazyByteString)

import Control.Monad.Error
import Control.Monad.Reader
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif
import Control.Monad.Reader
import qualified Control.Monad.State as MS

import qualified Data.Aeson as A
Expand All @@ -47,19 +51,23 @@ import qualified Data.Text as ST
import qualified Data.Text.Lazy as T
import Data.Text.Lazy.Encoding (encodeUtf8)

import Network.HTTP.Types
import Network.Wai
import Network.HTTP.Types
import Network.Wai

import Web.Scotty.Internal.Types
import Web.Scotty.Util
import Web.Scotty.Internal.Types
import Web.Scotty.Util

-- Nothing indicates route failed (due to Next) and pattern matching should continue.
-- Just indicates a successful response.
runAction :: (ScottyError e, Monad m) => ErrorHandler e m -> ActionEnv -> ActionT e m () -> m (Maybe Response)
runAction h env action = do
(e,r) <- flip MS.runStateT def
$ flip runReaderT env
#if MIN_VERSION_mtl(2,2,1)
$ runExceptT
#else
$ runErrorT
#endif
$ runAM
$ action `catchError` (defH h)
return $ either (const Nothing) (const $ Just $ mkResponse r) e
Expand Down
16 changes: 15 additions & 1 deletion Web/Scotty/Internal/Types.hs
@@ -1,12 +1,16 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}
{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeFamilies #-}
module Web.Scotty.Internal.Types where

import Blaze.ByteString.Builder (Builder)

import Control.Applicative
import qualified Control.Exception as E
import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM, ComposeSt, defaultLiftBaseWith, defaultRestoreM, MonadTransControl, StT, liftWith, restoreT)
Expand Down Expand Up @@ -89,8 +93,10 @@ instance ScottyError e => ScottyError (ActionError e) where
showError Next = pack "Next"
showError (ActionError e) = showError e

#if !MIN_VERSION_mtl(2,2,1)
instance ScottyError e => Error (ActionError e) where
strMsg = stringError
#endif

type ErrorHandler e m = Maybe (e -> ActionT e m ())

Expand All @@ -117,7 +123,11 @@ data ScottyResponse = SR { srStatus :: Status
instance Default ScottyResponse where
def = SR status200 [] (ContentBuilder mempty)

#if MIN_VERSION_mtl(2,2,1)
newtype ActionT e m a = ActionT { runAM :: ExceptT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
#else
newtype ActionT e m a = ActionT { runAM :: ErrorT (ActionError e) (ReaderT ActionEnv (StateT ScottyResponse m)) a }
#endif
deriving ( Functor, Applicative, Monad )

instance (MonadIO m, ScottyError e) => MonadIO (ActionT e m) where
Expand All @@ -139,7 +149,11 @@ instance (MonadBase b m, ScottyError e) => MonadBase b (ActionT e m) where


instance (ScottyError e) => MonadTransControl (ActionT e) where
#if MIN_VERSION_mtl(2,2,1)
newtype StT (ActionT e) a = StAction {unStAction :: StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ExceptT (ActionError e)) a))}
#else
newtype StT (ActionT e) a = StAction {unStAction :: StT (StateT ScottyResponse) (StT (ReaderT ActionEnv) (StT (ErrorT (ActionError e)) a))}
#endif
liftWith = \f ->
ActionT $ liftWith $ \run ->
liftWith $ \run' ->
Expand Down
28 changes: 16 additions & 12 deletions Web/Scotty/Route.hs
@@ -1,32 +1,36 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase,
{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, LambdaCase,
OverloadedStrings, RankNTypes, ScopedTypeVariables #-}
module Web.Scotty.Route
( get, post, put, delete, patch, addroute, matchAny, notFound,
capture, regex, function, literal
) where

import Control.Arrow ((***))
import Control.Concurrent.MVar
import Control.Monad.Error
import Control.Arrow ((***))
import Control.Concurrent.MVar
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif
import qualified Control.Monad.State as MS

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Maybe (fromMaybe)
import Data.Monoid (mconcat)
import Data.String (fromString)
import Data.Maybe (fromMaybe)
import Data.Monoid (mconcat)
import Data.String (fromString)
import qualified Data.Text.Lazy as T
import qualified Data.Text as TS

import Network.HTTP.Types
import Network.Wai (Request(..))
import Network.HTTP.Types
import Network.Wai (Request(..))
import qualified Network.Wai.Parse as Parse hiding (parseRequestBody)

import qualified Text.Regex as Regex

import Web.Scotty.Action
import Web.Scotty.Internal.Types
import Web.Scotty.Util
import Web.Scotty.Action
import Web.Scotty.Internal.Types
import Web.Scotty.Util

-- | get = 'addroute' 'GET'
get :: (ScottyError e, MonadIO m) => RoutePattern -> ActionT e m () -> ScottyT e m ()
Expand Down