From 3afb0f7442b0c8335a2b787f73dcaa480f3e7f3c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 31 Jan 2011 12:02:15 +0200 Subject: [PATCH] Fix up scaffolded site --- Yesod.hs | 5 ++--- scaffold.hs | 4 ++-- scaffold/Controller_hs.cg | 7 +++++-- scaffold/Root_hs.cg | 2 +- scaffold/Settings_hs.cg | 6 +++--- scaffold/cabal.cg | 30 ++++++++++++------------------ scaffold/default-layout_hamlet.cg | 16 ++++++++-------- scaffold/fastcgi_hs.cg | 6 ------ scaffold/favicon_ico.cg | Bin 1150 -> 1150 bytes scaffold/homepage_cassius.cg | 2 +- scaffold/homepage_hamlet.cg | 22 +++++++++++----------- scaffold/homepage_julius.cg | 2 +- scaffold/production_hs.cg | 6 ++++++ scaffold/simple-server_hs.cg | 6 ------ scaffold/sitearg_hs.cg | 20 +++++++++----------- scaffold/test_hs.cg | 11 +++++++++++ yesod.cabal | 2 +- 17 files changed, 73 insertions(+), 74 deletions(-) delete mode 100644 scaffold/fastcgi_hs.cg create mode 100644 scaffold/production_hs.cg delete mode 100644 scaffold/simple-server_hs.cg create mode 100644 scaffold/test_hs.cg diff --git a/Yesod.hs b/Yesod.hs index dd7360bc..d73cc3e6 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -58,7 +58,6 @@ import Yesod.Json import Yesod.Persist import Network.Wai (Application) import Network.Wai.Middleware.Debug -import qualified Network.Wai as W import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Peel (MonadPeelIO) @@ -77,12 +76,12 @@ readIntegral s = -- | A convenience method to run an application using the Warp webserver on the -- specified port. Automatically calls 'toWaiApp'. -warp :: (Yesod a, YesodSite a) => Int -> a -> IO () +warp :: (Yesod a, YesodDispatch a a) => Int -> a -> IO () warp port a = toWaiApp a >>= run port -- | Same as 'warp', but also sends a message to stderr for each request, and -- an \"application launched\" message as well. Can be useful for development. -warpDebug :: (Yesod a, YesodSite a) => Int -> a -> IO () +warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO () warpDebug port a = do hPutStrLn stderr $ "Application launched, listening on port " ++ show port toWaiApp a >>= run port . debug diff --git a/scaffold.hs b/scaffold.hs index cfca5303..b0da7867 100644 --- a/scaffold.hs +++ b/scaffold.hs @@ -63,8 +63,8 @@ main = do mkDir "cassius" mkDir "julius" - writeFile' "simple-server.hs" $(codegen "simple-server_hs") - writeFile' "fastcgi.hs" $(codegen "fastcgi_hs") + writeFile' "test.hs" $(codegen "test_hs") + writeFile' "production.hs" $(codegen "production_hs") writeFile' "devel-server.hs" $(codegen "devel-server_hs") writeFile' (project ++ ".cabal") $(codegen "cabal") writeFile' "LICENSE" $(codegen "LICENSE") diff --git a/scaffold/Controller_hs.cg b/scaffold/Controller_hs.cg index 96885c3d..8aafe2b2 100644 --- a/scaffold/Controller_hs.cg +++ b/scaffold/Controller_hs.cg @@ -1,4 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Controller ( with~sitearg~ @@ -9,6 +11,7 @@ import Settings import Yesod.Helpers.Static import Yesod.Helpers.Auth import Database.Persist.GenericSql +import Data.ByteString (ByteString) -- Import all relevant handler modules here. import Handler.Root @@ -24,7 +27,7 @@ getFaviconR :: Handler () getFaviconR = sendFile "image/x-icon" "favicon.ico" getRobotsR :: Handler RepPlain -getRobotsR = return $ RepPlain $ toContent "User-agent: *" +getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- This function allocates resources (such as a database connection pool), -- performs initialization and creates a WAI application. This is also the @@ -36,5 +39,5 @@ with~sitearg~ f = Settings.withConnectionPool $ \p -> do let h = ~sitearg~ s p toWaiApp h >>= f where - s = fileLookupDir Settings.staticdir typeByExt + s = static Settings.staticdir diff --git a/scaffold/Root_hs.cg b/scaffold/Root_hs.cg index 2c3f42f9..67cd987e 100644 --- a/scaffold/Root_hs.cg +++ b/scaffold/Root_hs.cg @@ -14,7 +14,7 @@ getRootR :: Handler RepHtml getRootR = do mu <- maybeAuth defaultLayout $ do - h2id <- newIdent + h2id <- lift newIdent setTitle "~project~ homepage" addWidget $(widgetFile "homepage") diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg index dad79c92..9becff92 100644 --- a/scaffold/Settings_hs.cg +++ b/scaffold/Settings_hs.cg @@ -24,7 +24,7 @@ import qualified Text.Cassius as H import qualified Text.Julius as H import Language.Haskell.TH.Syntax import Database.Persist.~upper~ -import Yesod (MonadInvertIO, addWidget, addCassius, addJulius) +import Yesod (MonadPeelIO, addWidget, addCassius, addJulius) import Data.Monoid (mempty) import System.Directory (doesFileExist) @@ -139,9 +139,9 @@ widgetFile x = do -- database actions using a pool, respectively. It is used internally -- by the scaffolded application, and therefore you will rarely need to use -- them yourself. -withConnectionPool :: MonadInvertIO m => (ConnectionPool -> m a) -> m a +withConnectionPool :: MonadPeelIO m => (ConnectionPool -> m a) -> m a withConnectionPool = with~upper~Pool connStr connectionCount -runConnectionPool :: MonadInvertIO m => SqlPersist m a -> ConnectionPool -> m a +runConnectionPool :: MonadPeelIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool = runSqlPool diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg index 625b614d..f8707e93 100644 --- a/scaffold/cabal.cg +++ b/scaffold/cabal.cg @@ -16,41 +16,35 @@ Flag production Description: Build the production executable. Default: False -executable simple-server +executable ~project~-test if flag(production) Buildable: False - main-is: simple-server.hs + main-is: test.hs build-depends: base >= 4 && < 5 - , yesod >= 0.6 && < 0.7 - , yesod-auth >= 0.2 && < 0.3 - , mime-mail >= 0.0 && < 0.1 + , yesod >= 0.7 && < 0.8 + , yesod-auth + , yesod-static + , mime-mail , wai-extra , directory , bytestring , text - , persistent >= 0.3.1.1 + , persistent , persistent-~lower~ , template-haskell , hamlet , web-routes - , hjsmin >= 0.0.4 && < 0.1 + , hjsmin + , transformers + , warp ghc-options: -Wall -threaded -executable devel-server - if flag(production) - Buildable: False - else - build-depends: wai-handler-devel >= 0.1.0 && < 0.2 - main-is: devel-server.hs - ghc-options: -Wall -O2 -threaded - -executable fastcgi +executable ~project~-production if flag(production) Buildable: True - build-depends: wai-handler-fastcgi >= 0.2.2 && < 0.3 else Buildable: False cpp-options: -DPRODUCTION - main-is: fastcgi.hs + main-is: production.hs ghc-options: -Wall -threaded diff --git a/scaffold/default-layout_hamlet.cg b/scaffold/default-layout_hamlet.cg index 3bcfae41..f31acb19 100644 --- a/scaffold/default-layout_hamlet.cg +++ b/scaffold/default-layout_hamlet.cg @@ -1,10 +1,10 @@ !!! -%html - %head - %title $pageTitle.pc$ - ^pageHead.pc^ - %body - $maybe mmsg msg - #message $msg$ - ^pageBody.pc^ +#{pageTitle pc} + ^{pageHead pc} + #{msg} + ^{pageBody pc} diff --git a/scaffold/fastcgi_hs.cg b/scaffold/fastcgi_hs.cg deleted file mode 100644 index d946d7c7..00000000 --- a/scaffold/fastcgi_hs.cg +++ /dev/null @@ -1,6 +0,0 @@ -import Controller -import Network.Wai.Handler.FastCGI (run) - -main :: IO () -main = with~sitearg~ run - diff --git a/scaffold/favicon_ico.cg b/scaffold/favicon_ico.cg index 4613ed03a65f518e28cd421beb06f346bedf0e1e..9888b98f958ff23094403e2f8ce27894d1f186c3 100644 GIT binary patch literal 1150 zcmZQzU<5(|0R|wcz>vYhz#zuJz@P!dKp~(AL>x#lFaYJy!TS&&*#8U}>}C_TXR z-o5)#7sf`Wf$231TbO5L967&l-_tOV+DDH*tFB#pzW`Yuhz&|-ad8Lkf%F5@t}(Lw ziWPS%K=DymcV>N5)c(g;uDr8AmItwcY2O}XPiyOWjQ9rm3n;!E7^ZK5anp^g_w#=S hhKE4>7Ks0$;Xm~Z3?TdyhW9fte1_uZ#~Bzv7y!I9`)dFI literal 1150 zcmai!--{Aa6vuBE1--NoL@%*DMlV4SK@YvvbI>1A&%MMFkx;b$VAM=knRM14tGhdn zKgLy=5mzPMY}H+Vu&V{pO1TjD=7Wf6r+Z!QAk#oIeCOPI=6udMocV#!IeacHA$+}o zo}EYNDnjTc7ItCJnI9X3@ICbb07$KV|JU`z1{-_7V*QpAa;xoT`|fl){U=V%jmKkM zUP?ZfL-t`y4ghcTK{L>TeNS~3Wum?8R@Qb{lUXuR5r9uw(Z zGsh>fWFUNI)74OObbpxffv_6U5s`ecrsqt5O6m+})Dt7SRk8z{T?G;>sPm8acq=Tdb;L;6h= z3dKjxV7&NYJ3n2lpHello +

