remove redundant function
This commit is contained in:
parent
e27ea01049
commit
775b239f7f
2 changed files with 5 additions and 23 deletions
|
@ -6,6 +6,7 @@
|
||||||
|
|
||||||
-- fixme: document phases
|
-- fixme: document phases
|
||||||
-- fixme: document that the req body can only be consumed once
|
-- fixme: document that the req body can only be consumed once
|
||||||
|
-- fixme: document that you can write request body streaming combinators
|
||||||
-- fixme: document dependency problem
|
-- fixme: document dependency problem
|
||||||
|
|
||||||
module Servant.Server.Utils.CustomCombinators (
|
module Servant.Server.Utils.CustomCombinators (
|
||||||
|
@ -20,7 +21,6 @@ module Servant.Server.Utils.CustomCombinators (
|
||||||
makeCaptureCombinator,
|
makeCaptureCombinator,
|
||||||
makeRequestCheckCombinator,
|
makeRequestCheckCombinator,
|
||||||
makeAuthCombinator,
|
makeAuthCombinator,
|
||||||
makeReqBodyCombinator,
|
|
||||||
makeCombinator,
|
makeCombinator,
|
||||||
|
|
||||||
-- * Re-exports
|
-- * Re-exports
|
||||||
|
@ -30,12 +30,9 @@ module Servant.Server.Utils.CustomCombinators (
|
||||||
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Control.Exception (throwIO, ErrorCall(..))
|
import Control.Exception (throwIO, ErrorCall(..))
|
||||||
import Data.ByteString
|
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Data.String.Conversions
|
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Text.Read
|
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
|
@ -59,6 +56,7 @@ runServerCombinator (CI i) = i
|
||||||
-- |
|
-- |
|
||||||
-- >>> :set -XTypeFamilies
|
-- >>> :set -XTypeFamilies
|
||||||
-- >>> :{
|
-- >>> :{
|
||||||
|
-- import Text.Read
|
||||||
-- data MyCaptureCombinator
|
-- data MyCaptureCombinator
|
||||||
-- instance HasServer api context => HasServer (MyCaptureCombinator :> api) context where
|
-- instance HasServer api context => HasServer (MyCaptureCombinator :> api) context where
|
||||||
-- type ServerT (MyCaptureCombinator :> api) m = Int -> ServerT api m
|
-- type ServerT (MyCaptureCombinator :> api) m = Int -> ServerT api m
|
||||||
|
@ -127,23 +125,6 @@ makeAuthCombinator = inner
|
||||||
withRequest $ \ request ->
|
withRequest $ \ request ->
|
||||||
liftRouteResult =<< liftIO (authCheck context (protectBody "makeAuthCombinator" request))
|
liftRouteResult =<< liftIO (authCheck context (protectBody "makeAuthCombinator" request))
|
||||||
|
|
||||||
makeReqBodyCombinator ::
|
|
||||||
(HasServer api context) =>
|
|
||||||
(Context context -> IO ByteString -> arg)
|
|
||||||
-> ServerCombinator combinator (arg -> ServerT api Handler) api context
|
|
||||||
makeReqBodyCombinator = inner
|
|
||||||
where
|
|
||||||
inner ::
|
|
||||||
forall api combinator arg context .
|
|
||||||
(HasServer api context) =>
|
|
||||||
(Context context -> IO ByteString -> arg)
|
|
||||||
-> ServerCombinator combinator (arg -> ServerT api Handler) api context
|
|
||||||
inner getArg = CI $ \ Proxy context delayed ->
|
|
||||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
|
||||||
(return ())
|
|
||||||
(\ () -> withRequest $ \ request ->
|
|
||||||
liftRouteResult $ Route $ getArg context $ requestBody request)
|
|
||||||
|
|
||||||
makeCombinator ::
|
makeCombinator ::
|
||||||
(HasServer api context) =>
|
(HasServer api context) =>
|
||||||
(Context context -> Request -> IO (RouteResult arg))
|
(Context context -> Request -> IO (RouteResult arg))
|
||||||
|
@ -159,7 +140,7 @@ makeCombinator = inner
|
||||||
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
route (Proxy :: Proxy api) context $ addBodyCheck delayed
|
||||||
(return ())
|
(return ())
|
||||||
(\ () -> withRequest $ \ request ->
|
(\ () -> withRequest $ \ request ->
|
||||||
liftRouteResult =<< liftIO (getArg context (protectBody "makeCombinator" request)))
|
liftRouteResult =<< liftIO (getArg context request))
|
||||||
|
|
||||||
protectBody :: String -> Request -> Request
|
protectBody :: String -> Request -> Request
|
||||||
protectBody name request = request{
|
protectBody name request = request{
|
||||||
|
|
|
@ -284,7 +284,8 @@ data Source = Source (IO SBS.ByteString)
|
||||||
|
|
||||||
instance HasServer api context => HasServer (StreamRequest :> api) context where
|
instance HasServer api context => HasServer (StreamRequest :> api) context where
|
||||||
type ServerT (StreamRequest :> api) m = Source -> ServerT api m
|
type ServerT (StreamRequest :> api) m = Source -> ServerT api m
|
||||||
route = runServerCombinator $ makeReqBodyCombinator (const getSource)
|
route = runServerCombinator $ makeCombinator $
|
||||||
|
\ context request -> return $ Route $ getSource $ requestBody request
|
||||||
|
|
||||||
getSource :: IO SBS.ByteString -> Source
|
getSource :: IO SBS.ByteString -> Source
|
||||||
getSource = Source
|
getSource = Source
|
||||||
|
|
Loading…
Reference in a new issue