purescript-httpurple/docs/Examples/CustomStack/Main.purs
Thomas Honeyman 42bf4475e0
Update for PureScript 0.15 (#194)
* Update shell and packages

* Fix code for 0.15

* Fix tests

* Format

* Add check-pulp command

* Generate bowerfile

* Add check-pulp to CI

* Add nixfmt to formatting

* Fixup test helpers

* Take 2

* PR comments (#1)

* Nix cleanup from PR

* Use arrows functions

* Remove unnecessary step

Co-authored-by: Connor Prussin <connor@prussin.net>
2022-05-04 14:02:29 -07:00

39 lines
1.4 KiB
Haskell

module Examples.CustomStack.Main where
import Prelude
import Control.Monad.Reader (class MonadAsk, ReaderT, asks, runReaderT)
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
import Effect.Console (log)
import HTTPure (Request, Response, ResponseM, ServerM, ok, serve)
-- | A type to hold the environment for our ReaderT
type Env = { name :: String }
-- | A middleware that introduces a ReaderT
readerMiddleware ::
(Request -> ReaderT Env Aff Response) ->
Request ->
ResponseM
readerMiddleware router request = do
runReaderT (router request) { name: "joe" }
-- | Say 'hello, joe' when run
sayHello :: forall m. MonadAff m => MonadAsk Env m => Request -> m Response
sayHello _ = do
name <- asks _.name
ok $ "hello, " <> name
-- | Boot up the server
main :: ServerM
main =
serve 8080 (readerMiddleware sayHello) do
log " ┌───────────────────────────────────────┐"
log " │ Server now up on port 8080 │"
log " │ │"
log " │ To test, run: │"
log " │ > curl -v localhost:8080 │"
log " │ # => hello, joe │"
log " └───────────────────────────────────────┘"