Instantly share code, notes, and snippets.

Embed
What would you like to do?
complete wai/warp sample server
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Format
import System.Locale
import Control.Monad.Trans
--------------------------------------------------
main :: IO ()
main = do
let port = 3000
putStrLn $ "starting on port " ++ show port
run port $ makeRoutes $ notFound
--------------------------------------------------
-- match routes, call handlers
makeRoutes :: Middleware
makeRoutes app req = do
startTime <- liftIO getCurrentTime
-- liftIO $ print $ path req
-- liftIO $ print $ requestMethod req
let _path = path req
_method = method req in
case (_method,_path) of
-- these are the routes
-- an example route that captures the index
(GET,[]) -> index req
-- everything else gets a 404 page, via notFound above
(_,_) -> app req
where
path :: Request -> [T.Text]
path req' = filter (\c -> c /= "") $ map T.toLower $ pathInfo req
method :: Request -> StdMethod
method req' = case parseMethod $ requestMethod req' of
Right m -> m
Left _ -> GET
--------------------------------------------------
-- / handler
index :: Application
index req = do
return $
responseLBS status200
[("Content-Type", "text/plain")]
"index"
--------------------------------------------------
-- 404 fallthrough
notFound :: Application
notFound req = do
return $
responseLBS status404
[("Content-Type", "text/plain")]
"not found"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment