Scaffolded site: yesod 0.8

This commit is contained in:
Michael Snoyman 2011-04-08 00:35:25 +03:00
parent fe38853ff0
commit 9b36dc2bf6
10 changed files with 67 additions and 63 deletions

View File

@ -3,12 +3,7 @@
-- | This module simply re-exports from other modules for your convenience. -- | This module simply re-exports from other modules for your convenience.
module Yesod module Yesod
( -- * Re-exports from yesod-core ( -- * Re-exports from yesod-core
module Yesod.Request module Yesod.Core
, module Yesod.Content
, module Yesod.Core
, module Yesod.Handler
, module Yesod.Dispatch
, module Yesod.Widget
, module Yesod.Form , module Yesod.Form
, module Yesod.Json , module Yesod.Json
, module Yesod.Persist , module Yesod.Persist
@ -20,7 +15,7 @@ module Yesod
, Application , Application
, lift , lift
, liftIO , liftIO
, MonadPeelIO , MonadControlIO
-- * Utilities -- * Utilities
, showIntegral , showIntegral
, readIntegral , readIntegral
@ -62,7 +57,7 @@ import Network.Wai (Application)
import Network.Wai.Middleware.Debug import Network.Wai.Middleware.Debug
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Peel (MonadPeelIO) import Control.Monad.IO.Control (MonadControlIO)
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import System.IO (stderr, hPutStrLn) import System.IO (stderr, hPutStrLn)

View File

@ -1,7 +1,7 @@
#!/bin/sh #!/bin/sh
cabal clean && cabal install && rm -rf foobar && \ cabal clean && cabal install && rm -rf foobar && \
yesod < input-sqlite && cd foobar && cabal install && cd .. && \ runghc scaffold.hs < input-sqlite && cd foobar && cabal install && cd .. && \
yesod < input-postgres && cd foobar && cabal install && cd .. && \ runghc scaffold.hs < input-postgres && cd foobar && cabal install && cd .. && \
yesod < input-mini && cd foobar && cabal install && cd .. && \ runghc scaffold.hs < input-mini && cd foobar && cabal install && cd .. && \
rm -rf foobar rm -rf foobar

View File

@ -2,21 +2,21 @@
module Model where module Model where
import Yesod import Yesod
import Database.Persist.TH (share2) import Database.Persist.TH (share, mkMigrate)
import Database.Persist.GenericSql (mkMigrate) import Data.Text (Text)
-- You can define all of your database entities here. You can find more -- You can define all of your database entities here. You can find more
-- information on persistent and how to declare entities at: -- information on persistent and how to declare entities at:
-- http://docs.yesodweb.com/book/persistent/ -- http://www.yesodweb.com/book/persistent/
share2 mkPersist (mkMigrate "migrateAll") [~qq~persist| share [mkPersist, mkMigrate "migrateAll"] [~qq~persist|
User User
ident String ident Text
password String Maybe Update password Text Maybe Update
UniqueUser ident UniqueUser ident
Email Email
email String email Text
user UserId Maybe Update user UserId Maybe Update
verkey String Maybe Update verkey Text Maybe Update
UniqueEmail email UniqueEmail email
|] |]

View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc. -- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod -- In addition, you can configure a number of different aspects of Yesod
@ -24,14 +25,15 @@ import qualified Text.Cassius as H
import qualified Text.Julius as H import qualified Text.Julius as H
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
~importDB~ ~importDB~
import Yesod (MonadPeelIO, addWidget, addCassius, addJulius) import Yesod (MonadControlIO, addWidget, addCassius, addJulius)
import Data.Monoid (mempty) import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Data.Text (Text)
-- | The base URL for your application. This will usually be different for -- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you, -- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links. -- so this value must be accurate to create valid links.
approot :: String approot :: Text
#ifdef PRODUCTION #ifdef PRODUCTION
-- You probably want to change this. If your domain name was "yesod.com", -- You probably want to change this. If your domain name was "yesod.com",
-- you would probably want it to be: -- you would probably want it to be:
@ -60,12 +62,12 @@ staticdir = "static"
-- have to make a corresponding change here. -- have to make a corresponding change here.
-- --
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs -- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticroot :: String staticroot :: Text
staticroot = approot ++ "/static" staticroot = approot `mappend` "/static"
-- | The database connection string. The meaning of this string is backend- -- | The database connection string. The meaning of this string is backend-
-- specific. -- specific.
connStr :: String connStr :: Text
#ifdef PRODUCTION #ifdef PRODUCTION
connStr = "~connstr2~" connStr = "~connstr2~"
#else #else
@ -139,9 +141,9 @@ widgetFile x = do
-- database actions using a pool, respectively. It is used internally -- database actions using a pool, respectively. It is used internally
-- by the scaffolded application, and therefore you will rarely need to use -- by the scaffolded application, and therefore you will rarely need to use
-- them yourself. -- them yourself.
withConnectionPool :: MonadPeelIO m => (ConnectionPool -> m a) -> m a withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a
withConnectionPool = with~upper~Pool connStr connectionCount withConnectionPool = with~upper~Pool connStr connectionCount
runConnectionPool :: MonadPeelIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a
runConnectionPool = runSqlPool runConnectionPool = runSqlPool

View File

@ -21,7 +21,7 @@ executable ~project~-test
Buildable: False Buildable: False
main-is: test.hs main-is: test.hs
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod >= 0.7 && < 0.8 , yesod >= 0.8 && < 0.9
, yesod-auth , yesod-auth
, yesod-static , yesod-static
, mime-mail , mime-mail
@ -30,13 +30,15 @@ executable ~project~-test
, bytestring , bytestring
, text , text
, persistent , persistent
, persistent-~lower~ >= 0.4 && < 0.5 , persistent-template
, persistent-~lower~ >= 0.5 && < 0.6
, template-haskell , template-haskell
, hamlet , hamlet
, web-routes , web-routes
, hjsmin , hjsmin
, transformers , transformers
, warp , warp
, blaze-builder
ghc-options: -Wall -threaded ghc-options: -Wall -threaded
executable ~project~-production executable ~project~-production

View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Settings are centralized, as much as possible, into this file. This -- | Settings are centralized, as much as possible, into this file. This
-- includes database connection settings, static file locations, etc. -- includes database connection settings, static file locations, etc.
-- In addition, you can configure a number of different aspects of Yesod -- In addition, you can configure a number of different aspects of Yesod
@ -20,13 +21,14 @@ import qualified Text.Cassius as H
import qualified Text.Julius as H import qualified Text.Julius as H
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import Yesod.Widget (addWidget, addCassius, addJulius) import Yesod.Widget (addWidget, addCassius, addJulius)
import Data.Monoid (mempty) import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Data.Text (Text)
-- | The base URL for your application. This will usually be different for -- | The base URL for your application. This will usually be different for
-- development and production. Yesod automatically constructs URLs for you, -- development and production. Yesod automatically constructs URLs for you,
-- so this value must be accurate to create valid links. -- so this value must be accurate to create valid links.
approot :: String approot :: Text
#ifdef PRODUCTION #ifdef PRODUCTION
-- You probably want to change this. If your domain name was "yesod.com", -- You probably want to change this. If your domain name was "yesod.com",
-- you would probably want it to be: -- you would probably want it to be:
@ -55,8 +57,8 @@ staticdir = "static"
-- have to make a corresponding change here. -- have to make a corresponding change here.
-- --
-- To see how this value is used, see urlRenderOverride in ~project~.hs -- To see how this value is used, see urlRenderOverride in ~project~.hs
staticroot :: String staticroot :: Text
staticroot = approot ++ "/static" staticroot = approot `mappend` "/static"
-- The rest of this file contains settings which rarely need changing by a -- The rest of this file contains settings which rarely need changing by a
-- user. -- user.

View File

@ -21,7 +21,7 @@ executable ~project~-test
Buildable: False Buildable: False
main-is: test.hs main-is: test.hs
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.7 && < 0.8 , yesod-core >= 0.8 && < 0.9
, yesod-static , yesod-static
, wai-extra , wai-extra
, directory , directory
@ -33,6 +33,7 @@ executable ~project~-test
, transformers , transformers
, wai , wai
, warp , warp
, blaze-builder
ghc-options: -Wall -threaded ghc-options: -Wall -threaded
executable ~project~-production executable ~project~-production

View File

@ -1,4 +1,5 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~ module ~sitearg~
( ~sitearg~ (..) ( ~sitearg~ (..)
, ~sitearg~Route (..) , ~sitearg~Route (..)
@ -16,11 +17,7 @@ module ~sitearg~
, liftIO , liftIO
) where ) where
import Yesod.Handler
import Yesod.Widget
import Yesod.Dispatch
import Yesod.Core import Yesod.Core
import Yesod.Content
import Yesod.Helpers.Static import Yesod.Helpers.Static
import qualified Settings import qualified Settings
import System.Directory import System.Directory
@ -30,6 +27,8 @@ import StaticFiles
import Control.Monad (unless) import Control.Monad (unless)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -90,7 +89,7 @@ instance Yesod ~sitearg~ where
-- This is done to provide an optimization for serving static files from -- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs -- a separate domain. Please see the staticroot setting in Settings.hs
urlRenderOverride a (StaticR s) = urlRenderOverride a (StaticR s) =
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s Just $ uncurry (joinPath a $ fromText Settings.staticroot) $ renderRoute s
urlRenderOverride _ _ = Nothing urlRenderOverride _ _ = Nothing
-- This function creates static content files in the static folder -- This function creates static content files in the static folder
@ -98,10 +97,10 @@ instance Yesod ~sitearg~ where
-- expiration dates to be set far in the future without worry of -- expiration dates to be set far in the future without worry of
-- users receiving stale content. -- users receiving stale content.
addStaticContent ext' _ content = do addStaticContent ext' _ content = do
let fn = base64md5 content ++ '.' : ext' let fn = base64md5 content ++ '.' : T.unpack ext'
let statictmp = Settings.staticdir ++ "/tmp/" let statictmp = Settings.staticdir ++ "/tmp/"
liftIO $ createDirectoryIfMissing True statictmp liftIO $ createDirectoryIfMissing True statictmp
let fn' = statictmp ++ fn let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn' exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content unless exists $ liftIO $ L.writeFile fn' content
return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], []) return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])

