Scaffolded site works with 0.6 (no email login)
This commit is contained in:
parent
300f0a4f4d
commit
ad8eeab039
@ -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")
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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 =
|
||||
|~~]
|
||||
}
|
||||
}
|
||||
-}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user