yesod 0.5.0.3 → 0.5.1
raw patch · 35 files changed
+711/−627 lines, 35 filesdep +web-routesdep +xss-sanitizedep ~authenticatedep ~directorydep ~hamletbinary-added
Dependencies added: web-routes, xss-sanitize
Dependency ranges changed: authenticate, directory, hamlet, persistent, template-haskell, text
Files
- CodeGen.hs +39/−0
- CodeGenQ.hs +0/−44
- Yesod/Form/Nic.hs +2/−1
- Yesod/Form/Profiles.hs +2/−1
- Yesod/Helpers/Auth.hs +1/−1
- Yesod/Helpers/Static.hs +9/−2
- Yesod/WebRoutes.hs +2/−82
- Yesod/Widget.hs +14/−0
- Yesod/Yesod.hs +3/−0
- favicon.ico binary
- scaffold.hs +33/−464
- scaffold/Controller_hs.cg +42/−0
- scaffold/LICENSE.cg +26/−0
- scaffold/Model_hs.cg +20/−0
- scaffold/Root_hs.cg +22/−0
- scaffold/Settings_hs.cg +127/−0
- scaffold/cabal.cg +53/−0
- scaffold/database.cg +6/−0
- scaffold/default-layout_cassius.cg +3/−0
- scaffold/default-layout_hamlet.cg +10/−0
- scaffold/devel-server_hs.cg +24/−0
- scaffold/dir-name.cg +5/−0
- scaffold/fastcgi_hs.cg +6/−0
- scaffold/favicon_ico.cg binary
- scaffold/homepage_cassius.cg +5/−0
- scaffold/homepage_hamlet.cg +13/−0
- scaffold/homepage_julius.cg +4/−0
- scaffold/pconn1.cg +1/−0
- scaffold/pconn2.cg +1/−0
- scaffold/project-name.cg +4/−0
- scaffold/simple-server_hs.cg +6/−0
- scaffold/site-arg.cg +5/−0
- scaffold/sitearg_hs.cg +182/−0
- scaffold/welcome.cg +6/−0
- yesod.cabal +35/−32
+ CodeGen.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}+-- | A code generation template haskell. Everything is taken as literal text,+-- with ~var~ variable interpolation.+module CodeGen (codegen) where++import Language.Haskell.TH.Syntax+import Text.ParserCombinators.Parsec+import qualified System.IO.UTF8 as U++data Token = VarToken String | LitToken String | EmptyToken++codegen :: FilePath -> Q Exp+codegen fp = do+ s' <- qRunIO $ U.readFile $ "scaffold/" ++ fp ++ ".cg"+ let s = init s'+ case parse (many parseToken) s s of+ Left e -> error $ show e+ Right tokens' -> do+ let tokens'' = map toExp tokens'+ concat' <- [|concat|]+ return $ concat' `AppE` ListE tokens''++toExp :: Token -> Exp+toExp (LitToken s) = LitE $ StringL s+toExp (VarToken s) = VarE $ mkName s+toExp EmptyToken = LitE $ StringL ""++parseToken :: Parser Token+parseToken =+ parseVar <|> parseLit+ where+ parseVar = do+ _ <- char '~'+ s <- many alphaNum+ _ <- char '~'+ return $ if null s then EmptyToken else VarToken s+ parseLit = do+ s <- many1 $ noneOf "~"+ return $ LitToken s
− CodeGenQ.hs
@@ -1,44 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--- | A code generation quasi-quoter. Everything is taken as literal text, with ~var~ variable interpolation, and ~~ is completely ignored.-module CodeGenQ (codegen) where--import Language.Haskell.TH.Quote-import Language.Haskell.TH.Syntax-import Text.ParserCombinators.Parsec--codegen :: QuasiQuoter-codegen = QuasiQuoter codegen' $ error "codegen cannot be a pattern"--data Token = VarToken String | LitToken String | EmptyToken--codegen' :: String -> Q Exp-codegen' s' = do- let s = killFirstBlank s'- case parse (many parseToken) s s of- Left e -> error $ show e- Right tokens' -> do- let tokens'' = map toExp tokens'- concat' <- [|concat|]- return $ concat' `AppE` ListE tokens''- where- killFirstBlank ('\n':x) = x- killFirstBlank ('\r':'\n':x) = x- killFirstBlank x = x--toExp :: Token -> Exp-toExp (LitToken s) = LitE $ StringL s-toExp (VarToken s) = VarE $ mkName s-toExp EmptyToken = LitE $ StringL ""--parseToken :: Parser Token-parseToken =- parseVar <|> parseLit- where- parseVar = do- _ <- char '~'- s <- many alphaNum- _ <- char '~'- return $ if null s then EmptyToken else VarToken s- parseLit = do- s <- many1 $ noneOf "~"- return $ LitToken s
Yesod/Form/Nic.hs view
@@ -10,6 +10,7 @@ import Yesod.Hamlet import Yesod.Widget import qualified Data.ByteString.Lazy.UTF8 as U+import Text.HTML.SanitizeXSS (sanitizeXSS) class YesodNic a where -- | NIC Editor.@@ -24,7 +25,7 @@ nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html nicHtmlFieldProfile = FieldProfile- { fpParse = Right . preEscapedString+ { fpParse = Right . preEscapedString . sanitizeXSS , fpRender = U.toString . renderHtml , fpWidget = \theId name val _isReq -> do addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
Yesod/Form/Profiles.hs view
@@ -27,6 +27,7 @@ import qualified Text.Email.Validate as Email import Network.URI (parseURI) import Database.Persist (PersistField)+import Text.HTML.SanitizeXSS (sanitizeXSS) import Text.Blaze.Builder.Utf8 (writeChar) import Text.Blaze.Builder.Core (writeList, writeByteString)@@ -77,7 +78,7 @@ htmlFieldProfile :: FieldProfile sub y Html htmlFieldProfile = FieldProfile- { fpParse = Right . preEscapedString+ { fpParse = Right . preEscapedString . sanitizeXSS , fpRender = U.toString . renderHtml , fpWidget = \theId name val _isReq -> addBody [$hamlet| %textarea.html#$theId$!name=$name$ $val$
Yesod/Helpers/Auth.hs view
@@ -571,7 +571,7 @@ %p %a!href=$f$ Login via Facebook $maybe rpxnowSettings.y r- %h3 OpenID+ %h3 Rpxnow %p %a!onclick="return false;"!href="https://$rpxnowApp.r$.rpxnow.com/openid/v2/signin?token_url=@tm.RpxnowR@" Login via Rpxnow
Yesod/Helpers/Static.hs view
@@ -67,6 +67,13 @@ , staticTypes :: [(String, ContentType)] } +-- | Manually construct a static route.+-- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.+-- For example, +-- > StaticRoute $ StaticR ["thumb001.jpg"] [("foo", "5"), ("bar", "choc")]+-- would generate a url such as 'http://site.com/static/thumb001.jpg?foo=5&bar=choc'+-- The StaticRoute constructor can be used when url's cannot be statically generated at compile-time.+-- E.g. When generating image galleries. data StaticRoute = StaticRoute [String] [(String, String)] deriving (Eq, Show, Read) @@ -138,8 +145,8 @@ -- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create: ----- > style_css = StaticRoute ["style.css"]--- > js_script_js = StaticRoute ["js/script.js"]+-- > style_css = StaticRoute ["style.css"] []+-- > js_script_js = StaticRoute ["js/script.js"] [] staticFiles :: FilePath -> Q [Dec] staticFiles fp = do fs <- qRunIO $ getFileList fp
Yesod/WebRoutes.hs view
@@ -4,85 +4,5 @@ , Site (..) ) where -import Codec.Binary.UTF8.String (encodeString)-import Data.List (intercalate)-import Network.URI--encodePathInfo :: [String] -> [(String, String)] -> String-encodePathInfo pieces qs = - let x = map encodeString `o` -- utf-8 encode the data characters in path components (we have not added any delimiters yet)- map (escapeURIString (\c -> isUnreserved c || c `elem` ":@&=+$,")) `o` -- percent encode the characters- map (\str -> case str of "." -> "%2E" ; ".." -> "%2E%2E" ; _ -> str) `o` -- encode . and ..- intercalate "/" -- add in the delimiters- y = showParams qs- in x pieces ++ y- where- -- reverse composition - o :: (a -> b) -> (b -> c) -> a -> c- o = flip (.)--{-|--A site groups together the three functions necesary to make an application:--* A function to convert from the URL type to path segments.--* A function to convert from path segments to the URL, if possible.--* A function to return the application for a given URL.--There are two type parameters for Site: the first is the URL datatype, the-second is the application datatype. The application datatype will depend upon-your server backend.--}-data Site url a- = Site {- {-|- Return the appropriate application for a given URL.-- The first argument is a function which will give an appropriate- URL (as a String) for a URL datatype. This is usually- constructed by a combination of 'formatPathSegments' and the- prepending of an absolute application root.-- Well behaving applications should use this function to- generating all internal URLs.- -}- handleSite :: (url -> [(String, String)] -> String) -> url -> a- -- | This function must be the inverse of 'parsePathSegments'.- , formatPathSegments :: url -> ([String], [(String, String)])- -- | This function must be the inverse of 'formatPathSegments'.- , parsePathSegments :: [String] -> Either String url- }--showParams :: [(String, String)] -> String-showParams [] = ""-showParams z =- '?' : intercalate "&" (map go z)- where- go (x, "") = go' x- go (x, y) = go' x ++ '=' : go' y- go' = concatMap encodeUrlChar---- | Taken straight from web-encodings; reimplemented here to avoid extra--- dependencies.-encodeUrlChar :: Char -> String-encodeUrlChar c- -- List of unreserved characters per RFC 3986- -- Gleaned from http://en.wikipedia.org/wiki/Percent-encoding- | 'A' <= c && c <= 'Z' = [c]- | 'a' <= c && c <= 'z' = [c]- | '0' <= c && c <= '9' = [c]-encodeUrlChar c@'-' = [c]-encodeUrlChar c@'_' = [c]-encodeUrlChar c@'.' = [c]-encodeUrlChar c@'~' = [c]-encodeUrlChar ' ' = "+"-encodeUrlChar y =- let (a, c) = fromEnum y `divMod` 16- b = a `mod` 16- showHex' x- | x < 10 = toEnum $ x + (fromEnum '0')- | x < 16 = toEnum $ x - 10 + (fromEnum 'A')- | otherwise = error $ "Invalid argument to showHex: " ++ show x- in ['%', showHex' b, showHex' c]+import Web.Routes.Base (encodePathInfo)+import Web.Routes.Site (Site (..))
Yesod/Widget.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} -- | Widgets combine HTML with JS and CSS dependencies with a unique identifier -- generator, allowing you to create truly modular HTML components. module Yesod.Widget@@ -60,6 +61,19 @@ mappend x y = x >> y -- | A 'GWidget' specialized to when the subsite and master site are the same. type Widget y = GWidget y y++instance HamletValue (GWidget s m ()) where+ newtype HamletMonad (GWidget s m ()) a =+ GWidget' { runGWidget' :: GWidget s m a }+ type HamletUrl (GWidget s m ()) = Route m+ toHamletValue = runGWidget'+ htmlToHamletMonad = GWidget' . addBody . const+ urlToHamletMonad url params = GWidget' $+ addBody $ \r -> preEscapedString (r url params)+ fromHamletValue = GWidget'+instance Monad (HamletMonad (GWidget s m ())) where+ return = GWidget' . return+ x >>= y = GWidget' $ runGWidget' x >>= runGWidget' . y -- | Lift an action in the 'GHandler' monad into an action in the 'GWidget' -- monad.
Yesod/Yesod.hs view
@@ -112,6 +112,7 @@ defaultLayout :: GWidget sub a () -> GHandler sub a RepHtml defaultLayout w = do p <- widgetToPageContent w+ mmsg <- getMessage hamletToRepHtml [$hamlet| !!! %html@@ -119,6 +120,8 @@ %title $pageTitle.p$ ^pageHead.p^ %body+ $maybe mmsg msg+ %p.message $msg$ ^pageBody.p^ |]
− favicon.ico
binary file changed (1150 → absent bytes)
scaffold.hs view
@@ -1,70 +1,47 @@-{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}-import CodeGenQ+{-# LANGUAGE TemplateHaskell #-}+import CodeGen import System.IO import System.Directory import qualified Data.ByteString.Char8 as S import Language.Haskell.TH.Syntax+import Data.Time (getCurrentTime, utctDay, toGregorian)+import Control.Applicative ((<$>)) main :: IO () main = do- putStr [$codegen|Welcome to the Yesod scaffolder.-I'm going to be creating a skeleton Yesod project for you.--What is your name? We're going to put this in the cabal and LICENSE files.--Your name: |]+ putStr $(codegen "welcome") hFlush stdout name <- getLine - putStr [$codegen|-Welcome ~name~.-What do you want to call your project? We'll use this for the cabal name.--Project name: |]+ putStr $(codegen "project-name") hFlush stdout project <- getLine - putStr [$codegen|-Now where would you like me to place your generated files? I'm smart enough-to create the directories, don't worry about that. If you leave this answer-blank, we'll place the files in ~project~.--Directory name: |]+ putStr $(codegen "dir-name") hFlush stdout dirRaw <- getLine let dir = if null dirRaw then project else dirRaw - putStr [$codegen|-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-start with a capital letter.--Site argument: |]+ putStr $(codegen "site-arg") hFlush stdout sitearg <- getLine - putStr [$codegen|-That's it! I'm creating your files now...-|]-- putStr [$codegen|-Yesod uses Persistent for its (you guessed it) persistence layer.-This tool will build in either SQLite or PostgreSQL support for you. If you-want to use a different backend, you'll have to make changes manually.-If you're not sure, stick with SQLite: it has no dependencies.--So, what'll it be? s for sqlite, p for postgresql: |]+ putStr $(codegen "database") hFlush stdout backendS <- getLine- let pconn1 = [$codegen|user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_debug|]- let pconn2 = [$codegen|user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_production|]+ let pconn1 = $(codegen "pconn1")+ let pconn2 = $(codegen "pconn2") let (lower, upper, connstr1, connstr2) = case backendS of "s" -> ("sqlite", "Sqlite", "debug.db3", "production.db3") "p" -> ("postgresql", "Postgresql", pconn1, pconn2) _ -> error $ "Invalid backend: " ++ backendS + putStrLn "That's it! I'm creating your files now..." + let fst3 (x, _, _) = x+ year <- show . fst3 . toGregorian . utctDay <$> getCurrentTime+ let writeFile' fp s = do putStrLn $ "Generating " ++ fp writeFile (dir ++ '/' : fp) s@@ -75,433 +52,25 @@ mkDir "cassius" mkDir "julius" - writeFile' "simple-server.hs" [$codegen|-import Controller-import Network.Wai.Handler.SimpleServer (run)--main :: IO ()-main = putStrLn "Loaded" >> with~sitearg~ (run 3000)-|]-- writeFile' "fastcgi.hs" [$codegen|-import Controller-import Network.Wai.Handler.FastCGI (run)--main :: IO ()-main = with~sitearg~ run-|]-- writeFile' (project ++ ".cabal") [$codegen|-name: ~project~-version: 0.0.0-license: BSD3-license-file: LICENSE-author: ~name~-maintainer: ~name~-synopsis: The greatest Yesod web application ever.-description: I'm sure you can say something clever here if you try.-category: Web-stability: Experimental-cabal-version: >= 1.6-build-type: Simple-homepage: http://www.yesodweb.com/~project~--Flag production- Description: Build the production executable.- Default: False--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- ghc-options: -Wall- extensions: TemplateHaskell, QuasiQuotes, TypeFamilies--executable fastcgi- if flag(production)- Buildable: True- else- Buildable: False- cpp-options: -DPRODUCTION- main-is: fastcgi.hs- build-depends: wai-handler-fastcgi- ghc-options: -Wall- extensions: TemplateHaskell, QuasiQuotes, TypeFamilies-|]-- writeFile' "LICENSE" [$codegen|-The following license covers this documentation, and the source code, except-where otherwise indicated.--Copyright 2010, ~name~. All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--* Redistributions of source code must retain the above copyright notice, this- list of conditions and the following disclaimer.--* Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR-IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO-EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,-INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT-NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,-OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE-OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-|]-- writeFile' (sitearg ++ ".hs") [$codegen|-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}-module ~sitearg~- ( ~sitearg~ (..)- , ~sitearg~Route (..)- , resources~sitearg~- , Handler- , maybeAuth- , requireAuth- , module Yesod- , module Settings- , module Model- , StaticRoute (..)- , AuthRoute (..)- ) where--import Yesod-import Yesod.Mail-import Yesod.Helpers.Static-import Yesod.Helpers.Auth-import qualified Settings-import System.Directory-import qualified Data.ByteString.Lazy as L-import Yesod.WebRoutes-import Database.Persist.GenericSql-import Settings (hamletFile, cassiusFile, juliusFile)-import Model-import Control.Monad (join)-import Data.Maybe (isJust)--data ~sitearg~ = ~sitearg~- { getStatic :: Static- , connPool :: Settings.ConnectionPool- }--type Handler = GHandler ~sitearg~ ~sitearg~--mkYesodData "~sitearg~" [$parseRoutes|-/static StaticR Static getStatic-/auth AuthR Auth getAuth--/favicon.ico FaviconR GET-/robots.txt RobotsR GET--/ RootR GET-|~~]--instance Yesod ~sitearg~ where- approot _ = Settings.approot- defaultLayout widget = do- mmsg <- getMessage- pc <- widgetToPageContent $ do- widget- addStyle $(Settings.cassiusFile "default-layout")- hamletToRepHtml $(Settings.hamletFile "default-layout")- 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- urlRenderOverride _ _ = Nothing- authRoute _ = Just $ AuthR LoginR- addStaticContent ext' _ content = do- let fn = base64md5 content ++ '.' : ext'- let statictmp = Settings.staticdir ++ "/tmp/"- liftIO $ createDirectoryIfMissing True statictmp- liftIO $ L.writeFile (statictmp ++ fn) content- return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])--instance YesodPersist ~sitearg~ where- type YesodDB ~sitearg~ = SqlPersist- runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db--instance YesodAuth ~sitearg~ where- type AuthEntity ~sitearg~ = User- type AuthEmailEntity ~sitearg~ = Email-- defaultDest _ = RootR-- getAuthId creds _extra = 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-- emailSettings _ = Just EmailSettings- { addUnverified = \email verkey ->- runDB $ insert $ Email email Nothing (Just verkey)- , sendVerifyEmail = sendVerifyEmail'- , getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get- , setVerifyKey = \eid key -> runDB $ update eid [EmailVerkey $ Just key]- , verifyAccount = \eid -> runDB $ do- me <- get eid- case me of- Nothing -> return Nothing- Just e -> do- let email = emailEmail e- case emailUser e of- Just uid -> return $ Just uid- Nothing -> do- uid <- insert $ User email Nothing- update eid [EmailUser $ Just uid]- return $ Just uid- , getPassword = runDB . fmap (join . fmap userPassword) . get- , setPassword = \uid pass -> runDB $ update uid [UserPassword $ Just pass]- , getEmailCreds = \email -> runDB $ do- me <- getBy $ UniqueEmail email- case me of- Nothing -> return Nothing- Just (eid, e) -> return $ Just EmailCreds- { emailCredsId = eid- , emailCredsAuthId = emailUser e- , emailCredsStatus = isJust $ emailUser e- , emailCredsVerkey = emailVerkey e- }- , getEmail = runDB . fmap (fmap emailEmail) . get- }--sendVerifyEmail' :: String -> String -> String -> GHandler Auth m ()-sendVerifyEmail' email _ verurl =- liftIO $ renderSendMail Mail- { mailHeaders =- [ ("From", "noreply")- , ("To", email)- , ("Subject", "Verify your email address")- ]- , mailPlain = verurl- , mailParts = return Part- { partType = "text/html; charset=utf-8"- , partEncoding = None- , partDisposition = Inline- , partContent = renderHamlet id [$hamlet|-%p Please confirm your email address by clicking on the link below.-%p- %a!href=$verurl$ $verurl$-%p Thank you-|~~]- }- }-|]-- writeFile' "Controller.hs" [$codegen|-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Controller- ( with~sitearg~- ) where--import ~sitearg~-import Settings-import Yesod.Helpers.Static-import Yesod.Helpers.Auth-import Database.Persist.GenericSql--import Handler.Root--mkYesodDispatch "~sitearg~" resources~sitearg~--getFaviconR :: Handler ()-getFaviconR = sendFile "image/x-icon" "favicon.ico"--getRobotsR :: Handler RepPlain-getRobotsR = return $ RepPlain $ toContent "User-agent: *"--with~sitearg~ :: (Application -> IO a) -> IO a-with~sitearg~ f = Settings.withConnectionPool $ \p -> do- flip runConnectionPool p $ runMigration $ do- migrate (undefined :: User)- migrate (undefined :: Email)- let h = ~sitearg~ s p- toWaiApp h >>= f- where- s = fileLookupDir Settings.staticdir typeByExt-|]-- writeFile' "Handler/Root.hs" [$codegen|-{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}-module Handler.Root where--import ~sitearg~--getRootR :: Handler RepHtml-getRootR = do- mu <- maybeAuth- defaultLayout $ do- h2id <- newIdent- setTitle "~project~ homepage"- addBody $(hamletFile "homepage")- addStyle $(cassiusFile "homepage")- addJavascript $(juliusFile "homepage")-|]-- writeFile' "Model.hs" [$codegen|-{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}-module Model where--import Yesod--mkPersist [$persist|-User- ident String- password String null update- UniqueUser ident-Email- email String- user UserId null update- verkey String null update- UniqueEmail email-|~~]-|]-- writeFile' "Settings.hs" [$codegen|-{-# LANGUAGE CPP #-}-module Settings- ( hamletFile- , cassiusFile- , juliusFile- , connStr- , ConnectionPool- , withConnectionPool- , runConnectionPool- , approot- , staticroot- , staticdir- ) where--import qualified Text.Hamlet as H-import qualified Text.Cassius as H-import qualified Text.Julius as H-import Language.Haskell.TH.Syntax-import Database.Persist.~upper~-import Yesod (MonadCatchIO)--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-cassiusFile x = H.cassiusFile $ "cassius/" ++ x ++ ".cassius"-#else-cassiusFile x = H.cassiusFileDebug $ "cassius/" ++ x ++ ".cassius"-#endif--juliusFile :: FilePath -> Q Exp-#ifdef PRODUCTION-juliusFile x = H.juliusFile $ "julius/" ++ x ++ ".julius"-#else-juliusFile x = H.juliusFileDebug $ "julius/" ++ x ++ ".julius"-#endif--connStr :: String-#ifdef PRODUCTION-connStr = "~connstr2~"-#else-connStr = "~connstr1~"-#endif--connectionCount :: Int-connectionCount = 10--withConnectionPool :: MonadCatchIO m => (ConnectionPool -> m a) -> m a-withConnectionPool = with~upper~Pool connStr connectionCount--runConnectionPool :: MonadCatchIO m => SqlPersist m a -> ConnectionPool -> m a-runConnectionPool = runSqlPool--approot :: String-#ifdef PRODUCTION-approot = "http://localhost:3000"-#else-approot = "http://localhost:3000"-#endif--staticroot :: String-staticroot = approot ++ "/static"--staticdir :: FilePath-staticdir = "static"-|]-- writeFile' "cassius/default-layout.cassius" [$codegen|-body- font-family: sans-serif-|]-- writeFile' "hamlet/default-layout.hamlet" [$codegen|-!!!-%html- %head- %title $pageTitle.pc$- ^pageHead.pc^- %body- $maybe mmsg msg- #message $msg$- ^pageBody.pc^-|]-- writeFile' "hamlet/homepage.hamlet" [$codegen|-%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- \.-$nothing- %p- You are not logged in. $- %a!href=@AuthR.LoginR@ Login now- \.-|]-- writeFile' "cassius/homepage.cassius" [$codegen|-body- font-family: sans-serif-h1- text-align: center-h2#$h2id$- color: #990-|]-- writeFile' "julius/homepage.julius" [$codegen|-window.onload = function(){- document.getElementById("%h2id%").innerHTML = "<i>Added from JavaScript.</i>";-}-|]+ writeFile' "simple-server.hs" $(codegen "simple-server_hs")+ writeFile' "fastcgi.hs" $(codegen "fastcgi_hs")+ writeFile' "devel-server.hs" $(codegen "devel-server_hs")+ writeFile' (project ++ ".cabal") $(codegen "cabal")+ writeFile' "LICENSE" $(codegen "LICENSE")+ writeFile' (sitearg ++ ".hs") $(codegen "sitearg_hs")+ writeFile' "Controller.hs" $(codegen "Controller_hs")+ writeFile' "Handler/Root.hs" $(codegen "Root_hs")+ writeFile' "Model.hs" $(codegen "Model_hs")+ writeFile' "Settings.hs" $(codegen "Settings_hs")+ writeFile' "cassius/default-layout.cassius"+ $(codegen "default-layout_cassius")+ writeFile' "hamlet/default-layout.hamlet"+ $(codegen "default-layout_hamlet")+ writeFile' "hamlet/homepage.hamlet" $(codegen "homepage_hamlet")+ writeFile' "cassius/homepage.cassius" $(codegen "homepage_cassius")+ writeFile' "julius/homepage.julius" $(codegen "homepage_julius") S.writeFile (dir ++ "/favicon.ico")- $(runIO (S.readFile "favicon.ico") >>= \bs -> do+ $(runIO (S.readFile "scaffold/favicon_ico.cg") >>= \bs -> do pack <- [|S.pack|] return $ pack `AppE` LitE (StringL $ S.unpack bs))
+ scaffold/Controller_hs.cg view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Controller+ ( with~sitearg~+ ) where++import ~sitearg~+import Settings+import Yesod.Helpers.Static+import Yesod.Helpers.Auth+import Database.Persist.GenericSql++-- Import all relevant handler modules here.+import Handler.Root++-- This line actually creates our YesodSite instance. It is the second half+-- of the call to mkYesodData which occurs in ~sitearg~.hs. Please see+-- the comments there for more details.+mkYesodDispatch "~sitearg~" resources~sitearg~++-- Some default handlers that ship with the Yesod site template. You will+-- very rarely need to modify this.+getFaviconR :: Handler ()+getFaviconR = sendFile "image/x-icon" "favicon.ico"++getRobotsR :: Handler RepPlain+getRobotsR = return $ RepPlain $ toContent "User-agent: *"++-- This function allocates resources (such as a database connection pool),+-- performs initialization and creates a WAI application. This is also the+-- place to put your migrate statements to have automatic database+-- migrations handled by Yesod.+with~sitearg~ :: (Application -> IO a) -> IO a+with~sitearg~ f = Settings.withConnectionPool $ \p -> do+ flip runConnectionPool p $ runMigration $ do+ migrate (undefined :: User)+ migrate (undefined :: Email)+ let h = ~sitearg~ s p+ toWaiApp h >>= f+ where+ s = fileLookupDir Settings.staticdir typeByExt+
+ scaffold/LICENSE.cg view
@@ -0,0 +1,26 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright ~year~, ~name~. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ scaffold/Model_hs.cg view
@@ -0,0 +1,20 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving #-}+module Model where++import Yesod++-- You can define all of your database entities here. You can find more+-- information on persistent and how to declare entities at:+-- http://docs.yesodweb.com/book/persistent/+mkPersist [$persist|+User+ ident String+ password String null update+ UniqueUser ident+Email+ email String+ user UserId null update+ verkey String null update+ UniqueEmail email+|]+
+ scaffold/Root_hs.cg view
@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}+module Handler.Root where++import ~sitearg~++-- This is a handler function for the GET request method on the RootR+-- resource pattern. All of your resource patterns are defined in+-- ~sitearg~.hs; look for the line beginning with mkYesodData.+--+-- The majority of the code you will write in Yesod lives in these handler+-- functions. You can spread them across multiple files if you are so+-- inclined, or create a single monolithic file.+getRootR :: Handler RepHtml+getRootR = do+ mu <- maybeAuth+ defaultLayout $ do+ h2id <- newIdent+ setTitle "~project~ homepage"+ addBody $(hamletFile "homepage")+ addStyle $(cassiusFile "homepage")+ addJavascript $(juliusFile "homepage")+
+ scaffold/Settings_hs.cg view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}+-- | Settings are centralized, as much as possible, into this file. This+-- includes database connection settings, static file locations, etc.+-- In addition, you can configure a number of different aspects of Yesod+-- by overriding methods in the Yesod typeclass. That instance is+-- declared in the ~sitearg~.hs file.+module Settings+ ( hamletFile+ , cassiusFile+ , juliusFile+ , connStr+ , ConnectionPool+ , withConnectionPool+ , runConnectionPool+ , approot+ , staticroot+ , staticdir+ ) where++import qualified Text.Hamlet as H+import qualified Text.Cassius as H+import qualified Text.Julius as H+import Language.Haskell.TH.Syntax+import Database.Persist.~upper~+import Yesod (MonadCatchIO)++-- | The base URL for your application. This will usually be different for+-- development and production. Yesod automatically constructs URLs for you,+-- so this value must be accurate to create valid links.+approot :: String+#ifdef PRODUCTION+-- You probably want to change this. If your domain name was "yesod.com",+-- you would probably want it to be:+-- > approot = "http://www.yesod.com"+-- Please note that there is no trailing slash.+approot = "http://localhost:3000"+#else+approot = "http://localhost:3000"+#endif++-- | The location of static files on your system. This is a file system+-- path. The default value works properly with your scaffolded site.+staticdir :: FilePath+staticdir = "static"++-- | The base URL for your static files. As you can see by the default+-- value, this can simply be "static" appended to your application root.+-- A powerful optimization can be serving static files from a separate+-- domain name. This allows you to use a web server optimized for static+-- files, more easily set expires and cache values, and avoid possibly+-- costly transference of cookies on static files. For more information,+-- please see:+-- http://code.google.com/speed/page-speed/docs/request.html#ServeFromCookielessDomain+--+-- If you change the resource pattern for StaticR in ~sitearg~.hs, you will+-- have to make a corresponding change here.+--+-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs+staticroot :: String+staticroot = approot ++ "/static"++-- | The database connection string. The meaning of this string is backend-+-- specific.+connStr :: String+#ifdef PRODUCTION+connStr = "~connstr2~"+#else+connStr = "~connstr1~"+#endif++-- | Your application will keep a connection pool and take connections from+-- there as necessary instead of continually creating new connections. This+-- value gives the maximum number of connections to be open at a given time.+-- If your application requests a connection when all connections are in+-- use, that request will fail. Try to choose a number that will work well+-- with the system resources available to you while providing enough+-- connections for your expected load.+--+-- Also, connections are returned to the pool as quickly as possible by+-- Yesod to avoid resource exhaustion. A connection is only considered in+-- use while within a call to runDB.+connectionCount :: Int+connectionCount = 10++-- The rest of this file contains settings which rarely need changing by a+-- user.++-- The following three functions are used for calling HTML, CSS and+-- Javascript templates from your Haskell code. During development,+-- the "Debug" versions of these functions are used so that changes to+-- the templates are immediately reflected in an already running+-- application. When making a production compile, the non-debug version+-- is used for increased performance.+--+-- You can see an example of how to call these functions in Handler/Root.hs++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+cassiusFile x = H.cassiusFile $ "cassius/" ++ x ++ ".cassius"+#else+cassiusFile x = H.cassiusFileDebug $ "cassius/" ++ x ++ ".cassius"+#endif++juliusFile :: FilePath -> Q Exp+#ifdef PRODUCTION+juliusFile x = H.juliusFile $ "julius/" ++ x ++ ".julius"+#else+juliusFile x = H.juliusFileDebug $ "julius/" ++ x ++ ".julius"+#endif++-- The next two functions are for allocating a connection pool and running+-- 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 = with~upper~Pool connStr connectionCount++runConnectionPool :: MonadCatchIO m => SqlPersist m a -> ConnectionPool -> m a+runConnectionPool = runSqlPool+
+ scaffold/cabal.cg view
@@ -0,0 +1,53 @@+name: ~project~+version: 0.0.0+license: BSD3+license-file: LICENSE+author: ~name~+maintainer: ~name~+synopsis: The greatest Yesod web application ever.+description: I'm sure you can say something clever here if you try.+category: Web+stability: Experimental+cabal-version: >= 1.6+build-type: Simple+homepage: http://~project~.yesodweb.com/++Flag production+ Description: Build the production executable.+ Default: False++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+ ghc-options: -Wall+ extensions: TemplateHaskell, QuasiQuotes, TypeFamilies++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++executable fastcgi+ if flag(production)+ Buildable: True+ else+ Buildable: False+ cpp-options: -DPRODUCTION+ main-is: fastcgi.hs+ build-depends: wai-handler-fastcgi+ ghc-options: -Wall+ extensions: TemplateHaskell, QuasiQuotes, TypeFamilies+
+ scaffold/database.cg view
@@ -0,0 +1,6 @@+Yesod uses Persistent for its (you guessed it) persistence layer.+This tool will build in either SQLite or PostgreSQL support for you. If you+want to use a different backend, you'll have to make changes manually.+If you're not sure, stick with SQLite: it has no dependencies.++So, what'll it be? s for sqlite, p for postgresql:
+ scaffold/default-layout_cassius.cg view
@@ -0,0 +1,3 @@+body+ font-family: sans-serif+
+ scaffold/default-layout_hamlet.cg view
@@ -0,0 +1,10 @@+!!!+%html+ %head+ %title $pageTitle.pc$+ ^pageHead.pc^+ %body+ $maybe mmsg msg+ #message $msg$+ ^pageBody.pc^+
+ scaffold/devel-server_hs.cg view
@@ -0,0 +1,24 @@+import Network.Wai.Handler.DevelServer (run)+import Control.Concurrent (forkIO)++main :: IO ()+main = do+ mapM_ putStrLn+ [ "Starting your server process. Code changes will be automatically"+ , "loaded as you save your files. Type \"quit\" to exit."+ , "You can view your app at http://localhost:3000/"+ , ""+ ]+ _ <- forkIO $ run 3000 "Controller" "with~sitearg~"+ [ "hamlet"+ , "cassius"+ , "julius"+ ]+ go+ where+ go = do+ x <- getLine+ case x of+ 'q':_ -> putStrLn "Quitting, goodbye!"+ _ -> go+
+ scaffold/dir-name.cg view
@@ -0,0 +1,5 @@+Now where would you like me to place your generated files? I'm smart enough+to create the directories, don't worry about that. If you leave this answer+blank, we'll place the files in ~project~.++Directory name:
+ scaffold/fastcgi_hs.cg view
@@ -0,0 +1,6 @@+import Controller+import Network.Wai.Handler.FastCGI (run)++main :: IO ()+main = with~sitearg~ run+
+ scaffold/favicon_ico.cg view
binary file changed (absent → 1150 bytes)
+ scaffold/homepage_cassius.cg view
@@ -0,0 +1,5 @@+h1+ text-align: center+h2#$h2id$+ color: #990+
+ scaffold/homepage_hamlet.cg view
@@ -0,0 +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+ \.+$nothing+ %p+ You are not logged in. $+ %a!href=@AuthR.LoginR@ Login now+ \.+
+ scaffold/homepage_julius.cg view
@@ -0,0 +1,4 @@+window.onload = function(){+ document.getElementById("%h2id%").innerHTML = "<i>Added from JavaScript.</i>";+}+
+ scaffold/pconn1.cg view
@@ -0,0 +1,1 @@+user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_debug
+ scaffold/pconn2.cg view
@@ -0,0 +1,1 @@+user=~project~ password=~project~ host=localhost port=5432 dbname=~project~_production
+ scaffold/project-name.cg view
@@ -0,0 +1,4 @@+Welcome ~name~.+What do you want to call your project? We'll use this for the cabal name.++Project name:
+ scaffold/simple-server_hs.cg view
@@ -0,0 +1,6 @@+import Controller+import Network.Wai.Handler.SimpleServer (run)++main :: IO ()+main = putStrLn "Loaded" >> with~sitearg~ (run 3000)+
+ scaffold/site-arg.cg view
@@ -0,0 +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+start with a capital letter.++Site argument:
+ scaffold/sitearg_hs.cg view
@@ -0,0 +1,182 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}+module ~sitearg~+ ( ~sitearg~ (..)+ , ~sitearg~Route (..)+ , resources~sitearg~+ , Handler+ , maybeAuth+ , requireAuth+ , module Yesod+ , module Settings+ , module Model+ , StaticRoute (..)+ , AuthRoute (..)+ ) where++import Yesod+import Yesod.Mail+import Yesod.Helpers.Static+import Yesod.Helpers.Auth+import qualified Settings+import System.Directory+import qualified Data.ByteString.Lazy as L+import Yesod.WebRoutes+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+-- starts running, such as database connections. Every handler will have+-- access to the data present here.+data ~sitearg~ = ~sitearg~+ { getStatic :: Static -- ^ Settings for static file serving.+ , connPool :: Settings.ConnectionPool -- ^ Database connection pool.+ }++-- | A useful synonym; most of the handler functions in your application+-- will need to be of this type.+type Handler = GHandler ~sitearg~ ~sitearg~++-- This is where we define all of the routes in our application. For a full+-- explanation of the syntax, please see:+-- http://docs.yesodweb.com/book/web-routes-quasi/+--+-- This function does three things:+--+-- * Creates the route datatype ~sitearg~Route. Every valid URL in your+-- application can be represented as a value of this type.+-- * Creates the associated type:+-- type instance Route ~sitearg~ = ~sitearg~Route+-- * Creates the value resources~sitearg~ which contains information on the+-- resources declared below. This is used in Controller.hs by the call to+-- mkYesodDispatch+--+-- What this function does *not* do is create a YesodSite instance for+-- ~sitearg~. Creating that instance requires all of the handler functions+-- for our application to be in scope. However, the handler functions+-- usually require access to the ~sitearg~Route datatype. Therefore, we+-- split these actions into two functions and place them in separate files.+mkYesodData "~sitearg~" [$parseRoutes|+/static StaticR Static getStatic+/auth AuthR Auth getAuth++/favicon.ico FaviconR GET+/robots.txt RobotsR GET++/ RootR GET+|]++-- Please see the documentation for the Yesod typeclass. There are a number+-- of settings which can be configured by overriding methods here.+instance Yesod ~sitearg~ where+ approot _ = Settings.approot++ defaultLayout widget = do+ mmsg <- getMessage+ pc <- widgetToPageContent $ do+ widget+ addStyle $(Settings.cassiusFile "default-layout")+ hamletToRepHtml $(Settings.hamletFile "default-layout")++ -- 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+ urlRenderOverride _ _ = Nothing++ -- The page to be redirected to when authentication is required.+ authRoute _ = Just $ AuthR LoginR++ -- This function creates static content files in the static folder+ -- and names them based on a hash of their content. This allows+ -- expiration dates to be set far in the future without worry of+ -- users receiving stale content.+ addStaticContent ext' _ content = do+ let fn = base64md5 content ++ '.' : ext'+ let statictmp = Settings.staticdir ++ "/tmp/"+ liftIO $ createDirectoryIfMissing True statictmp+ liftIO $ L.writeFile (statictmp ++ fn) content+ return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])++-- How to run database actions.+instance YesodPersist ~sitearg~ where+ type YesodDB ~sitearg~ = SqlPersist+ runDB db = fmap connPool getYesod >>= Settings.runConnectionPool db++instance YesodAuth ~sitearg~ where+ type AuthEntity ~sitearg~ = User+ type AuthEmailEntity ~sitearg~ = Email++ defaultDest _ = RootR++ getAuthId creds _extra = 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++ emailSettings _ = Just EmailSettings+ { addUnverified = \email verkey ->+ runDB $ insert $ Email email Nothing (Just verkey)+ , sendVerifyEmail = sendVerifyEmail'+ , getVerifyKey = runDB . fmap (join . fmap emailVerkey) . get+ , setVerifyKey = \eid key -> runDB $ update eid [EmailVerkey $ Just key]+ , verifyAccount = \eid -> runDB $ do+ me <- get eid+ case me of+ Nothing -> return Nothing+ Just e -> do+ let email = emailEmail e+ case emailUser e of+ Just uid -> return $ Just uid+ Nothing -> do+ uid <- insert $ User email Nothing+ update eid [EmailUser $ Just uid]+ return $ Just uid+ , getPassword = runDB . fmap (join . fmap userPassword) . get+ , setPassword = \uid pass -> runDB $ update uid [UserPassword $ Just pass]+ , getEmailCreds = \email -> runDB $ do+ me <- getBy $ UniqueEmail email+ case me of+ Nothing -> return Nothing+ Just (eid, e) -> return $ Just EmailCreds+ { emailCredsId = eid+ , emailCredsAuthId = emailUser e+ , emailCredsStatus = isJust $ emailUser e+ , emailCredsVerkey = emailVerkey e+ }+ , getEmail = runDB . fmap (fmap emailEmail) . get+ }++sendVerifyEmail' :: String -> String -> String -> GHandler Auth m ()+sendVerifyEmail' email _ verurl =+ liftIO $ renderSendMail Mail+ { mailHeaders =+ [ ("From", "noreply")+ , ("To", email)+ , ("Subject", "Verify your email address")+ ]+ , mailPlain = verurl+ , mailParts = return Part+ { partType = "text/html; charset=utf-8"+ , partEncoding = None+ , partDisposition = Inline+ , partContent = renderHamlet id [$hamlet|+%p Please confirm your email address by clicking on the link below.+%p+ %a!href=$verurl$ $verurl$+%p Thank you+|~~]+ }+ }+
+ scaffold/welcome.cg view
@@ -0,0 +1,6 @@+Welcome to the Yesod scaffolder.+I'm going to be creating a skeleton Yesod project for you.++What is your name? We're going to put this in the cabal and LICENSE files.++Your name:
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 0.5.0.3+version: 0.5.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -13,42 +13,44 @@ stability: Stable cabal-version: >= 1.6 build-type: Simple-homepage: http://docs.yesodweb.com/yesod/-extra-source-files: favicon.ico+homepage: http://docs.yesodweb.com/+extra-source-files: scaffold/*.cg flag buildtests description: Build the executable to run unit tests default: False library- build-depends: base >= 4 && < 5,- time >= 1.1.4 && < 1.3,- wai >= 0.2.0 && < 0.3,- wai-extra >= 0.2.2 && < 0.3,- authenticate >= 0.6.3 && < 0.7,- bytestring >= 0.9.1.4 && < 0.10,- directory >= 1 && < 1.1,- text >= 0.5 && < 0.9,- utf8-string >= 0.3.4 && < 0.4,- template-haskell >= 2.4 && < 2.5,- web-routes-quasi >= 0.6 && < 0.7,- hamlet >= 0.5.0 && < 0.6,- blaze-builder >= 0.1 && < 0.2,- transformers >= 0.2 && < 0.3,- clientsession >= 0.4.0 && < 0.5,- pureMD5 >= 1.1.0.0 && < 1.2,- random >= 1.0.0.2 && < 1.1,- control-monad-attempt >= 0.3 && < 0.4,- cereal >= 0.2 && < 0.3,- dataenc >= 0.13.0.2 && < 0.14,- old-locale >= 1.0.0.2 && < 1.1,- persistent >= 0.2.0 && < 0.3,- neither >= 0.0.0 && < 0.1,- MonadCatchIO-transformers >= 0.2.2.0 && < 0.3,- data-object >= 0.3.1 && < 0.4,- network >= 2.2.1.5 && < 2.3,- email-validate >= 0.2.5 && < 0.3,- process >= 1.0.1 && < 1.1+ build-depends: base >= 4 && < 5+ , time >= 1.1.4 && < 1.3+ , wai >= 0.2.0 && < 0.3+ , wai-extra >= 0.2.2 && < 0.3+ , authenticate >= 0.6.3.2 && < 0.7+ , bytestring >= 0.9.1.4 && < 0.10+ , directory >= 1 && < 1.2+ , text >= 0.5 && < 0.10+ , utf8-string >= 0.3.4 && < 0.4+ , template-haskell >= 2.4 && < 2.6+ , web-routes-quasi >= 0.6 && < 0.7+ , hamlet >= 0.5.1 && < 0.6+ , blaze-builder >= 0.1 && < 0.2+ , transformers >= 0.2 && < 0.3+ , clientsession >= 0.4.0 && < 0.5+ , pureMD5 >= 1.1.0.0 && < 1.2+ , random >= 1.0.0.2 && < 1.1+ , control-monad-attempt >= 0.3 && < 0.4+ , cereal >= 0.2 && < 0.3+ , dataenc >= 0.13.0.2 && < 0.14+ , old-locale >= 1.0.0.2 && < 1.1+ , persistent >= 0.2.2 && < 0.3+ , neither >= 0.0.0 && < 0.1+ , MonadCatchIO-transformers >= 0.2.2.0 && < 0.3+ , data-object >= 0.3.1 && < 0.4+ , network >= 2.2.1.5 && < 2.3+ , email-validate >= 0.2.5 && < 0.3+ , process >= 1.0.1 && < 1.1+ , web-routes >= 0.23 && < 0.24+ , xss-sanitize >= 0.1.1 && < 0.2 exposed-modules: Yesod Yesod.Content Yesod.Dispatch@@ -79,7 +81,8 @@ build-depends: parsec >= 2.1 && < 4 ghc-options: -Wall main-is: scaffold.hs- other-modules: CodeGenQ+ other-modules: CodeGen+ extensions: TemplateHaskell executable runtests if flag(buildtests)