View File

@ -1,4 +1,5 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~ module ~sitearg~
( ~sitearg~ (..) ( ~sitearg~ (..)
, ~sitearg~Route (..) , ~sitearg~Route (..)
@ -32,6 +33,8 @@ import Network.Mail.Mime
import qualified Data.Text.Lazy import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding import qualified Data.Text.Lazy.Encoding
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import qualified Data.Text as T
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
@ -94,7 +97,7 @@ instance Yesod ~sitearg~ where
-- This is done to provide an optimization for serving static files from -- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs -- a separate domain. Please see the staticroot setting in Settings.hs
urlRenderOverride a (StaticR s) = urlRenderOverride a (StaticR s) =
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s Just $ uncurry (joinPath a $ fromText Settings.staticroot) $ renderRoute s
urlRenderOverride _ _ = Nothing urlRenderOverride _ _ = Nothing
-- The page to be redirected to when authentication is required. -- The page to be redirected to when authentication is required.
@ -105,7 +108,7 @@ instance Yesod ~sitearg~ where
-- expiration dates to be set far in the future without worry of -- expiration dates to be set far in the future without worry of
-- users receiving stale content. -- users receiving stale content.
addStaticContent ext' _ content = do addStaticContent ext' _ content = do
let fn = base64md5 content ++ '.' : ext' let fn = base64md5 content ++ '.' : T.unpack ext'
let content' = let content' =
if ext' == "js" if ext' == "js"
then case minifym content of then case minifym content of
@ -117,7 +120,7 @@ instance Yesod ~sitearg~ where
let fn' = statictmp ++ fn let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn' exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content' unless exists $ liftIO $ L.writeFile fn' content'
return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], []) return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])
-- How to run database actions. -- How to run database actions.
instance YesodPersist ~sitearg~ where instance YesodPersist ~sitearg~ where
@ -140,8 +143,8 @@ instance YesodAuth ~sitearg~ where
Nothing -> do Nothing -> do
fmap Just $ insert $ User (credsIdent creds) Nothing fmap Just $ insert $ User (credsIdent creds) Nothing
showAuthId _ = showIntegral showAuthId _ = T.pack . show
readAuthId _ = readIntegral readAuthId _ = read . T.unpack
authPlugins = [ authOpenId authPlugins = [ authOpenId
, authEmail , authEmail
@ -150,8 +153,8 @@ instance YesodAuth ~sitearg~ where
instance YesodAuthEmail ~sitearg~ where instance YesodAuthEmail ~sitearg~ where
type AuthEmailId ~sitearg~ = EmailId type AuthEmailId ~sitearg~ = EmailId
showAuthEmailId _ = showIntegral showAuthEmailId _ = T.pack . show
readAuthEmailId _ = readIntegral readAuthEmailId _ = read . T.unpack
addUnverified email verkey = addUnverified email verkey =
runDB $ insert $ Email email Nothing $ Just verkey runDB $ insert $ Email email Nothing $ Just verkey
@ -169,10 +172,10 @@ instance YesodAuthEmail ~sitearg~ where
, partEncoding = None , partEncoding = None
, partFilename = Nothing , partFilename = Nothing
, partContent = Data.Text.Lazy.Encoding.encodeUtf8 , partContent = Data.Text.Lazy.Encoding.encodeUtf8
$ Data.Text.Lazy.pack $ unlines $ Data.Text.Lazy.unlines
[ "Please confirm your email address by clicking on the link below." [ "Please confirm your email address by clicking on the link below."
, "" , ""
, verurl , Data.Text.Lazy.fromChunks [verurl]
, "" , ""
, "Thank you" , "Thank you"
] ]

View File

@ -1,5 +1,5 @@
name: yesod name: yesod
version: 0.7.3 version: 0.8.0
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -24,19 +24,19 @@ library
cpp-options: -DGHC7 cpp-options: -DGHC7
else else
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
build-depends: yesod-core >= 0.7.0.2 && < 0.8 build-depends: yesod-core >= 0.8 && < 0.9
, yesod-auth >= 0.3 && < 0.4 , yesod-auth >= 0.4 && < 0.5
, yesod-json >= 0.0.0.1 && < 0.1 , yesod-json >= 0.1 && < 0.2
, yesod-persistent >= 0.0.0.1 && < 0.1 , yesod-persistent >= 0.1 && < 0.2
, yesod-static >= 0.0 && < 0.1 , yesod-static >= 0.1 && < 0.2
, yesod-form >= 0.0.0.1 && < 0.1 , yesod-form >= 0.1 && < 0.2
, monad-peel >= 0.1 && < 0.2 , monad-control >= 0.2 && < 0.3
, transformers >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3
, wai >= 0.3 && < 0.4 , wai >= 0.4 && < 0.5
, wai-extra >= 0.3.2 && < 0.4 , wai-extra >= 0.4 && < 0.5
, hamlet >= 0.7.3 && < 0.8 , hamlet >= 0.8 && < 0.9
, warp >= 0.3.3 && < 0.4 , warp >= 0.4 && < 0.5
, mime-mail >= 0.1.0.1 && < 0.2 , mime-mail >= 0.3 && < 0.4
, hjsmin >= 0.0.13 && < 0.1 , hjsmin >= 0.0.13 && < 0.1
exposed-modules: Yesod exposed-modules: Yesod
ghc-options: -Wall ghc-options: -Wall