View source on Github

Introduction

This is hopefully the first blog post in many with "cookbook" style answers. If you have either questions or "recipes" to submit, please send them over (michael at snoyman dot com) . Eventually, this content will make its way into the Yesod book.

Adding a local Javascript file

{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} import Yesod data Local = Local type Handler = GHandler Local Local mkYesod "Local" [parseRoutes| / RootR GET /myfile.js MyFileJsR GET |] instance Yesod Local where approot _ = "" getRootR = defaultLayout $ do addScript MyFileJsR addHamlet [hamlet| <h1>HELLO WORLD! |] -- type sig necessary, since sendFile is polymorphic getMyFileJsR :: Handler () -- Serves "myfile.js" with text/javascript mime-type. -- Served from /myfile.js as defined above, but your code needn't know that. getMyFileJsR = sendFile "text/javascript" "myfile.js" main = warpDebug 3000 Local

Virtual Hosts

{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} import Yesod import Network.Wai.Middleware.Vhost import Network.Wai.Handler.Warp import Network.Wai data Site1 = Site1 data Site2 = Site2 data DefaultSite = DefaultSite mkYesod "Site1" [parseRoutes|/ Root1 GET|] getRoot1 = return $ RepPlain "Root1" mkYesod "Site2" [parseRoutes|/ Root2 GET|] getRoot2 = return $ RepPlain "Root2" mkYesod "DefaultSite" [parseRoutes|/ RootDef GET|] getRootDef = return $ RepPlain "RootDef" instance Yesod Site1 where approot _ = "" instance Yesod Site2 where approot _ = "" instance Yesod DefaultSite where approot _ = ""

main = do app1 <- toWaiApp Site1 app2 <- toWaiApp Site2 appDef <- toWaiApp DefaultSite run 3000 $ vhost [ ((==) "host1" . serverName, app1) , ((==) "host2" . serverName, app2) ] appDef

import qualified Data.Map as Map

main = do app1 <- toWaiApp Site1 app2 <- toWaiApp Site2 appDef <- toWaiApp DefaultSite let sites = Map.fromList [ ("host1", app1) , ("host2", app2) ] run 3000 $ \req -> case Map.lookup (serverName req) sites of Nothing -> appDef req Just app -> app req

Yesod Proxy Server

{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-}

import Yesod hiding (Request) import Network.HTTP.Enumerator (parseUrl, withManager, http, Request) import Network.HTTP.Types (Status, ResponseHeaders) import Network.Wai (Response (ResponseEnumerator)) import Data.ByteString (ByteString) import Blaze.ByteString.Builder (Builder, fromByteString) import Data.Enumerator (Iteratee, run_, ($$), joinI) import qualified Data.Enumerator.List as EL

data Proxy = Proxy type Handler = GHandler Proxy Proxy mkYesod "Proxy" [parseRoutes| / RootR GET |] instance Yesod Proxy where approot _ = "" main :: IO () main = warpDebug 3000 Proxy

getRootR :: Handler () getRootR = do req <- liftIO $ parseUrl "http://www.yesodweb.com/"

http :: Request IO -> (Status -> ResponseHeaders -> Iteratee ByteString IO a) -> Manager -> Iteratee ByteString IO a

http is a bit more polymorphic than this, allowing any instance of MonadIO. Additionally, we could swap out httpRedirect for http here if we wished; httpRedirect will automatically follow 3xx redirects.

type ResponseEnumerator a = (Status -> ResponseHeaders -> Iteratee Builder IO a) -> IO a

blaze :: (Status -> ResponseHeaders -> Iteratee Builder IO a) -> Status -> ResponseHeaders -> Iteratee ByteString IO a blaze f status headers =

let notEncoding ("Content-Encoding", _) = False notEncoding _ = True headers' = filter notEncoding headers

--builderIter :: Iteratee Builder IO a builderIter = f status headers'

in joinI $ EL.map fromByteString $$ builderIter

getRootR :: Handler () getRootR = do req <- liftIO $ parseUrl "http://www.yesodweb.com/" sendWaiResponse $ ResponseEnumerator $ inside req

inside :: Request IO -> (Status -> ResponseHeaders -> Iteratee Builder IO a) -> IO a

inside req f = withManager $ \manager ->

http req (blaze f) manager :: Iteratee Bytestring IO a

inside req f = withManager $ \manager -> run_ (http req (blaze f) manager)

inside req f = withManager $ run_ . http req (blaze f)