twain-1.0.0.0: Tiny web application framework for WAI.
Safe HaskellNone
LanguageHaskell2010

Web.Twain

Synopsis

Twain to WAI

twain :: Port -> e -> TwainM e () -> IO () Source #

Run a Twain app on Port using the given environment.

If a PORT environment variable is set, it will take precendence.

twain 8080 "My App" $ do
  middleware logger
  get "/" $ do
    appTitle <- env
    send $ text ("Hello from " <> appTitle)
  get "/greetings/:name"
    name <- param "name"
    send $ text ("Hello, " <> name)
  notFound $ do
    send $ status status404 $ text "Not Found"

twain' :: Settings -> e -> TwainM e () -> IO () Source #

Run a Twain app passing Warp Settings.

twainApp :: e -> TwainM e () -> Application Source #

Create a WAI Application from a Twain app and environment.

Middleware and Routes.

middleware :: Middleware -> TwainM e () Source #

Use the given middleware. The first declared is the outermost middleware (it has first access to request and last action on response).

get :: PathPattern -> RouteM e a -> TwainM e () Source #

put :: PathPattern -> RouteM e a -> TwainM e () Source #

post :: PathPattern -> RouteM e a -> TwainM e () Source #

notFound :: RouteM e a -> TwainM e () Source #

Add a route if nothing else is found. This matches any request, so it should go last.

onException :: (SomeException -> Response) -> TwainM e () Source #

Render a Response on exceptions.

addRoute :: Maybe Method -> PathPattern -> RouteM e a -> TwainM e () Source #

Add a route matching Method (optional) and PathPattern.

Request and Parameters.

env :: RouteM e e Source #

Get the app environment.

param :: ParsableParam a => Text -> RouteM e a Source #

Get a parameter. Looks in query, path, cookie, and body (in that order).

If no parameter is found, or parameter fails to parse, next is called which passes control to subsequent routes and middleware.

param' :: ParsableParam a => Text -> RouteM e (Either Text a) Source #

Get a parameter or error if missing or parse failure.

paramMaybe :: ParsableParam a => Text -> RouteM e (Maybe a) Source #

Get an optional parameter. Nothing is returned for missing parameter or parse failure.

params :: RouteM e [Param] Source #

Get all parameters from query, path, cookie, and body (in that order).

files :: RouteM e [File ByteString] Source #

Get all uploaded files.

header :: Text -> RouteM e (Maybe Text) Source #

Get the value of a request Header. Header names are case-insensitive.

headers :: RouteM e [Header] Source #

Get the request headers.

Responses.

send :: Response -> RouteM e a Source #

Send a Response.

send $ text "Hello, World!"

Send an html response:

send $ html "<h1>Hello, World!</h1>"

Modify the status:

send $ status status404 $ text "Not Found"

Send a response withHeader:

send $ withHeader (hServer, "Twain + Warp") $ text "Hello"

Send a response withCookie:

send $ withCookie "key" "val" $ text "Hello"

next :: RouteM e a Source #

Pass control to the next route or middleware.

redirect301 :: Text -> Response Source #

Create a redirect response with 301 status (Moved Permanently).

redirect302 :: Text -> Response Source #

Create a redirect response with 302 status (Found).

redirect303 :: Text -> Response Source #

Create a redirect response 303 status (See Other).

text :: Text -> Response Source #

Construct a Text response.

Sets the Content-Type and Content-Length headers.

html :: ByteString -> Response Source #

Construct an HTML response.

Sets the Content-Type and Content-Length headers.

json :: ToJSON a => a -> Response Source #

Construct a JSON response using ToJSON.

Sets the Content-Type and Content-Length headers.

xml :: ByteString -> Response Source #

Construct an XML response.

Sets the Content-Type and Content-Length headers.

raw :: Status -> [Header] -> ByteString -> Response Source #

Construct a raw response from a lazy ByteString.

withHeader :: Header -> Response -> Response Source #

Add a Header to response.

withCookie :: Text -> Text -> Response -> Response Source #

Add a cookie to the response with the given key and value.

Note: This uses defaultSetCookie.

withCookie' :: SetCookie -> Response -> Response Source #

Add a SetCookie to the response.

expireCookie :: Text -> Response -> Response Source #

Add a header to expire (unset) a cookie with the given key.