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.RoutingApplication
|
||||
Servant.Server.Internal.ServantErr
|
||||
Servant.Server.Internal.RawServer
|
||||
Servant.Utils.StaticFiles
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
|
|
|
@ -55,6 +55,7 @@ import Servant.API.ResponseHeaders (GetHeaders, Headers, getHeaders,
|
|||
import Servant.Server.Internal.Router
|
||||
import Servant.Server.Internal.RoutingApplication
|
||||
import Servant.Server.Internal.ServantErr
|
||||
import Servant.Server.Internal.RawServer
|
||||
|
||||
import Web.HttpApiData (FromHttpApiData)
|
||||
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
|
||||
|
@ -565,12 +566,12 @@ instance (KnownSymbol sym, HasServer sublayout)
|
|||
-- > server = serveDirectory "/var/www/images"
|
||||
instance HasServer Raw where
|
||||
|
||||
type ServerT Raw m = Application
|
||||
type ServerT Raw m = RawServer m
|
||||
|
||||
route Proxy rawApplication = LeafRouter $ \ request respond -> do
|
||||
r <- runDelayed rawApplication
|
||||
case r of
|
||||
Route app -> app request (respond . Route)
|
||||
Route app -> (getRawServer app) request (respond . Route)
|
||||
Fail a -> respond $ Fail a
|
||||
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.Strict as SWriter
|
||||
import Data.Typeable
|
||||
import Data.Coerce
|
||||
import Servant.API
|
||||
import Servant.Server.Internal.RawServer (RawServer)
|
||||
|
||||
class Enter typ arg ret | typ arg -> ret, typ ret -> arg where
|
||||
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
|
||||
enter arg f a = enter arg (f a)
|
||||
|
||||
instance Enter (RawServer m) (m :~> n) (RawServer n) where
|
||||
enter _ = coerce
|
||||
|
||||
-- ** Useful instances
|
||||
|
||||
-- | 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.Server (Server)
|
||||
import System.FilePath (addTrailingPathSeparator)
|
||||
import Servant.Server.Internal.RawServer (RawServer(..))
|
||||
#if !MIN_VERSION_wai_app_static(3,1,0)
|
||||
import Filesystem.Path.CurrentOS (decodeString)
|
||||
#endif
|
||||
|
@ -37,7 +38,7 @@ import Filesystem.Path.CurrentOS (decodeString)
|
|||
-- handler in the last position, because /servant/ will try to match the handlers
|
||||
-- in order.
|
||||
serveDirectory :: FilePath -> Server Raw
|
||||
serveDirectory =
|
||||
serveDirectory = RawServer .
|
||||
#if MIN_VERSION_wai_app_static(3,1,0)
|
||||
staticApp . defaultFileServerSettings . addTrailingPathSeparator
|
||||
#else
|
||||
|
|
Loading…
Reference in a new issue