Warp + Pool

gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types (status200)
import Blaze.ByteString.Builder (copyByteString)
import qualified Data.ByteString.UTF8 as BU
import Data.Monoid
import Data.Enumerator (Iteratee)
import Data.Pool
import qualified Database.HDBC as H
import qualified Database.HDBC.PostgreSQL as H
import Control.Monad.IO.Class
 
main = do
    let port = 3000
    putStrLn $ "Listening on port " ++ show port
    createPool (H.connectPostgreSQL "dbname=rfid") H.disconnect 
      5 $ run port . app
    
app::Pool H.Connection -> Application
app pool req = do
    case pathInfo req of
        ["reports"] -> 
          liftIO $ withPool' pool reports
        x -> return $ index x

reports conn = do
  reports <- H.quickQuery' conn "SELECT name from report" []
  return $ ResponseBuilder status200 [ ("Content-Type", "text/plain; charset=utf-8") ] $ mconcat $ map copyByteString
    [ "first report name:" 
    ,  H.fromSql $ head $ head reports ]

index x = ResponseBuilder status200 [("Content-Type", "text/html")] $ mconcat $ map copyByteString
    [ "<p>Hello from ", BU.fromString $ show x, "!</p>"
    , "<p><a href='/yay'>yay</a></p>\n" ]