You do not have Javascript enabled. +$maybe u <- mu +

Logout + . $nothing - %p - You are not logged in. $ - %a!href=@AuthR.LoginR@ Login now - \. +

Login now + . diff --git a/scaffold/homepage_julius.cg b/scaffold/homepage_julius.cg index 281c89aa..9b38774d 100644 --- a/scaffold/homepage_julius.cg +++ b/scaffold/homepage_julius.cg @@ -1,4 +1,4 @@ window.onload = function(){ - document.getElementById("%h2id%").innerHTML = "Added from JavaScript."; + document.getElementById("#{h2id}").innerHTML = "Added from JavaScript."; } diff --git a/scaffold/production_hs.cg b/scaffold/production_hs.cg new file mode 100644 index 00000000..3ca59728 --- /dev/null +++ b/scaffold/production_hs.cg @@ -0,0 +1,6 @@ +import Controller (with~sitearg~) +import Network.Wai.Handler.Warp (run) + +main :: IO () +main = with~sitearg~ $ run 3000 + diff --git a/scaffold/simple-server_hs.cg b/scaffold/simple-server_hs.cg deleted file mode 100644 index 9a630481..00000000 --- a/scaffold/simple-server_hs.cg +++ /dev/null @@ -1,6 +0,0 @@ -import Controller -import Network.Wai.Handler.SimpleServer (run) - -main :: IO () -main = putStrLn "Loaded" >> with~sitearg~ (run 3000) - diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg_hs.cg index f83f8335..e678fff7 100644 --- a/scaffold/sitearg_hs.cg +++ b/scaffold/sitearg_hs.cg @@ -22,7 +22,6 @@ import Yesod.Helpers.Auth.Email import qualified Settings import System.Directory import qualified Data.ByteString.Lazy as L -import Web.Routes.Site (Site (formatPathSegments)) import Database.Persist.GenericSql import Settings (hamletFile, cassiusFile, juliusFile, widgetFile) import Model @@ -94,11 +93,7 @@ instance Yesod ~sitearg~ where -- This is done to provide an optimization for serving static files from -- a separate domain. Please see the staticroot setting in Settings.hs urlRenderOverride a (StaticR s) = - Just $ uncurry (joinPath a Settings.staticroot) $ format s - where - format = formatPathSegments ss - ss :: Site StaticRoute (String -> Maybe (GHandler Static ~sitearg~ ChooseRep)) - ss = getSubSite + Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s urlRenderOverride _ _ = Nothing -- The page to be redirected to when authentication is required. @@ -126,7 +121,8 @@ instance Yesod ~sitearg~ where -- How to run database actions. instance YesodPersist ~sitearg~ where type YesodDB ~sitearg~ = SqlPersist - runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db + runDB db = liftIOHandler + $ fmap connPool getYesod >>= Settings.runConnectionPool db instance YesodAuth ~sitearg~ where type AuthId ~sitearg~ = UserId @@ -179,17 +175,19 @@ instance YesodAuthEmail ~sitearg~ where , "" , "Thank you" ] + , partHeaders = [] } htmlPart = Part { partType = "text/html; charset=utf-8" , partEncoding = None , partFilename = Nothing , partContent = renderHtml [~qq~hamlet| -%p Please confirm your email address by clicking on the link below. -%p - %a!href=$verurl$ $verurl$ -%p Thank you +

Please confirm your email address by clicking on the link below. +

+ Thank you |] + , partHeaders = [] } getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get setVerifyKey eid key = runDB $ update eid [EmailVerkey $ Just key] diff --git a/scaffold/test_hs.cg b/scaffold/test_hs.cg new file mode 100644 index 00000000..5b0089f9 --- /dev/null +++ b/scaffold/test_hs.cg @@ -0,0 +1,11 @@ +import Controller (with~sitearg~) +import System.IO (hPutStrLn, stderr) +import Network.Wai.Middleware.Debug (debug) +import Network.Wai.Handler.Warp (run) + +main :: IO () +main = do + let port = 3000 + hPutStrLn stderr $ "Application launched, listening on port " ++ show port + with~sitearg~ $ run port . debug + diff --git a/yesod.cabal b/yesod.cabal index efe13ed9..618397ed 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -35,7 +35,7 @@ library , hamlet >= 0.7 && < 0.8 , warp >= 0.3 && < 0.4 , mime-mail >= 0.1 && < 0.2 - , hjsmin >= 0.0.5 && < 0.1 + , hjsmin >= 0.0.12 && < 0.1 exposed-modules: Yesod ghc-options: -Wall