RawServer datatype, for uniformity of Enter
Previously, ServerT raw m ~ Application. Seems reasonable, but has the unfortunate consequence of making Enter useless for Raw routes. Attempting to solve the Enter class constraint for a Raw route will run up to IO ResponseReceived, the tail end of the Wai Application type, in practical use ultimately demanding something along the lines of: Enter (IO ResponseReceived) (yourMonad :~> EitherT ServantErr IO) (IO ResponseReceived) There's no need to use Enter on a Raw route anyway, I know, but with this change, the programmer can treat Raw routes and non-Raw routes uniformly with respect to Enter.
This commit is contained in:
parent
6dac6e831c
commit
5d40b7787f
5 changed files with 33 additions and 3 deletions
|
@ -40,6 +40,7 @@ library
|
||||||
Servant.Server.Internal.Router
|
Servant.Server.Internal.Router
|
||||||
Servant.Server.Internal.RoutingApplication
|
Servant.Server.Internal.RoutingApplication
|
||||||
Servant.Server.Internal.ServantErr
|
Servant.Server.Internal.ServantErr
|
||||||
|
Servant.Server.Internal.RawServer
|
||||||
Servant.Utils.StaticFiles
|
Servant.Utils.StaticFiles
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 5
|
base >= 4.7 && < 5
|
||||||
|
|
|
@ -55,6 +55,7 @@ import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
|
||||||
import Servant.Server.Internal.Router
|
import Servant.Server.Internal.Router
|
||||||
import Servant.Server.Internal.RoutingApplication
|
import Servant.Server.Internal.RoutingApplication
|
||||||
import Servant.Server.Internal.ServantErr
|
import Servant.Server.Internal.ServantErr
|
||||||
|
import Servant.Server.Internal.RawServer
|
||||||
|
|
||||||
import Web.HttpApiData (FromHttpApiData)
|
import Web.HttpApiData (FromHttpApiData)
|
||||||
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
|
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
|
||||||
|
@ -565,12 +566,12 @@ instance (KnownSymbol sym, HasServer sublayout)
|
||||||
-- > server = serveDirectory "/var/www/images"
|
-- > server = serveDirectory "/var/www/images"
|
||||||
instance HasServer Raw where
|
instance HasServer Raw where
|
||||||
|
|
||||||
type ServerT Raw m = Application
|
type ServerT Raw m = RawServer m
|
||||||
|
|
||||||
route Proxy rawApplication = LeafRouter $ \ request respond -> do
|
route Proxy rawApplication = LeafRouter $ \ request respond -> do
|
||||||
r <- runDelayed rawApplication
|
r <- runDelayed rawApplication
|
||||||
case r of
|
case r of
|
||||||
Route app -> app request (respond . Route)
|
Route app -> (getRawServer app) request (respond . Route)
|
||||||
Fail a -> respond $ Fail a
|
Fail a -> respond $ Fail a
|
||||||
FailFatal e -> respond $ FailFatal e
|
FailFatal e -> respond $ FailFatal e
|
||||||
|
|
||||||
|
|
|
@ -25,7 +25,9 @@ import qualified Control.Monad.State.Strict as SState
|
||||||
import qualified Control.Monad.Writer.Lazy as LWriter
|
import qualified Control.Monad.Writer.Lazy as LWriter
|
||||||
import qualified Control.Monad.Writer.Strict as SWriter
|
import qualified Control.Monad.Writer.Strict as SWriter
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
|
import Data.Coerce
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
import Servant.Server.Internal.RawServer (RawServer)
|
||||||
|
|
||||||
class Enter typ arg ret | typ arg -> ret, typ ret -> arg where
|
class Enter typ arg ret | typ arg -> ret, typ ret -> arg where
|
||||||
enter :: arg -> typ -> ret
|
enter :: arg -> typ -> ret
|
||||||
|
@ -39,6 +41,9 @@ instance ( Enter typ1 arg1 ret1, Enter typ2 arg2 ret2
|
||||||
instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
|
instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where
|
||||||
enter arg f a = enter arg (f a)
|
enter arg f a = enter arg (f a)
|
||||||
|
|
||||||
|
instance Enter (RawServer m) (m :~> n) (RawServer n) where
|
||||||
|
enter _ = coerce
|
||||||
|
|
||||||
-- ** Useful instances
|
-- ** Useful instances
|
||||||
|
|
||||||
-- | A natural transformation from @m@ to @n@. Used to `enter` particular
|
-- | A natural transformation from @m@ to @n@. Used to `enter` particular
|
||||||
|
|
22
servant-server/src/Servant/Server/Internal/RawServer.hs
Normal file
22
servant-server/src/Servant/Server/Internal/RawServer.hs
Normal file
|
@ -0,0 +1,22 @@
|
||||||
|
{-|
|
||||||
|
Module : Servant.Server.Internal.RawServer
|
||||||
|
Description : Definition of the RawServer type.
|
||||||
|
Copyright : (c) Alexander Vieth, 2015
|
||||||
|
Licence : BSD3
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE AutoDeriveTypeable #-}
|
||||||
|
{-# LANGUAGE KindSignatures #-}
|
||||||
|
|
||||||
|
module Servant.Server.Internal.RawServer (
|
||||||
|
|
||||||
|
RawServer(..)
|
||||||
|
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Network.Wai (Application)
|
||||||
|
|
||||||
|
-- | A Wai Application, but with a phantom type.
|
||||||
|
newtype RawServer (m :: * -> *) = RawServer {
|
||||||
|
getRawServer :: Application
|
||||||
|
}
|
|
@ -12,6 +12,7 @@ import Network.Wai.Application.Static (defaultFileServerSettings,
|
||||||
import Servant.API.Raw (Raw)
|
import Servant.API.Raw (Raw)
|
||||||
import Servant.Server (Server)
|
import Servant.Server (Server)
|
||||||
import System.FilePath (addTrailingPathSeparator)
|
import System.FilePath (addTrailingPathSeparator)
|
||||||
|
import Servant.Server.Internal.RawServer (RawServer(..))
|
||||||
#if !MIN_VERSION_wai_app_static(3,1,0)
|
#if !MIN_VERSION_wai_app_static(3,1,0)
|
||||||
import Filesystem.Path.CurrentOS (decodeString)
|
import Filesystem.Path.CurrentOS (decodeString)
|
||||||
#endif
|
#endif
|
||||||
|
@ -37,7 +38,7 @@ import Filesystem.Path.CurrentOS (decodeString)
|
||||||
-- handler in the last position, because /servant/ will try to match the handlers
|
-- handler in the last position, because /servant/ will try to match the handlers
|
||||||
-- in order.
|
-- in order.
|
||||||
serveDirectory :: FilePath -> Server Raw
|
serveDirectory :: FilePath -> Server Raw
|
||||||
serveDirectory =
|
serveDirectory = RawServer .
|
||||||
#if MIN_VERSION_wai_app_static(3,1,0)
|
#if MIN_VERSION_wai_app_static(3,1,0)
|
||||||
staticApp . defaultFileServerSettings . addTrailingPathSeparator
|
staticApp . defaultFileServerSettings . addTrailingPathSeparator
|
||||||
#else
|
#else
|
||||||
|
|
Loading…
Reference in a new issue