git.iko.soy/typeable/servant
on master help sign in
Support resourcet-1.2
77600e6Oleg Grenrus
.travis.yml+2−2
compare with master
unifiedsplit
@@ -71,7 +71,7 @@ install:
71 - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
71 - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
72 - "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"
72 - "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"
73 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
73 - "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"
75 - cat cabal.project
75 - cat cabal.project
76 - if [ -f "servant/configure.ac" ]; then
76 - if [ -f "servant/configure.ac" ]; then
77 (cd "servant" && autoreconf -i);
77 (cd "servant" && autoreconf -i);
@@ -149,7 +149,7 @@ script:
149 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
149 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
150 - "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"
150 - "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"
151 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
151 - "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"
153 - cat cabal.project
153 - cat cabal.project
154 - echo -en 'travis_fold:end:unpack\\r'
154 - echo -en 'travis_fold:end:unpack\\r'
155
155
cabal.project+5−1
@@ -7,7 +7,11 @@ packages: servant/
7 doc/tutorial/
7 doc/tutorial/
8 doc/cookbook/*/*.cabal
8 doc/cookbook/*/*.cabal
9
9
10+allow-newer:
11+ servant-js:servant-foreign,
10−allow-newer: servant-js:servant-foreign, servant-auth-server:http-types, servant-multipart:lens
12+ servant-auth-server:http-types,
13+ servant-multipart:lens,
14+ servant-multipart:resourcet
11
15
12constraints:
16constraints:
13 -- see https://github.com/haskell-infra/hackage-trustees/issues/119
17 -- see https://github.com/haskell-infra/hackage-trustees/issues/119
servant-server/servant-server.cabal+1−1
@@ -90,7 +90,7 @@ library
90 , split >= 0.2.3.2 && < 0.3
90 , split >= 0.2.3.2 && < 0.3
91 , string-conversions >= 0.4.0.1 && < 0.5
91 , string-conversions >= 0.4.0.1 && < 0.5
92 , system-filepath >= 0.4 && < 0.5
92 , system-filepath >= 0.4 && < 0.5
93− , resourcet >= 1.1.10 && < 1.2
93+ , resourcet >= 1.1.9 && < 1.3
94 , tagged >= 0.8.5 && < 0.9
94 , tagged >= 0.8.5 && < 0.9
95 , transformers-base >= 0.4.4 && < 0.5
95 , transformers-base >= 0.4.4 && < 0.5
96 , transformers-compat >= 0.5.1 && < 0.6
96 , 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
13import Control.Monad (ap, liftM)
13import Control.Monad (ap, liftM)
14import Control.Monad.Base (MonadBase (..))
14import Control.Monad.Base (MonadBase (..))
15import Control.Monad.Catch (MonadThrow (..))
15import Control.Monad.Catch (MonadThrow (..))
16−import Control.Monad.Reader (MonadReader (..), ReaderT, runReaderT)
16+import Control.Monad.Reader (MonadReader (..), ReaderT (..), runReaderT)
17import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
17import Control.Monad.Trans (MonadIO (..), MonadTrans (..))
18import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
18import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
19 defaultLiftBaseWith, defaultRestoreM)
19 defaultLiftBaseWith, defaultRestoreM)
20−import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT)
20+import Control.Monad.Trans.Resource (MonadResource (..), ResourceT, runResourceT, transResourceT, withInternalState, runInternalState)
21import Network.Wai (Application, Request, Response, ResponseReceived)
21import Network.Wai (Application, Request, Response, ResponseReceived)
22import Prelude ()
22import Prelude ()
23import Prelude.Compat
23import Prelude.Compat
@@ -84,7 +84,6 @@ instance MonadTransControl RouteResultT where
84instance MonadThrow m => MonadThrow (RouteResultT m) where
84instance MonadThrow m => MonadThrow (RouteResultT m) where
85 throwM = lift . throwM
85 throwM = lift . throwM
86
86
87−
88toApplication :: RoutingApplication -> Application
87toApplication :: RoutingApplication -> Application
89toApplication ra request respond = ra request routingRespond
88toApplication ra request respond = ra request routingRespond
90 where
89 where
@@ -194,18 +193,27 @@ newtype DelayedIO a = DelayedIO { runDelayedIO' :: ReaderT Request (ResourceT (R
194 deriving
193 deriving
195 ( Functor, Applicative, Monad
194 ( Functor, Applicative, Monad
196 , MonadIO, MonadReader Request
195 , MonadIO, MonadReader Request
197− , MonadBase IO
198 , MonadThrow
196 , MonadThrow
199 , MonadResource
197 , MonadResource
200 )
198 )
201
199
200+instance MonadBase IO DelayedIO where
201+ liftBase = liftIO
202+
202liftRouteResult :: RouteResult a -> DelayedIO a
203liftRouteResult :: RouteResult a -> DelayedIO a
203liftRouteResult x = DelayedIO $ lift . lift $ RouteResultT . return $ x
204liftRouteResult x = DelayedIO $ lift . lift $ RouteResultT . return $ x
204
205
205instance MonadBaseControl IO DelayedIO where
206instance MonadBaseControl IO DelayedIO where
206− type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
207+ -- type StM DelayedIO a = StM (ReaderT Request (ResourceT (RouteResultT IO))) a
207− liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
208+ -- liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
208− restoreM = DelayedIO . restoreM
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+
209
217
210runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
218runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
211runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req
219runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req