widgetFile* provided by yesod-default

This commit is contained in:
Michael Snoyman 2011-09-23 08:13:30 +03:00
parent 6a949e7f29
commit 40143c6391
11 changed files with 100 additions and 183 deletions

View File

@ -1,7 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
-- | Various utilities used in the scaffolded site.
module Yesod.Default.Util
( addStaticContentExternal
, globFile
, widgetFileProduction
, widgetFileDebug
) where
import Control.Monad.IO.Class (liftIO)
@ -10,6 +14,11 @@ import Data.Text (Text, pack, unpack)
import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
import Control.Monad (unless)
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Language.Haskell.TH.Syntax
import Text.Lucius (luciusFile, luciusFileDebug)
import Text.Julius (juliusFile, juliusFileDebug)
import Text.Cassius (cassiusFile, cassiusFileDebug)
import Data.Monoid (mempty)
-- | An implementation of 'addStaticContent' which stores the contents in an
-- external file. Files are created in the given static folder with names based
@ -41,3 +50,29 @@ addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
content'
| ext' == "js" = either (const content) id $ minify content
| otherwise = content
-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/
globFile :: String -> String -> FilePath
globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
widgetFileProduction :: FilePath -> Q Exp
widgetFileProduction x = do
let h = whenExists x "hamlet" whamletFile
let c = whenExists x "cassius" cassiusFile
let j = whenExists x "julius" juliusFile
let l = whenExists x "lucius" luciusFile
[|$h >> addCassius $c >> addJulius $j >> addLucius $l|]
widgetFileDebug :: FilePath -> Q Exp
widgetFileDebug x = do
let h = whenExists x "hamlet" whamletFile
let c = whenExists x "cassius" cassiusFileDebug
let j = whenExists x "julius" juliusFileDebug
let l = whenExists x "lucius" luciusFileDebug
[|$h >> addCassius $c >> addJulius $j >> addLucius $l|]
whenExists :: String -> String -> (FilePath -> Q Exp) -> Q Exp
whenExists x glob f = do
let fn = globFile glob x
e <- qRunIO $ doesFileExist fn
if e then f fn else [|mempty|]

View File

@ -14,16 +14,19 @@ description: Convenient wrappers for your the configuration and
execution of your yesod application
library
build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10
, cmdargs >= 0.8 && < 0.9
, warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5
, bytestring >= 0.9 && < 0.10
, transformers >= 0.2 && < 0.3
, text >= 0.9 && < 1.0
, directory >= 1.0 && < 1.2
build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10
, cmdargs >= 0.8 && < 0.9
, warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5
, bytestring >= 0.9 && < 0.10
, transformers >= 0.2 && < 0.3
, text >= 0.9 && < 1.0
, directory >= 1.0 && < 1.2
, shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, template-haskell
exposed-modules: Yesod.Default.Config
, Yesod.Default.Main

View File

@ -148,6 +148,8 @@ scaffold = do
$(codegen "lucius/default-layout.lucius")
writeFile' "hamlet/default-layout.hamlet"
$(codegen "hamlet/default-layout.hamlet")
writeFile' "hamlet/default-layout-wrapper.hamlet"
$(codegen "hamlet/default-layout-wrapper.hamlet")
writeFile' "hamlet/boilerplate-layout.hamlet"
$(codegen "hamlet/boilerplate-layout.hamlet")
writeFile' "lucius/normalize.lucius"

View File

