git.iko.soy/servant
on master help sign in
Merge pull request #900 from phadej/resourcet-1.2

Support resourcet-1.2

commit4d3893885dbaa006c634d5bd9eed847707e25603 authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 8 Feb 2018, 12:16 (9 years ago) parentf5ffdc777600e6
4 files changed+23−11
compare with master
unifiedsplit
.travis.yml+2−2 cabal.project+5−1 servant-server/servant-server.cabal+1−1 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+15−7
.travis.yml+2−2
@@ -71,7 +71,7 @@ install:
7171 - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
7272 - "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"
7373 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
74− - "echo 'allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens' >> cabal.project"
74+ - "echo 'allow-newer: servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet' >> cabal.project"
7575 - cat cabal.project
7676 - if [ -f "servant/configure.ac" ]; then
7777 (cd "servant" && autoreconf -i);
@@ -149,7 +149,7 @@ script:
149149 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
150150 - "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"
151151 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
152− - "echo 'allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens' >> cabal.project"
152+ - "echo 'allow-newer: servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet' >> cabal.project"
153153 - cat cabal.project
154154 - echo -en 'travis_fold:end:unpack\\r'
155155
cabal.project+5−1
@@ -7,7 +7,11 @@ packages: servant/
77 doc/tutorial/
88 doc/cookbook/*/*.cabal
99
10−allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens
10+allow-newer:
11+ servant-js:servant-foreign,
12+ servant-auth-server:http-types,
13+ servant-multipart:lens,
14+ servant-multipart:resourcet
1115
1216constraints:
1317 -- see https://github.com/haskell-infra/hackage-trustees/issues/119
servant-server/servant-server.cabal+1−1
@@ -90,7 +90,7 @@ library
9090 , split >= 0.2.3.2 && < 0.3
9191 , string-conversions >= 0.4.0.1 && < 0.5
9292 , system-filepath >= 0.4 && < 0.5
93− , resourcet >= 1.1.10 && < 1.2
93+ , resourcet >= 1.1.9 && < 1.3
9494 , tagged >= 0.8.5 && < 0.9
9595 , transformers-base >= 0.4.4 && < 0.5
9696 , transformers-compat >= 0.5.1 && < 0.6
servant-server/src/Servant/Server/Internal/RoutingApplication.hs+15−7
@@ -13,11 +13,11 @@ module Servant.Server.Internal.RoutingApplication where
1313import Control.Monad (ap, liftM)
1414import Control.Monad.Base (MonadBase (..))
1515import Control.Monad.Catch (MonadThrow (..))
16−import Control.Monad.Reader (MonadReader (..), ReaderT, runReaderT)
16+import Control.Monad.Reader (MonadReader (..), ReaderT (..), runReaderT)
1717import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
1818import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
1919 defaultLiftBaseWith, defaultRestoreM)
20−import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT)
20+import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT, withInternalState, runInternalState)
2121import Network.Wai (Application, Request, Response, ResponseReceived)
2222import Prelude ()
2323import Prelude.Compat
@@ -84,7 +84,6 @@ instance MonadTransControl RouteResultT where
8484instance MonadThrow m => MonadThrow (RouteResultT m) where
8585 throwM = lift . throwM
8686
87−
8887toApplication :: RoutingApplication -> Application
8988toApplication ra request respond = ra request routingRespond
9089 where
@@ -194,18 +193,27 @@ newtype DelayedIO a = DelayedIO { runDelayedIO' :: ReaderT Request (ResourceT (R
194193 deriving
195194 ( Functor, Applicative, Monad
196195 , MonadIO, MonadReader Request
197− , MonadBase IO
198196 , MonadThrow
199197 , MonadResource
200198 )
201199
200+instance MonadBase IO DelayedIO where
201+ liftBase = liftIO
202+
202203liftRouteResult :: RouteResult a -> DelayedIO a
203204liftRouteResult x = DelayedIO $ lift . lift $ RouteResultT . return $ x
204205
205206instance MonadBaseControl IO DelayedIO where
206− type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
207− liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
208− restoreM = DelayedIO . restoreM
207+ -- type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
208+ -- liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
209+ -- restoreM = DelayedIO . restoreM
210+
211+ type StM DelayedIO a = RouteResult a
212+ liftBaseWith f = DelayedIO $ ReaderT $ \req -> withInternalState $ \s ->
213+ liftBaseWith $ \runInBase -> f $ \x ->
214+ runInBase (runInternalState (runReaderT (runDelayedIO' x) req) s)
215+ restoreM = DelayedIO . lift . withInternalState . const . restoreM
216+
209217
210218runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
211219runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req