Code cleanup (#54)
This commit is contained in:
parent
8210f35e4f
commit
b88b905dad
@ -25,15 +25,13 @@ read request = Aff.makeAff \_ success -> do
|
||||
let stream = HTTP.requestAsStream request
|
||||
buf <- ST.newSTRef ""
|
||||
Stream.onDataString stream Encoding.UTF8 \str ->
|
||||
ST.modifySTRef buf ((<>) str) >>= \_ -> pure unit
|
||||
void $ ST.modifySTRef buf ((<>) str)
|
||||
Stream.onEnd stream $ ST.readSTRef buf >>= success
|
||||
|
||||
-- | Write a body to the given HTTP Response and close it.
|
||||
write :: forall e. HTTP.Response -> Body -> Eff.Eff (http :: HTTP.HTTP | e) Unit
|
||||
write response body = do
|
||||
_ <- Stream.writeString stream Encoding.UTF8 body noop
|
||||
Stream.end stream noop
|
||||
noop
|
||||
write response body = void do
|
||||
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
|
||||
Stream.end stream $ pure unit
|
||||
where
|
||||
stream = HTTP.responseAsStream response
|
||||
noop = pure unit
|
||||
|
@ -27,9 +27,8 @@ write :: forall e.
|
||||
HTTP.Response ->
|
||||
Headers ->
|
||||
Eff.Eff (http :: HTTP.HTTP | e) Unit
|
||||
write response headers = do
|
||||
_ <- Traversable.traverse writeHeader $ StrMap.keys headers
|
||||
pure unit
|
||||
write response headers =
|
||||
void $ Traversable.traverse writeHeader $ StrMap.keys headers
|
||||
where
|
||||
getHeader header = Maybe.fromMaybe "" $ StrMap.lookup header headers
|
||||
writeHeader header = HTTP.setHeader response header $ getHeader header
|
||||
|
@ -27,11 +27,10 @@ handleRequest :: forall e.
|
||||
HTTP.Request ->
|
||||
HTTP.Response ->
|
||||
ServerM e
|
||||
handleRequest router request response = do
|
||||
_ <- Aff.runAff (\_ -> pure unit) (\_ -> pure unit) do
|
||||
handleRequest router request response =
|
||||
void $ Aff.runAff (\_ -> pure unit) (\_ -> pure unit) do
|
||||
req <- Request.fromHTTPRequest request
|
||||
EffClass.liftEff $ router req >>= Response.send response
|
||||
pure unit
|
||||
|
||||
-- | Given an options object, a function mapping Request to ResponseM, and an
|
||||
-- | HTTPureM containing effects to run on boot, creates and runs a HTTPure
|
||||
|
@ -7,7 +7,7 @@ import Control.Monad.Eff as Eff
|
||||
import Control.Monad.Eff.Exception as Exception
|
||||
import Control.Monad.ST as ST
|
||||
import Data.Maybe as Maybe
|
||||
import Data.Options as Options
|
||||
import Data.Options ((:=))
|
||||
import Data.String as StringUtil
|
||||
import Data.StrMap as StrMap
|
||||
import Node.Encoding as Encoding
|
||||
@ -53,26 +53,24 @@ request :: forall e.
|
||||
String ->
|
||||
String ->
|
||||
Aff.Aff (http :: HTTP.HTTP | e) HTTPClient.Response
|
||||
request port method headers path body = Aff.makeAff \_ success -> do
|
||||
request port method headers path body = Aff.makeAff \_ success -> void do
|
||||
req <- HTTPClient.request options success
|
||||
let stream = HTTPClient.requestAsStream req
|
||||
_ <- Stream.writeString stream Encoding.UTF8 body noop
|
||||
Stream.end stream noop
|
||||
noop
|
||||
_ <- Stream.writeString stream Encoding.UTF8 body $ pure unit
|
||||
Stream.end stream $ pure unit
|
||||
where
|
||||
noop = pure unit
|
||||
options =
|
||||
HTTPClient.method `Options.assoc` method <>
|
||||
HTTPClient.hostname `Options.assoc` "localhost" <>
|
||||
HTTPClient.port `Options.assoc` port <>
|
||||
HTTPClient.path `Options.assoc` path <>
|
||||
HTTPClient.headers `Options.assoc` HTTPClient.RequestHeaders headers
|
||||
HTTPClient.method := method <>
|
||||
HTTPClient.hostname := "localhost" <>
|
||||
HTTPClient.port := port <>
|
||||
HTTPClient.path := path <>
|
||||
HTTPClient.headers := HTTPClient.RequestHeaders headers
|
||||
|
||||
-- | Given an ST String buffer and a new string, concatenate that new string
|
||||
-- | onto the ST buffer.
|
||||
concat :: forall e s.
|
||||
ST.STRef s String -> String -> Eff.Eff (st :: ST.ST s | e) Unit
|
||||
concat buf new = ST.modifySTRef buf (\old -> old <> new) >>= (\_ -> pure unit)
|
||||
concat buf new = void $ ST.modifySTRef buf ((<>) new)
|
||||
|
||||
-- | Convert a request to an Aff containing the string with the response body.
|
||||
toString :: forall e.
|
||||
|
Loading…
Reference in New Issue
Block a user