Dynamic.hs

{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell #-}
module Yesod.Dynamic
    ( YesodDynamic
    , yesodDynamic
    , Handler
    , Widget
    , Method
    , returnY
    ) where

import Yesod.Content
import Yesod.Core
import Yesod.Handler
import Yesod.Widget
import Yesod.Dispatch
import Yesod.Request
import Network.Wai (Application, requestMethod)
import qualified Data.ByteString.Char8 as S8

type Method = String
type Handler = GHandler YesodDynamic YesodDynamic ChooseRep
type Widget = GWidget YesodDynamic YesodDynamic

returnY :: HasReps a => a -> Handler
returnY = return . chooseRep

newtype YesodDynamic = YesodDynamic (Method -> [String] -> Handler)

yesodDynamic :: (Method -> [String] -> Handler) -> IO Application
yesodDynamic = toWaiApp . YesodDynamic

mkYesod "YesodDynamic" [$parseRoutes|
/*Strings RootR
|]

handleRootR :: Strings -> Handler
handleRootR pieces = do
    req <- waiRequest
    let method = S8.unpack $ requestMethod req
    YesodDynamic f <- getYesod
    f method pieces

instance Yesod YesodDynamic where
    approot _ = ""

hello.hs

{-# LANGUAGE OverloadedStrings #-}
import Yesod.Dynamic
import Yesod.Content
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Debug (debug)

main = yesodDynamic app >>= run 3000 . debug

app _ _ = returnY $ RepPlain "Hello World"