module Web.Welshy
( welshy, welshyApp
, Welshy, middleware, route, RoutePattern
, get, post, put, patch, delete, head, options
, Action
, halt, pass
, catchIO
, request, body
, capture, captures
, queryParam, maybeQueryParam, queryParams
, jsonParam, maybeJsonParam, jsonParams, jsonData
, bearerAuth
, status, header
, text, text'
, html, html'
, json
, file, filePart
, source
, Param
, FromText(..), maybeFromText
) where
import Control.Applicative
import Control.Exception
import qualified Control.Exception.Lifted as Lifted
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Writer hiding (pass)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp
import System.IO
import Prelude hiding (head)
import Web.Welshy.Action
import Web.Welshy.FromText
import Web.Welshy.Request
import Web.Welshy.Response
newtype Welshy a = Welshy (Writer [Middleware] a)
deriving (Functor, Applicative, Monad)
welshy :: Port -> Welshy () -> IO ()
welshy p w = do
putStr "Aye, Dwi iawn 'n feddw!"
putStrLn $ " (port " ++ show p ++ ") (ctrl-c to quit)"
run p (welshyApp w)
welshyApp :: Welshy () -> Application
welshyApp (Welshy w) = foldr id notFound (catchError : execWriter w)
where
notFound :: Application
notFound _ = return $ ResponseBuilder notFound404 [] mempty
catchError :: Middleware
catchError app req = Lifted.catch (app req) $ \e -> do
liftIO $ hPrint stderr (e :: SomeException)
return $ ResponseBuilder status500 [] mempty
middleware :: Middleware -> Welshy ()
middleware = Welshy . tell . pure
get :: RoutePattern -> Action () -> Welshy ()
get = route GET
post :: RoutePattern -> Action () -> Welshy ()
post = route POST
put :: RoutePattern -> Action () -> Welshy ()
put = route PUT
patch :: RoutePattern -> Action () -> Welshy ()
patch = route PATCH
delete :: RoutePattern -> Action () -> Welshy ()
delete = route DELETE
head :: RoutePattern -> Action () -> Welshy ()
head = route HEAD
options :: RoutePattern -> Action () -> Welshy ()
options = route OPTIONS
type RoutePattern = Text
route :: StdMethod -> RoutePattern -> Action () -> Welshy ()
route met pat act = middleware $ \nextApp req ->
case matchRoute met pat req of
Nothing -> nextApp req
Just caps -> execAction act caps nextApp req
matchRoute :: StdMethod -> RoutePattern -> Request -> Maybe [Param]
matchRoute met pat req =
if Right met == parseMethod (requestMethod req)
then go (filter (/= T.empty) $ T.split (=='/') pat) (pathInfo req) []
else Nothing
where
go [] [] prs = Just prs
go [] _ _ = Nothing
go _ [] _ = Nothing
go (p:ps) (r:rs) prs
| p == r = go ps rs prs
| T.null p = Nothing
| T.head p == ':' = go ps rs $ (T.tail p, r) : prs
| otherwise = Nothing