@ -28,11 +28,12 @@ import Yesod.Logger (Logger, logLazyText)
import qualified Settings
import qualified Data.ByteString.Lazy as L
import Database.Persist.~importGenericDB~
import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
import Settings (widgetFile)
import Model
import qualified Data.Text.Lazy.Encoding
import Text.Jasmine (minifym)
import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile)
#if PRODUCTION
import Network.Mail.Mime (sendmail)
#endif
@ -82,11 +83,17 @@ instance Yesod ~sitearg~ where
defaultLayout widget = do
mmsg <- getMessage
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and
-- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
pc <- widgetToPageContent $ do
widget
toWidget $(luciusFile "normalize")
toWidget $(luciusFile "default-layout")
hamletToRepHtml $(hamletFile "default-layout")
$(widgetFile "normalize")
$(widgetFile "default-layout")
hamletToRepHtml $(hamletFile "hamlet/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs

View File

@ -15,4 +15,4 @@ getRootR = do
defaultLayout $ do
h2id <- lift newIdent
setTitle "~project~ homepage"
addWidget $(widgetFile "homepage")
$(widgetFile "homepage")

View File

@ -7,12 +7,7 @@
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the Foundation.hs file.
module Settings
( hamletFile
, cassiusFile
, juliusFile
, luciusFile
, textFile
, widgetFile
( widgetFile
, ConnectionPool
, withConnectionPool
, runConnectionPool
@ -20,21 +15,14 @@ module Settings
, staticDir
) where
import qualified Text.Hamlet as S
import qualified Text.Cassius as S
import qualified Text.Julius as S
import qualified Text.Lucius as S
import qualified Text.Shakespeare.Text as S
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Database.Persist.~importPersist~
import Yesod (liftIO, MonadControlIO, addWidget, addCassius, addJulius, addLucius, whamletFile)
import Yesod (liftIO, MonadControlIO)
import Yesod.Default.Config
import Data.Monoid (mempty)
import System.Directory (doesFileExist)
import qualified Yesod.Default.Util
import Data.Text (Text)
-- Static setting below. Changing these requires a recompile
-- | The location of static files on your system. This is a file system
@ -68,66 +56,9 @@ staticRoot conf = [st|#{appRoot conf}/static|]
-- them yourself.
~withConnectionPool~
-- The following functions are used for calling HTML, CSS,
-- Javascript, and plain text 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
--
-- 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.
-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/
globFile :: String -> String -> FilePath
globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
hamletFile :: FilePath -> Q Exp
hamletFile = S.hamletFile . globFile "hamlet"
cassiusFile :: FilePath -> Q Exp
cassiusFile =
#ifdef PRODUCTION
S.cassiusFile . globFile "cassius"
widgetFile :: String -> Q Exp
#if PRODUCTION
widgetFile = Yesod.Default.Util.widgetFileProduction
#else
S.cassiusFileDebug . globFile "cassius"
widgetFile = Yesod.Default.Util.widgetFileDebug
#endif
luciusFile :: FilePath -> Q Exp
luciusFile =
#ifdef PRODUCTION
S.luciusFile . globFile "lucius"
#else
S.luciusFileDebug . globFile "lucius"
#endif
juliusFile :: FilePath -> Q Exp
juliusFile =
#ifdef PRODUCTION
S.juliusFile . globFile "julius"
#else
S.juliusFileDebug . globFile "julius"
#endif
textFile :: FilePath -> Q Exp
textFile =
#ifdef PRODUCTION
S.textFile . globFile "text"
#else
S.textFileDebug . globFile "text"
#endif
widgetFile :: FilePath -> Q Exp
widgetFile x = do
let h = whenExists (globFile "hamlet") (whamletFile . globFile "hamlet")
let c = whenExists (globFile "cassius") cassiusFile
let j = whenExists (globFile "julius") juliusFile
let l = whenExists (globFile "lucius") luciusFile
[|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
where
whenExists tofn f = do
e <- qRunIO $ doesFileExist $ tofn x
if e then f x else [|mempty|]

View File

@ -0,0 +1,8 @@
!!!
<html>
<head
<title>#{pageTitle pc}
^{pageHead pc}
<body
^{pageBody pc}

View File

@ -1,10 +1,4 @@
!!!
<html
<head
<title>#{pageTitle pc}
^{pageHead pc}
<body
$maybe msg <- mmsg
<div #message>#{msg}
^{pageBody pc}
$maybe msg <- mmsg
<div #message>#{msg}
^{widget}

View File

@ -21,10 +21,11 @@ import Yesod.Static (Static, base64md5, StaticRoute(..))
import Settings.StaticFiles
import Yesod.Logger (Logger, logLazyText)
import qualified Settings
import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
import Settings (widgetFile)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
import Web.ClientSession (getKey)
import Text.Hamlet (hamletFile)
-- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
@ -70,11 +71,17 @@ instance Yesod ~sitearg~ where
defaultLayout widget = do
mmsg <- getMessage
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and
-- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
pc <- widgetToPageContent $ do
widget
toWidget $(luciusFile "normalize")
toWidget $(luciusFile "default-layout")
hamletToRepHtml $(hamletFile "default-layout")
$(widgetFile "normalize")
$(widgetFile "default-layout")
hamletToRepHtml $(hamletFile "hamlet/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticroot setting in Settings.hs

View File

@ -7,26 +7,15 @@
-- by overriding methods in the Yesod typeclass. That instance is
-- declared in the ~project~.hs file.
module Settings
( hamletFile
, cassiusFile
, juliusFile
, luciusFile
, widgetFile
( widgetFile
, staticRoot
, staticDir
) where
import qualified Text.Hamlet as S
import qualified Text.Cassius as S
import qualified Text.Julius as S
import qualified Text.Lucius as S
import qualified Text.Shakespeare.Text as S
import Text.Shakespeare.Text (st)
import Language.Haskell.TH.Syntax
import Yesod.Widget (addWidget, addCassius, addJulius, addLucius, whamletFile)
import Yesod.Default.Config
import Data.Monoid (mempty)
import System.Directory (doesFileExist)
import qualified Yesod.Default.Util
import Data.Text (Text)
-- | The location of static files on your system. This is a file system
@ -50,69 +39,9 @@ staticDir = "static"
staticRoot :: AppConfig DefaultEnv -> Text
staticRoot conf = [st|#{appRoot conf}/static|]
-- The rest of this file contains settings which rarely need changing by a
-- user.
-- The following functions are used for calling HTML, CSS,
-- Javascript, and plain text 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
--
-- 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.
-- | expects a root folder for each type, e.g: hamlet/ lucius/ julius/
globFile :: String -> String -> FilePath
globFile kind x = kind ++ "/" ++ x ++ "." ++ kind
hamletFile :: FilePath -> Q Exp
hamletFile = S.hamletFile . globFile "hamlet"
cassiusFile :: FilePath -> Q Exp
cassiusFile =
#ifdef PRODUCTION
S.cassiusFile . globFile "cassius"
widgetFile :: String -> Q Exp
#if PRODUCTION
widgetFile = Yesod.Default.Util.widgetFileProduction
#else
S.cassiusFileDebug . globFile "cassius"
widgetFile = Yesod.Default.Util.widgetFileDebug
#endif
luciusFile :: FilePath -> Q Exp
luciusFile =
#ifdef PRODUCTION
S.luciusFile . globFile "lucius"
#else
S.luciusFileDebug . globFile "lucius"
#endif
juliusFile :: FilePath -> Q Exp
juliusFile =
#ifdef PRODUCTION
S.juliusFile . globFile "julius"
#else
S.juliusFileDebug . globFile "julius"
#endif
textFile :: FilePath -> Q Exp
textFile =
#ifdef PRODUCTION
S.textFile . globFile "text"
#else
S.textFileDebug . globFile "text"
#endif
widgetFile :: FilePath -> Q Exp
widgetFile x = do
let h = whenExists (globFile "hamlet") (whamletFile . globFile "hamlet")
let c = whenExists (globFile "cassius") cassiusFile
let j = whenExists (globFile "julius") juliusFile
let l = whenExists (globFile "lucius") luciusFile
[|addWidget $h >> addCassius $c >> addJulius $j >> addLucius $l|]
where
whenExists tofn f = do
e <- qRunIO $ doesFileExist $ tofn x
if e then f x else [|mempty|]

View File

@ -37,6 +37,7 @@ extra-source-files:
scaffold/julius/homepage.julius.cg
scaffold/hamlet/homepage.hamlet.cg
scaffold/hamlet/default-layout.hamlet.cg
scaffold/hamlet/default-layout-wrapper.hamlet.cg
scaffold/hamlet/boilerplate-layout.hamlet.cg
scaffold/deploy/Procfile.cg
scaffold/main.hs.cg