Merge pull request #900 from phadej/resourcet-1.2
Support resourcet-1.2
This commit is contained in:
Oleg Grenrus
GitHub
commit
4d3893885d
4 changed files with 23 additions and 11 deletions
|
|
@ -71,7 +71,7 @@ install:
|
|||
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
|
||||
- "printf 'packages: \"servant\" \"servant-client\" \"servant-client-core\" \"servant-docs\" \"servant-foreign\" \"servant-server\" \"doc/tutorial\" \"doc/cookbook/db-postgres-pool\" \"doc/cookbook/jwt-and-basic-auth\" \"doc/cookbook/db-sqlite-simple\" \"doc/cookbook/basic-auth\" \"doc/cookbook/https\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\" \"doc/cookbook/file-upload\"\\n' > cabal.project"
|
||||
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
||||
- "echo 'allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens' >> cabal.project"
|
||||
- "echo 'allow-newer: servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet' >> cabal.project"
|
||||
- cat cabal.project
|
||||
- if [ -f "servant/configure.ac" ]; then
|
||||
(cd "servant" && autoreconf -i);
|
||||
|
|
@ -149,7 +149,7 @@ script:
|
|||
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||
- "printf 'packages: servant-*/*.cabal servant-client-*/*.cabal servant-client-core-*/*.cabal servant-docs-*/*.cabal servant-foreign-*/*.cabal servant-server-*/*.cabal tutorial-*/*.cabal cookbook-db-postgres-pool-*/*.cabal cookbook-jwt-and-basic-auth-*/*.cabal cookbook-db-sqlite-simple-*/*.cabal cookbook-basic-auth-*/*.cabal cookbook-https-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.cabal cookbook-file-upload-*/*.cabal\\n' > cabal.project"
|
||||
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
||||
- "echo 'allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens' >> cabal.project"
|
||||
- "echo 'allow-newer: servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet' >> cabal.project"
|
||||
- cat cabal.project
|
||||
- echo -en 'travis_fold:end:unpack\\r'
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,11 @@ packages: servant/
|
|||
doc/tutorial/
|
||||
doc/cookbook/*/*.cabal
|
||||
|
||||
allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens
|
||||
allow-newer:
|
||||
servant-js:servant-foreign,
|
||||
servant-auth-server:http-types,
|
||||
servant-multipart:lens,
|
||||
servant-multipart:resourcet
|
||||
|
||||
constraints:
|
||||
-- see https://github.com/haskell-infra/hackage-trustees/issues/119
|
||||
|
|
|
|||
|
|
@ -90,7 +90,7 @@ library
|
|||
, split >= 0.2.3.2 && < 0.3
|
||||
, string-conversions >= 0.4.0.1 && < 0.5
|
||||
, system-filepath >= 0.4 && < 0.5
|
||||
, resourcet >= 1.1.10 && < 1.2
|
||||
, resourcet >= 1.1.9 && < 1.3
|
||||
, tagged >= 0.8.5 && < 0.9
|
||||
, transformers-base >= 0.4.4 && < 0.5
|
||||
, transformers-compat >= 0.5.1 && < 0.6
|
||||
|
|
|
|||
|
|
@ -13,11 +13,11 @@ module Servant.Server.Internal.RoutingApplication where
|
|||
import Control.Monad (ap, liftM)
|
||||
import Control.Monad.Base (MonadBase (..))
|
||||
import Control.Monad.Catch (MonadThrow (..))
|
||||
import Control.Monad.Reader (MonadReader (..), ReaderT, runReaderT)
|
||||
import Control.Monad.Reader (MonadReader (..), ReaderT (..), runReaderT)
|
||||
import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
|
||||
import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
|
||||
defaultLiftBaseWith, defaultRestoreM)
|
||||
import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT)
|
||||
import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT, withInternalState, runInternalState)
|
||||
import Network.Wai (Application, Request, Response, ResponseReceived)
|
||||
import Prelude ()
|
||||
import Prelude.Compat
|
||||
|
|
@ -84,7 +84,6 @@ instance MonadTransControl RouteResultT where
|
|||
instance MonadThrow m => MonadThrow (RouteResultT m) where
|
||||
throwM = lift . throwM
|
||||
|
||||
|
||||
toApplication :: RoutingApplication -> Application
|
||||
toApplication ra request respond = ra request routingRespond
|
||||
where
|
||||
|
|
@ -194,18 +193,27 @@ newtype DelayedIO a = DelayedIO { runDelayedIO' :: ReaderT Request (ResourceT (R
|
|||
deriving
|
||||
( Functor, Applicative, Monad
|
||||
, MonadIO, MonadReader Request
|
||||
, MonadBase IO
|
||||
, MonadThrow
|
||||
, MonadResource
|
||||
)
|
||||
|
||||
instance MonadBase IO DelayedIO where
|
||||
liftBase = liftIO
|
||||
|
||||
liftRouteResult :: RouteResult a -> DelayedIO a
|
||||
liftRouteResult x = DelayedIO $ lift . lift $ RouteResultT . return $ x
|
||||
|
||||
instance MonadBaseControl IO DelayedIO where
|
||||
type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
|
||||
liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
|
||||
restoreM = DelayedIO . restoreM
|
||||
-- type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
|
||||
-- liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
|
||||
-- restoreM = DelayedIO . restoreM
|
||||
|
||||
type StM DelayedIO a = RouteResult a
|
||||
liftBaseWith f = DelayedIO $ ReaderT $ \req -> withInternalState $ \s ->
|
||||
liftBaseWith $ \runInBase -> f $ \x ->
|
||||
runInBase (runInternalState (runReaderT (runDelayedIO' x) req) s)
|
||||
restoreM = DelayedIO . lift . withInternalState . const . restoreM
|
||||
|
||||
|
||||
runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
|
||||
runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req
|
||||
|
|
|
|||
Loading…
Reference in a new issue