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 4613ed03..9888b98f 100644 Binary files a/scaffold/favicon_ico.cg and b/scaffold/favicon_ico.cg differ diff --git a/scaffold/homepage_cassius.cg b/scaffold/homepage_cassius.cg index c2873e00..2ac20924 100644 --- a/scaffold/homepage_cassius.cg +++ b/scaffold/homepage_cassius.cg @@ -1,5 +1,5 @@ h1 text-align: center -h2#$h2id$ +h2##{h2id} color: #990 diff --git a/scaffold/homepage_hamlet.cg b/scaffold/homepage_hamlet.cg index 55bf9683..727f0eb6 100644 --- a/scaffold/homepage_hamlet.cg +++ b/scaffold/homepage_hamlet.cg @@ -1,13 +1,13 @@ -%h1 Hello -%h2#$h2id$ You do not have Javascript enabled. -$maybe mu u - %p - You are logged in as $userIdent.snd.u$. $ - %a!href=@AuthR.LogoutR@ Logout - \. +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. +