haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Scaffolded site: yesod 0.8

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Yesod.hs
View File

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

6
full-test.sh
View File

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

16
scaffold/Model_hs.cg
View File

@ -2,21 +2,21 @@
module Model where
import Yesod
import Database.Persist.TH (share2)
import Database.Persist.GenericSql (mkMigrate)
import Database.Persist.TH (share, mkMigrate)
import Data.Text (Text)
-- 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/
share2 mkPersist (mkMigrate "migrateAll") [~qq~persist|
-- http://www.yesodweb.com/book/persistent/
share [mkPersist, mkMigrate "migrateAll"] [~qq~persist|
User
ident String
password String Maybe Update
ident Text
password Text Maybe Update
UniqueUser ident
Email
email String
email Text
user UserId Maybe Update
verkey String Maybe Update
verkey Text Maybe Update
UniqueEmail email
|]

18
scaffold/Settings_hs.cg
View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | 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
@ -24,14 +25,15 @@ import qualified Text.Cassius as H
import qualified Text.Julius as H
import Language.Haskell.TH.Syntax
~importDB~
import Yesod (MonadPeelIO, addWidget, addCassius, addJulius)
import Data.Monoid (mempty)
import Yesod (MonadControlIO, addWidget, addCassius, addJulius)
import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist)
import Data.Text (Text)
-- | 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
approot :: Text
#ifdef PRODUCTION
-- You probably want to change this. If your domain name was "yesod.com",
-- you would probably want it to be:
@ -60,12 +62,12 @@ staticdir = "static"
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~sitearg~.hs
staticroot :: String
staticroot = approot ++ "/static"
staticroot :: Text
staticroot = approot `mappend` "/static"
-- | The database connection string. The meaning of this string is backend-
-- specific.
connStr :: String
connStr :: Text
#ifdef PRODUCTION
connStr = "~connstr2~"
#else
@ -139,9 +141,9 @@ widgetFile x = do
-- 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 :: MonadPeelIO m => (ConnectionPool -> m a) -> m a
withConnectionPool :: MonadControlIO m => (ConnectionPool -> m a) -> m a
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

6
scaffold/cabal.cg
View File

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

10
scaffold/mini-Settings_hs.cg
View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
-- | 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
@ -20,13 +21,14 @@ import qualified Text.Cassius as H
import qualified Text.Julius as H
import Language.Haskell.TH.Syntax
import Yesod.Widget (addWidget, addCassius, addJulius)
import Data.Monoid (mempty)
import Data.Monoid (mempty, mappend)
import System.Directory (doesFileExist)
import Data.Text (Text)
-- | 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
approot :: Text
#ifdef PRODUCTION
-- You probably want to change this. If your domain name was "yesod.com",
-- you would probably want it to be:
@ -55,8 +57,8 @@ staticdir = "static"
-- have to make a corresponding change here.
--
-- To see how this value is used, see urlRenderOverride in ~project~.hs
staticroot :: String
staticroot = approot ++ "/static"
staticroot :: Text
staticroot = approot `mappend` "/static"
-- The rest of this file contains settings which rarely need changing by a
-- user.

3
scaffold/mini-cabal.cg
View File

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

13
scaffold/mini-sitearg_hs.cg
View File

@ -1,4 +1,5 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~
( ~sitearg~ (..)
, ~sitearg~Route (..)
@ -16,11 +17,7 @@ module ~sitearg~
, liftIO
) where
import Yesod.Handler
import Yesod.Widget
import Yesod.Dispatch
import Yesod.Core
import Yesod.Content
import Yesod.Helpers.Static
import qualified Settings
import System.Directory
@ -30,6 +27,8 @@ import StaticFiles
import Control.Monad (unless)
import Control.Monad.Trans.Class (lift)
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
-- 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
-- a separate domain. Please see the staticroot setting in Settings.hs
urlRenderOverride a (StaticR s) =
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s
Just $ uncurry (joinPath a $ fromText Settings.staticroot) $ renderRoute s
urlRenderOverride _ _ = Nothing
-- 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
-- users receiving stale content.
addStaticContent ext' _ content = do
let fn = base64md5 content ++ '.' : ext'
let fn = base64md5 content ++ '.' : T.unpack ext'
let statictmp = Settings.staticdir ++ "/tmp/"
liftIO $ createDirectoryIfMissing True statictmp
let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn'
unless exists $ liftIO $ L.writeFile fn' content
return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])
return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])

21
scaffold/sitearg_hs.cg
View File

@ -1,4 +1,5 @@
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
module ~sitearg~
( ~sitearg~ (..)
, ~sitearg~Route (..)
@ -32,6 +33,8 @@ import Network.Mail.Mime
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Encoding
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
-- 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
-- a separate domain. Please see the staticroot setting in Settings.hs
urlRenderOverride a (StaticR s) =
Just $ uncurry (joinPath a Settings.staticroot) $ renderRoute s
Just $ uncurry (joinPath a $ fromText Settings.staticroot) $ renderRoute s
urlRenderOverride _ _ = Nothing
-- 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
-- users receiving stale content.
addStaticContent ext' _ content = do
let fn = base64md5 content ++ '.' : ext'
let fn = base64md5 content ++ '.' : T.unpack ext'
let content' =
if ext' == "js"
then case minifym content of
@ -117,7 +120,7 @@ instance Yesod ~sitearg~ where
let fn' = statictmp ++ fn
exists <- liftIO $ doesFileExist fn'
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.
instance YesodPersist ~sitearg~ where
@ -140,8 +143,8 @@ instance YesodAuth ~sitearg~ where
Nothing -> do
fmap Just $ insert $ User (credsIdent creds) Nothing
showAuthId _ = showIntegral
readAuthId _ = readIntegral
showAuthId _ = T.pack . show
readAuthId _ = read . T.unpack
authPlugins = [ authOpenId
, authEmail
@ -150,8 +153,8 @@ instance YesodAuth ~sitearg~ where
instance YesodAuthEmail ~sitearg~ where
type AuthEmailId ~sitearg~ = EmailId
showAuthEmailId _ = showIntegral
readAuthEmailId _ = readIntegral
showAuthEmailId _ = T.pack . show
readAuthEmailId _ = read . T.unpack
addUnverified email verkey =
runDB $ insert $ Email email Nothing $ Just verkey
@ -169,10 +172,10 @@ instance YesodAuthEmail ~sitearg~ where
, partEncoding = None
, partFilename = Nothing
, 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."
, ""
, verurl
, Data.Text.Lazy.fromChunks [verurl]
, ""
, "Thank you"
]

26
yesod.cabal
View File

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