From ad8eeab03912b7bedc6780c279ab8be6874cde9c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 26 Oct 2010 09:59:58 +0200 Subject: [PATCH] Scaffolded site works with 0.6 (no email login) --- scaffold/Root_hs.cg | 6 +++--- scaffold/Settings_hs.cg | 14 +++++++------- scaffold/cabal.cg | 23 +++++++++++++---------- scaffold/site-arg.cg | 4 ++-- scaffold/sitearg_hs.cg | 28 ++++++++++++++++++---------- 5 files changed, 43 insertions(+), 32 deletions(-) diff --git a/scaffold/Root_hs.cg b/scaffold/Root_hs.cg index d442d350..c05d8e37 100644 --- a/scaffold/Root_hs.cg +++ b/scaffold/Root_hs.cg @@ -16,7 +16,7 @@ getRootR = do defaultLayout $ do h2id <- newIdent setTitle "~project~ homepage" - addBody $(hamletFile "homepage") - addStyle $(cassiusFile "homepage") - addJavascript $(juliusFile "homepage") + addCassius $(cassiusFile "homepage") + addJulius $(juliusFile "homepage") + addWidget $(hamletFile "homepage") diff --git a/scaffold/Settings_hs.cg b/scaffold/Settings_hs.cg index 64cce2cf..e1ba8c7f 100644 --- a/scaffold/Settings_hs.cg +++ b/scaffold/Settings_hs.cg @@ -22,7 +22,7 @@ import qualified Text.Cassius as H import qualified Text.Julius as H import Language.Haskell.TH.Syntax import Database.Persist.~upper~ -import Yesod (MonadCatchIO) +import Yesod (MonadInvertIO) -- | The base URL for your application. This will usually be different for -- development and production. Yesod automatically constructs URLs for you, @@ -93,13 +93,13 @@ connectionCount = 10 -- is used for increased performance. -- -- You can see an example of how to call these functions in Handler/Root.hs +-- +-- Note: due to polymorphic Hamlet templates, hamletFileDebug is no longer +-- used; to get the same auto-loading effect, it is recommended that you +-- use the devel server. hamletFile :: FilePath -> Q Exp -#ifdef PRODUCTION hamletFile x = H.hamletFile $ "hamlet/" ++ x ++ ".hamlet" -#else -hamletFile x = H.hamletFileDebug $ "hamlet/" ++ x ++ ".hamlet" -#endif cassiusFile :: FilePath -> Q Exp #ifdef PRODUCTION @@ -119,9 +119,9 @@ juliusFile x = H.juliusFileDebug $ "julius/" ++ x ++ ".julius" -- 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 :: MonadCatchIO m => (ConnectionPool -> m a) -> m a +withConnectionPool :: MonadInvertIO m => (ConnectionPool -> m a) -> m a withConnectionPool = with~upper~Pool connStr connectionCount -runConnectionPool :: MonadCatchIO m => SqlPersist m a -> ConnectionPool -> m a +runConnectionPool :: MonadInvertIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool = runSqlPool diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg index b9ee9e41..0cbf05fc 100644 --- a/scaffold/cabal.cg +++ b/scaffold/cabal.cg @@ -20,15 +20,18 @@ executable simple-server if flag(production) Buildable: False main-is: simple-server.hs - build-depends: base >= 4 && < 5, - yesod >= 0.5 && < 0.6, - wai-extra, - directory, - bytestring, - persistent, - persistent-~lower~, - template-haskell, - hamlet + build-depends: base >= 4 && < 5 + , yesod >= 0.6 && < 0.7 + , yesod-auth >= 0.2 && < 0.3 + , mime-mail >= 0.0 && < 0.1 + , wai-extra + , directory + , bytestring + , persistent + , persistent-~lower~ + , template-haskell + , hamlet + , web-routes ghc-options: -Wall extensions: TemplateHaskell, QuasiQuotes, TypeFamilies @@ -47,7 +50,7 @@ executable fastcgi Buildable: False cpp-options: -DPRODUCTION main-is: fastcgi.hs - build-depends: wai-handler-fastcgi + build-depends: wai-handler-fastcgi >= 0.2.2 && < 0.3 ghc-options: -Wall extensions: TemplateHaskell, QuasiQuotes, TypeFamilies diff --git a/scaffold/site-arg.cg b/scaffold/site-arg.cg index 28e7e31a..f49604c5 100644 --- a/scaffold/site-arg.cg +++ b/scaffold/site-arg.cg @@ -1,5 +1,5 @@ Great, we'll be creating ~project~ today, and placing it in ~dir~. -What's going to be the name of your site argument datatype? This name must +What's going to be the name of your foundation datatype? This name must start with a capital letter. -Site argument: +Foundation: diff --git a/scaffold/sitearg_hs.cg b/scaffold/sitearg_hs.cg index 47cb0dc8..60b5a1fd 100644 --- a/scaffold/sitearg_hs.cg +++ b/scaffold/sitearg_hs.cg @@ -14,18 +14,16 @@ module ~sitearg~ ) where import Yesod -import Yesod.Mail import Yesod.Helpers.Static import Yesod.Helpers.Auth +import Yesod.Helpers.Auth.OpenId import qualified Settings import System.Directory import qualified Data.ByteString.Lazy as L -import Yesod.WebRoutes +import Web.Routes.Site (Site (formatPathSegments)) import Database.Persist.GenericSql import Settings (hamletFile, cassiusFile, juliusFile) import Model -import Control.Monad (join) -import Data.Maybe (isJust) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -82,7 +80,7 @@ instance Yesod ~sitearg~ where mmsg <- getMessage pc <- widgetToPageContent $ do widget - addStyle $(Settings.cassiusFile "default-layout") + addCassius $(Settings.cassiusFile "default-layout") hamletToRepHtml $(Settings.hamletFile "default-layout") -- This is done to provide an optimization for serving static files from @@ -115,20 +113,29 @@ instance YesodPersist ~sitearg~ where runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db instance YesodAuth ~sitearg~ where - type AuthEntity ~sitearg~ = User - type AuthEmailEntity ~sitearg~ = Email + type AuthId ~sitearg~ = UserId - defaultDest _ = RootR + -- Where to send a user after successful login + loginDest _ = RootR + -- Where to send a user after logout + logoutDest _ = RootR - getAuthId creds _extra = runDB $ do + getAuthId creds = runDB $ do x <- getBy $ UniqueUser $ credsIdent creds case x of Just (uid, _) -> return $ Just uid Nothing -> do fmap Just $ insert $ User (credsIdent creds) Nothing - openIdEnabled _ = True + showAuthId _ x = show (fromIntegral x :: Integer) + readAuthId _ s = case reads s of + (i, _):_ -> Just $ fromInteger i + [] -> Nothing + authPlugins = [ authOpenId + ] + +{- FIXME emailSettings _ = Just EmailSettings { addUnverified = \email verkey -> runDB $ insert $ Email email Nothing (Just verkey) @@ -183,4 +190,5 @@ sendVerifyEmail' email _ verurl = |~~] } } +-}