Scaffolded site works with 0.6 (no email login)

This commit is contained in:
Michael Snoyman 2010-10-26 09:59:58 +02:00
parent 300f0a4f4d
commit ad8eeab039
5 changed files with 43 additions and 32 deletions

View File

@ -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")

View File

@ -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

View File

@ -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

View File

@ -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:

View File

@ -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 =
|~~]
}
}
-}