thunderstrike/purescript-httpurple
thunderstrike/purescript-httpurple
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Some cleanup

Browse Source
This commit is contained in:
sigma-andex 2022-08-08 21:17:03 +01:00
parent 79e88a71e1
commit 5e3f5a77a8
2 changed files with 2 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/HTTPurple/Server.purs
View File

@ -17,7 +17,6 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Data.Options ((:=)) import Data.Options ((:=))
import Data.Posix.Signal (Signal(..)) import Data.Posix.Signal (Signal(..))
import Data.Profunctor.Choice ((|||)) import Data.Profunctor.Choice ((|||))
import Debug (spy)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, catchError, message, runAff) import Effect.Aff (Aff, catchError, message, runAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
@ -79,11 +78,13 @@ type ExtRoutingSettingsR route output r =
| r | r
) )
type MiddlewareSettingsR :: forall k1 k2. k1 -> k2 -> Row Type
type MiddlewareSettingsR input output = type MiddlewareSettingsR input output =
( middleware :: MiddlewareResult input -> ContT (MiddlewareResult output) Effect (MiddlewareResult input) ( middleware :: MiddlewareResult input -> ContT (MiddlewareResult output) Effect (MiddlewareResult input)
, middlewareErrorHandler :: Error -> Request Unit -> Aff Response , middlewareErrorHandler :: Error -> Request Unit -> Aff Response
) )
type ExtRoutingSettings :: forall k. Type -> k -> Row Type -> Type
type ExtRoutingSettings route input output = { | ExtRoutingSettingsR route output + MiddlewareSettingsR input output } type ExtRoutingSettings route input output = { | ExtRoutingSettingsR route output + MiddlewareSettingsR input output }
-- | Given a router, handle unhandled exceptions it raises by -- | Given a router, handle unhandled exceptions it raises by

66
src/Middleware.purs
View File

@ -1,66 +0,0 @@
module Middleware
( MiddlewareProcessing(..)
, NodeMiddleware
, using
, usingContinuation
) where
import Prelude
import Control.Monad.Cont (ContT(..))
import Data.Tuple.Nested (type (/\), (/\))
import Debug (spy)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Aff.Class (class MonadAff)
import Effect.Ref as Ref
import HTTPurple.Request (Request, fromHTTPRequest)
import HTTPurple.Response (Response, send)
import Node.HTTP as HTTP
import Routing.Duplex (RouteDuplex')
type NodeMiddleware = HTTP.Request -> HTTP.Response -> Effect Unit -> Effect Unit
data MiddlewareProcessing = NotStarted | ProcessingFailed | ProcessingSucceeded (HTTP.Request /\ HTTP.Response)
usingContinuation ::
NodeMiddleware ->
(HTTP.Request /\ HTTP.Response) ->
((HTTP.Request /\ HTTP.Response) -> Effect MiddlewareProcessing) ->
Effect MiddlewareProcessing
usingContinuation middleware reqResp nextHandler = do
middlewareResult <- callMiddleware reqResp
case middlewareResult of
res@(ProcessingSucceeded newReqResp) -> let _ = spy "Next called" res in nextHandler newReqResp
res -> let _ = spy "Next not called" res in pure res
where
callMiddleware :: HTTP.Request /\ HTTP.Response -> Effect (MiddlewareProcessing)
callMiddleware (req /\ resp) = do
ref <- Ref.new NotStarted
let
next :: Effect Unit
next = Ref.write (ProcessingSucceeded reqResp) ref
middleware req resp next
value <- Ref.read ref
pure value
using ::
(HTTP.Request -> HTTP.Response -> Effect Unit -> Effect Unit) ->
HTTP.Request /\ HTTP.Response ->
ContT MiddlewareProcessing Effect (HTTP.Request /\ HTTP.Response)
using nodeMiddleware reqResp = ContT $ usingContinuation nodeMiddleware reqResp
type Handler route m = Request route -> m Response
-- runHandler ::
-- forall route m.
-- MonadAff m =>
-- RouteDuplex' route ->
-- Handler route m ->
-- HTTP.Request ->
-- HTTP.Response ->
-- Effect Unit
-- runHandler rd handler req resp = launchAff_ do
-- httpurpleReq <- fromHTTPRequest rd req
-- httpurpleResp <- handler httpurpleReq
-- send resp httpurpleResp