diff --git a/scripts b/scripts index f56426fa..e791ced0 160000 --- a/scripts +++ b/scripts @@ -1 +1 @@ -Subproject commit f56426fada59012329f23c928a2d7f9c3a515d75 +Subproject commit e791ced0395245e30d37b5098a27bba5e818ecb7 diff --git a/yesod-core/Yesod/Config.hs b/yesod-core/Yesod/Config.hs new file mode 100644 index 00000000..51216e59 --- /dev/null +++ b/yesod-core/Yesod/Config.hs @@ -0,0 +1,182 @@ +module Yesod.Config + ( AppConfig(..) + , PostgresConf(..) + , SqliteConf(..) + , MongoConf(..) + , loadConfig + , loadPostgresql + , loadSqlite + , loadMongo + ) where + +import Control.Monad (join, forM) +import Data.Maybe (fromMaybe) +import Data.Object +import Data.Object.Yaml + +import Data.Text (Text) +import qualified Data.Text as T + +-- | Dynamic per-environment configuration which can be loaded at +-- run-time negating the need to recompile between environments. +data AppConfig e = AppConfig + { appEnv :: e + , appPort :: Int + , appRoot :: Text + } deriving (Show) + +-- separate types means more code here, but it's easier to use in the +-- scaffold + +-- | Information required to connect to a postgres database +data PostgresConf = PostgresConf + { pgConnStr :: Text + , pgPoolSize :: Int + } + +-- | Information required to connect to a sqlite database +data SqliteConf = SqliteConf + { sqlDatabase :: Text + , sqlPoolSize :: Int + } + +-- | Information required to connect to a mongo database +data MongoConf = MongoConf + { mgDatabase :: String + , mgHost :: String + , mgPoolSize :: Int + } + +-- | Load an @'AppConfig'@ from @config\/settings.yml@. +-- +-- Some examples: +-- +-- > -- typical local development +-- > Development: +-- > host: localhost +-- > port: 3000 +-- > +-- > -- ssl: will default false +-- > -- approot: will default to "http://localhost:3000" +-- +-- > -- typical outward-facing production box +-- > Production: +-- > host: www.example.com +-- > +-- > -- ssl: will default false +-- > -- port: will default 80 +-- > -- approot: will default "http://www.example.com" +-- +-- > -- maybe you're reverse proxying connections to the running app +-- > -- on some other port +-- > Production: +-- > port: 8080 +-- > approot: "http://example.com" +-- > +-- > -- approot is specified so that the non-80 port is not appended +-- > -- automatically. +-- +loadConfig :: Show e => e -> IO (AppConfig e) +loadConfig env = withYamlEnvironment "config/settings.yml" env $ \e -> do + let mssl = lookupScalar "ssl" e + let mhost = lookupScalar "host" e + let mport = lookupScalar "port" e + let mapproot = lookupScalar "approot" e + + -- set some default arguments + let ssl = maybe False toBool mssl + port <- safeRead "port" $ fromMaybe (if ssl then "443" else "80") mport + + approot <- case (mhost, mapproot) of + (_ , Just ar) -> return ar + (Just host, _ ) -> return $ (if ssl then "https://" else "http://") ++ host ++ (addPort ssl port) + _ -> fail "You must supply either a host or approot" + + return $ AppConfig + { appEnv = env + , appPort = port + , appRoot = T.pack approot + } + + where + toBool :: String -> Bool + toBool = (`elem` ["true", "TRUE", "yes", "YES", "Y", "1"]) + + addPort :: Bool -> Int -> String + addPort True 443 = "" + addPort False 80 = "" + addPort _ p = ":" ++ show p + +-- | Load a @'PostgresConf'@ from @config\/postgresql.yml@. +-- +-- > Production: +-- > user: jsmith +-- > password: secret +-- > host: localhost +-- > port: 5432 +-- > database: some_db +-- > poolsize: 100 +-- +loadPostgresql :: Show e => e -> IO PostgresConf +loadPostgresql env = withYamlEnvironment "config/postgresql.yml" env $ \e -> do + db <- lookupScalar "database" e + pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e + + -- TODO: default host/port? + connparts <- forM ["user", "password", "host", "port"] $ \k -> do + v <- lookupScalar k e + return $ k ++ "=" ++ v ++ " " + + conn <- return $ concat connparts + + return $ PostgresConf (T.pack $ conn ++ " dbname=" ++ db) pool + +-- | Load a @'SqliteConf'@ from @config\/sqlite.yml@. +-- +-- > Production: +-- > database: foo.s3db +-- > poolsize: 100 +-- +loadSqlite :: Show e => e -> IO SqliteConf +loadSqlite env = withYamlEnvironment "config/sqlite.yml" env $ \e -> do + db <- lookupScalar "database" e + pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e + + return $ SqliteConf (T.pack db) pool + +-- | Load a @'MongoConf'@ from @config\/mongoDB.yml@. +-- +-- > Production: +-- > database: some_db +-- > host: localhost +-- > poolsize: 100 +-- +loadMongo :: Show e => e -> IO MongoConf +loadMongo env = withYamlEnvironment "config/mongoDB.yml" env $ \e -> do + db <- lookupScalar "database" e + host <- lookupScalar "host" e + pool <- safeRead "poolsize" =<< lookupScalar "poolsize" e + + return $ MongoConf db host pool + +-- | Loads the configuration block in the passed file named by the +-- passed environment, yeilds to the passed function as a mapping. +-- +-- Errors in the case of a bad load or if your function returns +-- @Nothing@. +withYamlEnvironment :: (IsYamlScalar v, Show e) + => FilePath -- ^ the yaml file + -> e -- ^ the environment you want to load + -> ([(String, Object String v)] -> IO a) -- ^ what to do with the mapping + -> IO a +withYamlEnvironment fp env f = do + obj <- join $ decodeFile fp + envs <- fromMapping obj + conf <- lookupMapping (show env) envs + f conf + +-- | Returns 'fail' if read fails +safeRead :: Monad m => String -> String -> m Int +safeRead name s = case reads s of + (i, _):_ -> return i + [] -> fail $ concat ["Invalid value for ", name, ": ", s] diff --git a/yesod-core/Yesod/Core.hs b/yesod-core/Yesod/Core.hs index 9f137991..2e395856 100644 --- a/yesod-core/Yesod/Core.hs +++ b/yesod-core/Yesod/Core.hs @@ -33,6 +33,7 @@ module Yesod.Core , module Yesod.Request , module Yesod.Widget , module Yesod.Message + , module Yesod.Config ) where import Yesod.Internal.Core @@ -42,6 +43,7 @@ import Yesod.Handler import Yesod.Request import Yesod.Widget import Yesod.Message +import Yesod.Config import Language.Haskell.TH.Syntax import Data.Text (Text) diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 9e73aef9..12d2e97b 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -54,6 +54,8 @@ library , case-insensitive >= 0.2 && < 0.4 , parsec >= 2 && < 3.2 , directory >= 1 && < 1.2 + , data-object >= 0.3 && < 0.4 + , data-object-yaml >= 0.3 && < 0.4 -- for logger. Probably logger should be a separate package , strict-concurrency >= 0.2.4 && < 0.2.5 @@ -65,6 +67,7 @@ library Yesod.Request Yesod.Widget Yesod.Message + Yesod.Config Yesod.Internal.TestApi other-modules: Yesod.Internal Yesod.Internal.Core diff --git a/yesod-default/LICENSE b/yesod-default/LICENSE new file mode 100644 index 00000000..8643e5d8 --- /dev/null +++ b/yesod-default/LICENSE @@ -0,0 +1,25 @@ +The following license covers this documentation, and the source code, except +where otherwise indicated. + +Copyright 2010, Michael Snoyman. 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. diff --git a/yesod-default/README b/yesod-default/README new file mode 100644 index 00000000..e69de29b diff --git a/yesod-default/Setup.lhs b/yesod-default/Setup.lhs new file mode 100755 index 00000000..06e2708f --- /dev/null +++ b/yesod-default/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/yesod-default/Yesod/Default/Config.hs b/yesod-default/Yesod/Default/Config.hs new file mode 100644 index 00000000..742967bb --- /dev/null +++ b/yesod-default/Yesod/Default/Config.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Yesod.Default.Config + ( DefaultEnv(..) + , ArgConfig(..) + , defaultArgConfig + , fromArgs + , fromArgsWith + , loadDevelopmentConfig + + -- reexport + , module Yesod.Config + ) where + +import Yesod.Config +import Data.Char (toUpper, toLower) +import System.Console.CmdArgs hiding (args) + +-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and +-- Production environments +data DefaultEnv = Development + | Testing + | Staging + | Production deriving (Read, Show, Enum, Bounded) + +-- | Setup commandline arguments for environment and port +data ArgConfig = ArgConfig + { environment :: String + , port :: Int + } deriving (Show, Data, Typeable) + +-- | A default @'ArgConfig'@ if using the provided @'DefaultEnv'@ type. +defaultArgConfig :: ArgConfig +defaultArgConfig = + ArgConfig + { environment = "development" + &= help ("application environment, one of: " ++ environments) + &= typ "ENVIRONMENT" + , port = def + &= help "the port to listen on" + &= typ "PORT" + } + + where + environments :: String + environments = foldl1 (\a b -> a ++ ", " ++ b) + . map ((map toLower) . show) + $ ([minBound..maxBound] :: [DefaultEnv]) + +-- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from +-- commandline arguments. +fromArgs :: IO (AppConfig DefaultEnv) +fromArgs = fromArgsWith defaultArgConfig + +fromArgsWith :: (Read e, Show e) => ArgConfig -> IO (AppConfig e) +fromArgsWith argConfig = do + args <- cmdArgs argConfig + + env <- + case reads $ capitalize $ environment args of + (e, _):_ -> return e + [] -> error $ "Invalid environment: " ++ environment args + + config <- loadConfig env + + return $ if port args /= 0 + then config { appPort = port args } + else config + + where + capitalize [] = [] + capitalize (x:xs) = toUpper x : map toLower xs + +-- | Load your development config (when using @'DefaultEnv'@) +loadDevelopmentConfig :: IO (AppConfig DefaultEnv) +loadDevelopmentConfig = loadConfig Development diff --git a/yesod-default/Yesod/Default/Main.hs b/yesod-default/Yesod/Default/Main.hs new file mode 100644 index 00000000..f19e5d41 --- /dev/null +++ b/yesod-default/Yesod/Default/Main.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Yesod.Default.Main + ( defaultMain + , defaultDevelApp + , defaultDevelAppWith + ) where + +import Yesod.Default.Config +import Yesod.Logger (Logger, makeLogger, logString, logLazyText, flushLogger) +import Network.Wai (Application) +import Network.Wai.Handler.Warp (run) +import Network.Wai.Middleware.Debug (debugHandle) + +-- | Run your app, taking environment and port settings from the +-- commandline. +-- +-- Use @'fromArgs'@ when using the provided @'DefaultEnv'@ type, or +-- @'fromArgsWith'@ when using a custom type +-- +-- > main :: IO () +-- > main = defaultMain fromArgs withMySite +-- +-- or +-- +-- > main :: IO () +-- > main = defaultMain (fromArgsWith customArgConfig) withMySite +-- +defaultMain :: (Show e, Read e) => IO (AppConfig e) -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -> IO () +defaultMain load withSite = do + config <- load + logger <- makeLogger + withSite config logger $ run (appPort config) + +-- | Run your development app using the provided @'DefaultEnv'@ type +-- +-- > withDevelAppPort :: Dynamic +-- > withDevelAppPort = toDyn $ defaultDevelApp withMySite +-- +defaultDevelApp :: (AppConfig DefaultEnv -> Logger -> (Application -> IO ()) -> IO ()) + -> ((Int, Application) -> IO ()) + -> IO () +defaultDevelApp = defaultDevelAppWith loadDevelopmentConfig + +-- | Run your development app using a custom environment type and loader +-- function +-- +-- > withDevelAppPort :: Dynamic +-- > withDevelAppPort = toDyn $ (defaultDevelAppWith customLoadAppConfig) withMySite +-- +defaultDevelAppWith :: (Show e, Read e) + => IO (AppConfig e) -- ^ A means to load your development @'AppConfig'@ + -> (AppConfig e -> Logger -> (Application -> IO ()) -> IO ()) -- ^ Your @withMySite@ function + -> ((Int, Application) -> IO ()) -> IO () +defaultDevelAppWith load withSite f = do + conf <- load + logger <- makeLogger + let p = appPort conf + logString logger $ "Devel application launched, listening on port " ++ show p + withSite conf logger $ \app -> f (p, debugHandle (logHandle logger) app) + flushLogger logger + + where + logHandle logger msg = logLazyText logger msg >> flushLogger logger diff --git a/yesod-default/Yesod/Default/Util.hs b/yesod-default/Yesod/Default/Util.hs new file mode 100644 index 00000000..ba36cb14 --- /dev/null +++ b/yesod-default/Yesod/Default/Util.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Various utilities used in the scaffolded site. +module Yesod.Default.Util + ( addStaticContentExternal + ) where + +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Lazy as L +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) + +-- | An implementation of 'addStaticContent' which stores the contents in an +-- external file. Files are created in the given static folder with names 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. +addStaticContentExternal + :: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier + -> (L.ByteString -> String) -- ^ hash function to determine file name + -> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder + -> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces + -> Text -- ^ filename extension + -> Text -- ^ mime type + -> L.ByteString -- ^ file contents + -> GHandler sub master (Maybe (Either Text (Route master, [(Text, Text)]))) +addStaticContentExternal minify hash staticDir toRoute ext' _ content = do + liftIO $ createDirectoryIfMissing True statictmp + exists <- liftIO $ doesFileExist fn' + unless exists $ liftIO $ L.writeFile fn' content' + return $ Just $ Right (toRoute ["tmp", pack fn], []) + where + fn, statictmp, fn' :: FilePath + -- by basing the hash off of the un-minified content, we avoid a costly + -- minification if the file already exists + fn = hash content ++ '.' : unpack ext' + statictmp = staticDir ++ "/tmp/" + fn' = statictmp ++ fn + + content' :: L.ByteString + content' + | ext' == "js" = either (const content) id $ minify content + | otherwise = content diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal new file mode 100644 index 00000000..8eea3d63 --- /dev/null +++ b/yesod-default/yesod-default.cabal @@ -0,0 +1,36 @@ +name: yesod-default +version: 0.3.1 +license: BSD3 +license-file: LICENSE +author: Patrick Brisbin +maintainer: Patrick Brisbin +synopsis: Default config and main functions for your yesod application +category: Web, Yesod +stability: Stable +cabal-version: >= 1.6 +build-type: Simple +homepage: http://www.yesodweb.com/ +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 + + exposed-modules: Yesod.Default.Config + , Yesod.Default.Main + , Yesod.Default.Util + + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/yesodweb/yesod.git diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index b5910e4e..f762b621 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -31,6 +31,7 @@ module Yesod.Form.Functions , check , checkBool , checkM + , customErrorMessage ) where import Yesod.Form.Types @@ -309,3 +310,8 @@ checkM f field = field Right Nothing -> return $ Right Nothing Right (Just a) -> fmap (either (Left . SomeMessage) (Right . Just)) $ f a } + +-- | Allows you to overwrite the error message on parse error. +customErrorMessage :: SomeMessage master -> Field sub master a -> Field sub master a +customErrorMessage msg field = field { fieldParse = \ts -> fmap (either +(const $ Left msg) Right) $ fieldParse field ts } diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index f26813b7..be5e45e8 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -29,6 +29,7 @@ module Yesod.Static , embed -- * Template Haskell helpers , staticFiles + , staticFilesList , publicFiles -- * Hashing , base64md5 @@ -155,6 +156,25 @@ getFileListPieces = flip go id staticFiles :: Prelude.FilePath -> Q [Dec] staticFiles dir = mkStaticFiles dir +-- | Same as 'staticFiles', but takes an explicit list of files to create +-- identifiers for. The files are given relative to the static folder. For +-- example, to get the files \"static/js/jquery.js\" and +-- \"static/css/normalize.css\", you would use: +-- +-- > staticFilesList "static" ["js/jquery.js"], ["css/normalize.css"]] +-- +-- This can be useful when you have a very large number of static files, but +-- only need to refer to a few of them from Haskell. +staticFilesList :: Prelude.FilePath -> [Prelude.FilePath] -> Q [Dec] +staticFilesList dir fs = + mkStaticFilesList dir (map split fs) "StaticRoute" True + where + split :: Prelude.FilePath -> [String] + split [] = [] + split x = + let (a, b) = break (== '/') x + in a : split (drop 1 b) + -- | like staticFiles, but doesn't append an etag to the query string -- This will compile faster, but doesn't achieve as great of caching. -- The browser can avoid downloading the file, but it always needs to send a request with the etag value or the last-modified value to the server to see if its copy is up to dat @@ -212,6 +232,15 @@ mkStaticFiles' :: Prelude.FilePath -- ^ static directory -> Q [Dec] mkStaticFiles' fp routeConName makeHash = do fs <- qRunIO $ getFileListPieces fp + mkStaticFilesList fp fs routeConName makeHash + +mkStaticFilesList + :: Prelude.FilePath -- ^ static directory + -> [[String]] -- ^ list of files to create identifiers for + -> String -- ^ route constructor "StaticRoute" + -> Bool -- ^ append checksum query parameter + -> Q [Dec] +mkStaticFilesList fp fs routeConName makeHash = do concat `fmap` mapM mkRoute fs where replace' c @@ -233,7 +262,6 @@ mkStaticFiles' fp routeConName makeHash = do pack' <- [|pack|] qs <- if makeHash then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f - -- FIXME hash <- qRunIO . calcHash $ fp ++ '/' : intercalate "/" f [|[(pack $(lift hash), mempty)]|] else return $ ListE [] return diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index e503db0c..18e26a80 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 0.3.0.1 +version: 0.3.1 license: BSD3 license-file: LICENSE author: Michael Snoyman diff --git a/yesod/Devel.hs b/yesod/Devel.hs index 03d8795f..09ce09aa 100755 --- a/yesod/Devel.hs +++ b/yesod/Devel.hs @@ -66,8 +66,8 @@ devel isDevel = do checkCabalFile gpd _ <- if isDevel - then rawSystem "cabal-dev" ["configure", "--cabal-install-arg=-fdevel"] - else rawSystem "cabal" ["configure", "-fdevel"] + then rawSystem "cabal-dev" ["configure", "--cabal-install-arg=-fdevel", "--disable-library-profiling"] + else rawSystem "cabal" ["configure", "-fdevel", "--disable-library-profiling"] T.writeFile "dist/devel.hs" (develFile pid) diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index 287bb8a9..5cd5569e 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/yesod/Scaffolding/Scaffolder.hs @@ -94,10 +94,6 @@ scaffold = do MongoDB -> $(codegen $ "mongoDBConnPool") Tiny -> "" - settingsTextImport = case backend of - Postgresql -> "import Data.Text (Text, pack, concat)\nimport Prelude hiding (concat)" - _ -> "import Data.Text (Text, pack)" - packages = if backend == MongoDB then " , persistent-mongoDB >= 0.6.1 && < 0.7\n , mongoDB >= 1.1\n , bson >= 0.1.5\n" @@ -124,6 +120,7 @@ scaffold = do mkDir "Model" mkDir "deploy" mkDir "Settings" + mkDir "messages" writeFile' ("deploy/Procfile") $(codegen "deploy/Procfile") @@ -143,24 +140,25 @@ scaffold = do writeFile' "LICENSE" $(codegen "LICENSE") writeFile' ("Foundation.hs") $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs") writeFile' "Application.hs" $ ifTiny $(codegen "tiny/Application.hs") $(codegen "Application.hs") - writeFile' "Handler/Root.hs" $ ifTiny $(codegen "tiny/Handler/Root.hs") $(codegen "Handler/Root.hs") + writeFile' "Handler/Root.hs" $(codegen "Handler/Root.hs") unless isTiny $ writeFile' "Model.hs" $(codegen "Model.hs") writeFile' "Settings.hs" $ ifTiny $(codegen "tiny/Settings.hs") $(codegen "Settings.hs") writeFile' "Settings/StaticFiles.hs" $(codegen "Settings/StaticFiles.hs") - writeFile' "cassius/default-layout.cassius" - $(codegen "cassius/default-layout.cassius") + writeFile' "lucius/default-layout.lucius" + $(codegen "lucius/default-layout.lucius") writeFile' "hamlet/default-layout.hamlet" $(codegen "hamlet/default-layout.hamlet") writeFile' "hamlet/boilerplate-layout.hamlet" $(codegen "hamlet/boilerplate-layout.hamlet") - writeFile' "static/css/normalize.css" - $(codegen "static/css/normalize.css") - writeFile' "hamlet/homepage.hamlet" $ ifTiny $(codegen "tiny/hamlet/homepage.hamlet") $(codegen "hamlet/homepage.hamlet") + writeFile' "lucius/normalize.lucius" + $(codegen "lucius/normalize.lucius") + writeFile' "hamlet/homepage.hamlet" $(codegen "hamlet/homepage.hamlet") writeFile' "config/routes" $ ifTiny $(codegen "tiny/config/routes") $(codegen "config/routes") - writeFile' "cassius/homepage.cassius" $(codegen "cassius/homepage.cassius") + writeFile' "lucius/homepage.lucius" $(codegen "lucius/homepage.lucius") writeFile' "julius/homepage.julius" $(codegen "julius/homepage.julius") unless isTiny $ writeFile' "config/models" $(codegen "config/models") - + writeFile' "messages/en.msg" $(codegen "messages/en.msg") + S.writeFile (dir ++ "/config/favicon.ico") $(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do pack <- [|S.pack|] diff --git a/yesod/scaffold/Application.hs.cg b/yesod/scaffold/Application.hs.cg index 03153b5a..6c9a5c65 100644 --- a/yesod/scaffold/Application.hs.cg +++ b/yesod/scaffold/Application.hs.cg @@ -12,11 +12,12 @@ import Foundation import Settings import Settings.StaticFiles (static) import Yesod.Auth -import Yesod.Logger (makeLogger, flushLogger, Logger, logString, logLazyText) +import Yesod.Default.Config +import Yesod.Default.Main +import Yesod.Logger (Logger) import Database.Persist.~importGenericDB~ import Data.ByteString (ByteString) import Data.Dynamic (Dynamic, toDyn) -import Network.Wai.Middleware.Debug (debugHandle) #ifndef WINDOWS import qualified System.Posix.Signals as Signal @@ -44,7 +45,7 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- 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~ :: AppConfig -> Logger -> (Application -> IO a) -> IO () +with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO () with~sitearg~ conf logger f = do s <- static Settings.staticDir Settings.withConnectionPool conf $ \p -> do~runMigration~ @@ -63,16 +64,4 @@ with~sitearg~ conf logger f = do -- for yesod devel withDevelAppPort :: Dynamic -withDevelAppPort = - toDyn go - where - go :: ((Int, Application) -> IO ()) -> IO () - go f = do - conf <- Settings.loadConfig Settings.Development - let port = appPort conf - logger <- makeLogger - logString logger $ "Devel application launched, listening on port " ++ show port - with~sitearg~ conf logger $ \app -> f (port, debugHandle (logHandle logger) app) - flushLogger logger - where - logHandle logger msg = logLazyText logger msg >> flushLogger logger +withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~ diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg index 3f000eb5..d0740589 100644 --- a/yesod/scaffold/Foundation.hs.cg +++ b/yesod/scaffold/Foundation.hs.cg @@ -4,6 +4,7 @@ module Foundation ( ~sitearg~ (..) , ~sitearg~Route (..) + , ~sitearg~Message (..) , resources~sitearg~ , Handler , Widget @@ -22,19 +23,19 @@ import Settings.StaticFiles import Yesod.Auth import Yesod.Auth.OpenId import Yesod.Auth.Email +import Yesod.Default.Config +import Yesod.Default.Util (addStaticContentExternal) import Yesod.Logger (Logger, logLazyText) import qualified Settings -import System.Directory import qualified Data.ByteString.Lazy as L import Database.Persist.~importGenericDB~ import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile) import Model import Data.Maybe (isJust) -import Control.Monad (join, unless) +import Control.Monad (join) import Network.Mail.Mime import qualified Data.Text.Lazy.Encoding import Text.Jasmine (minifym) -import qualified Data.Text as T import Web.ClientSession (getKey) import Text.Blaze.Renderer.Utf8 (renderHtml) import Text.Hamlet (shamlet) @@ -45,12 +46,15 @@ import Text.Shakespeare.Text (stext) -- starts running, such as database connections. Every handler will have -- access to the data present here. data ~sitearg~ = ~sitearg~ - { settings :: Settings.AppConfig + { settings :: AppConfig DefaultEnv , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. , connPool :: Settings.ConnectionPool -- ^ Database connection pool. } +-- Set up i18n messages. See the message folder. +mkMessage "~sitearg~" "messages" "en" + -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: -- http://www.yesodweb.com/book/handler @@ -75,7 +79,7 @@ mkYesodData "~sitearg~" $(parseRoutesFile "config/routes") -- 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 . settings + approot = appRoot . settings -- Place the session key file in the config folder encryptKey _ = fmap Just $ getKey "config/client_session_key.aes" @@ -84,7 +88,8 @@ instance Yesod ~sitearg~ where mmsg <- getMessage pc <- widgetToPageContent $ do widget - addCassius $(cassiusFile "default-layout") + toWidget $(luciusFile "normalize") + toWidget $(luciusFile "default-layout") hamletToRepHtml $(hamletFile "default-layout") -- This is done to provide an optimization for serving static files from @@ -103,21 +108,7 @@ instance Yesod ~sitearg~ where -- 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 ++ '.' : T.unpack ext' - let content' = - if ext' == "js" - then case minifym content of - Left _ -> content - Right y -> y - else content - 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", T.pack fn] [], []) - + addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) -- How to run database actions. instance YesodPersist ~sitearg~ where diff --git a/yesod/scaffold/Handler/Root.hs.cg b/yesod/scaffold/Handler/Root.hs.cg index 99bf711d..e485b7cd 100644 --- a/yesod/scaffold/Handler/Root.hs.cg +++ b/yesod/scaffold/Handler/Root.hs.cg @@ -12,7 +12,6 @@ import Foundation -- inclined, or create a single monolithic file. getRootR :: Handler RepHtml getRootR = do - mu <- maybeAuth defaultLayout $ do h2id <- lift newIdent setTitle "~project~ homepage" diff --git a/yesod/scaffold/Settings.hs.cg b/yesod/scaffold/Settings.hs.cg index 9109198e..c60fb3f6 100644 --- a/yesod/scaffold/Settings.hs.cg +++ b/yesod/scaffold/Settings.hs.cg @@ -18,9 +18,6 @@ module Settings , runConnectionPool , staticRoot , staticDir - , loadConfig - , AppEnvironment(..) - , AppConfig(..) ) where import qualified Text.Hamlet as S @@ -32,75 +29,11 @@ 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.Default.Config import Data.Monoid (mempty) import System.Directory (doesFileExist) -~settingsTextImport~ -import Data.Object -import qualified Data.Object.Yaml as YAML -import Control.Monad (join) +import Data.Text (Text) -data AppEnvironment = Test - | Development - | Staging - | Production - deriving (Eq, Show, Read, Enum, Bounded) - --- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml. --- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments). --- --- By convention these settings should be overwritten by any command line arguments. --- See config/Foundation.hs for command line arguments --- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku). --- -data AppConfig = AppConfig { - appEnv :: AppEnvironment - - , appPort :: Int - - -- | 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. - -- - -- 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. - , connectionPoolSize :: Int - - -- | 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. - -- Please note that there is no trailing slash. - -- - -- You probably want to change this! If your domain name was "yesod.com", - -- you would probably want it to be: - -- > "http://yesod.com" - , appRoot :: Text -} deriving (Show) - -loadConfig :: AppEnvironment -> IO AppConfig -loadConfig env = do - allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping - settings <- lookupMapping (show env) allSettings - hostS <- lookupScalar "host" settings - port <- fmap read $ lookupScalar "port" settings - connectionPoolSizeS <- lookupScalar "connectionPoolSize" settings - return $ AppConfig { - appEnv = env - , appPort = port - , appRoot = pack $ hostS ++ addPort port - , connectionPoolSize = read connectionPoolSizeS - } - where - addPort :: Int -> String -#ifdef PRODUCTION - addPort _ = "" -#else - addPort p = ":" ++ (show p) -#endif -- Static setting below. Changing these requires a recompile @@ -122,7 +55,7 @@ staticDir = "static" -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in Foundation.hs -staticRoot :: AppConfig -> Text +staticRoot :: AppConfig DefaultEnv -> Text staticRoot conf = [st|#{appRoot conf}/static|] diff --git a/yesod/scaffold/cassius/default-layout.cassius.cg b/yesod/scaffold/cassius/default-layout.cassius.cg deleted file mode 100644 index 77177469..00000000 --- a/yesod/scaffold/cassius/default-layout.cassius.cg +++ /dev/null @@ -1,3 +0,0 @@ -body - font-family: sans-serif - diff --git a/yesod/scaffold/config/mongoDB.yml.cg b/yesod/scaffold/config/mongoDB.yml.cg index 60f74187..b97d7dfa 100644 --- a/yesod/scaffold/config/mongoDB.yml.cg +++ b/yesod/scaffold/config/mongoDB.yml.cg @@ -4,6 +4,7 @@ Default: &defaults host: localhost port: 27017 database: ~project~ + poolsize: 10 Development: <<: *defaults @@ -14,8 +15,10 @@ Test: Staging: database: ~project~_staging + poolsize: 100 <<: *defaults Production: database: ~project~_production + poolsize: 100 <<: *defaults diff --git a/yesod/scaffold/config/postgresql.yml.cg b/yesod/scaffold/config/postgresql.yml.cg index 2f60ddab..aceae393 100644 --- a/yesod/scaffold/config/postgresql.yml.cg +++ b/yesod/scaffold/config/postgresql.yml.cg @@ -4,6 +4,7 @@ Default: &defaults host: localhost port: 5432 database: ~project~ + poolsize: 10 Development: <<: *defaults @@ -14,7 +15,10 @@ Test: Staging: database: ~project~_staging + poolsize: 100 + <<: *defaults Production: database: ~project~_production + poolsize: 100 <<: *defaults diff --git a/yesod/scaffold/config/settings.yml.cg b/yesod/scaffold/config/settings.yml.cg index 1485242c..816a2db6 100644 --- a/yesod/scaffold/config/settings.yml.cg +++ b/yesod/scaffold/config/settings.yml.cg @@ -1,7 +1,6 @@ Default: &defaults - host: "http://localhost" + host: "localhost" port: 3000 - connectionPoolSize: 10 Development: <<: *defaults @@ -13,4 +12,5 @@ Staging: <<: *defaults Production: + approot: "http://www.example.com" <<: *defaults diff --git a/yesod/scaffold/config/sqlite.yml.cg b/yesod/scaffold/config/sqlite.yml.cg index b9f01df1..ebee1fa8 100644 --- a/yesod/scaffold/config/sqlite.yml.cg +++ b/yesod/scaffold/config/sqlite.yml.cg @@ -1,5 +1,6 @@ Default: &defaults database: ~project~.sqlite3 + poolsize: 10 Development: <<: *defaults @@ -10,8 +11,10 @@ Test: Staging: database: ~project~_staging.sqlite3 + poolsize: 100 <<: *defaults Production: database: ~project~_production.sqlite3 + poolsize: 100 <<: *defaults diff --git a/yesod/scaffold/hamlet/boilerplate-layout.hamlet.cg b/yesod/scaffold/hamlet/boilerplate-layout.hamlet.cg index 522df932..22a5aca4 100644 --- a/yesod/scaffold/hamlet/boilerplate-layout.hamlet.cg +++ b/yesod/scaffold/hamlet/boilerplate-layout.hamlet.cg @@ -15,7 +15,6 @@ #{pageTitle pc} - <link rel="stylesheet" href=@{StaticR css_normalize_css}> ^{pageHead pc} <!--[if lt IE 9]> diff --git a/yesod/scaffold/hamlet/default-layout.hamlet.cg b/yesod/scaffold/hamlet/default-layout.hamlet.cg index 0a4d08f4..f31acb19 100644 --- a/yesod/scaffold/hamlet/default-layout.hamlet.cg +++ b/yesod/scaffold/hamlet/default-layout.hamlet.cg @@ -2,7 +2,6 @@ <html <head <title>#{pageTitle pc} - <link rel="stylesheet" href=@{StaticR css_normalize_css}> ^{pageHead pc} <body $maybe msg <- mmsg diff --git a/yesod/scaffold/hamlet/homepage.hamlet.cg b/yesod/scaffold/hamlet/homepage.hamlet.cg index 727f0eb6..e8907860 100644 --- a/yesod/scaffold/hamlet/homepage.hamlet.cg +++ b/yesod/scaffold/hamlet/homepage.hamlet.cg @@ -1,13 +1,2 @@ -<h1>Hello +<h1>_{MsgHello} <h2 ##{h2id}>You do not have Javascript enabled. -$maybe u <- mu - <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 - . - diff --git a/yesod/scaffold/lucius/default-layout.lucius.cg b/yesod/scaffold/lucius/default-layout.lucius.cg new file mode 100644 index 00000000..799dec4f --- /dev/null +++ b/yesod/scaffold/lucius/default-layout.lucius.cg @@ -0,0 +1,4 @@ +body { + font-family: sans-serif; +} + diff --git a/yesod/scaffold/cassius/homepage.cassius.cg b/yesod/scaffold/lucius/homepage.lucius.cg similarity index 64% rename from yesod/scaffold/cassius/homepage.cassius.cg rename to yesod/scaffold/lucius/homepage.lucius.cg index 2ac20924..e8cf5292 100644 --- a/yesod/scaffold/cassius/homepage.cassius.cg +++ b/yesod/scaffold/lucius/homepage.lucius.cg @@ -1,5 +1,7 @@ -h1 +h1 { text-align: center -h2##{h2id} +} +h2##{h2id} { color: #990 +} diff --git a/yesod/scaffold/static/css/normalize.css.cg b/yesod/scaffold/lucius/normalize.lucius.cg similarity index 100% rename from yesod/scaffold/static/css/normalize.css.cg rename to yesod/scaffold/lucius/normalize.lucius.cg diff --git a/yesod/scaffold/main.hs.cg b/yesod/scaffold/main.hs.cg index eede5e55..db9ccf5b 100644 --- a/yesod/scaffold/main.hs.cg +++ b/yesod/scaffold/main.hs.cg @@ -1,68 +1,6 @@ -{-# LANGUAGE CPP, DeriveDataTypeable #-} -import Settings (AppEnvironment(..), AppConfig(..), loadConfig) -import Application (with~sitearg~) -import Network.Wai.Handler.Warp (run) -import System.Console.CmdArgs hiding (args) -import Data.Char (toUpper, toLower) - -#ifndef PRODUCTION -import Network.Wai.Middleware.Debug (debugHandle) -import Yesod.Logger (logString, logLazyText, flushLogger, makeLogger) -#else -import Yesod.Logger (makeLogger) -#endif +import Yesod.Default.Config (fromArgs) +import Yesod.Default.Main (defaultMain) +import Application (with~sitearg~) main :: IO () -main = do - logger <- makeLogger - args <- cmdArgs argConfig - env <- getAppEnv args - config <- loadConfig env - let c = if port args /= 0 - then config { appPort = port args } - else config - -#if PRODUCTION - with~sitearg~ c logger $ run (appPort c) -#else - logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c) - with~sitearg~ c logger $ run (appPort c) . debugHandle (logHandle logger) - flushLogger logger - - where - logHandle logger msg = logLazyText logger msg >> flushLogger logger -#endif - -data ArgConfig = ArgConfig - { environment :: String - , port :: Int - } deriving (Show, Data, Typeable) - -argConfig :: ArgConfig -argConfig = ArgConfig - { environment = def - &= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments)) - &= typ "ENVIRONMENT" - , port = def - &= typ "PORT" - } - -environments :: [String] -environments = map ((map toLower) . show) ([minBound..maxBound] :: [AppEnvironment]) - --- | retrieve the -e environment option -getAppEnv :: ArgConfig -> IO AppEnvironment -getAppEnv cfg = do - let e = if environment cfg /= "" - then environment cfg - else -#if PRODUCTION - "production" -#else - "development" -#endif - return $ read $ capitalize e - - where - capitalize [] = [] - capitalize (x:xs) = toUpper x : map toLower xs +main = defaultMain fromArgs with~sitearg~ diff --git a/yesod/scaffold/messages/en.msg.cg b/yesod/scaffold/messages/en.msg.cg new file mode 100644 index 00000000..e928c34b --- /dev/null +++ b/yesod/scaffold/messages/en.msg.cg @@ -0,0 +1 @@ +Hello: Hello diff --git a/yesod/scaffold/mongoDBConnPool.cg b/yesod/scaffold/mongoDBConnPool.cg index 57cb2aa0..4269f2fa 100644 --- a/yesod/scaffold/mongoDBConnPool.cg +++ b/yesod/scaffold/mongoDBConnPool.cg @@ -1,16 +1,8 @@ runConnectionPool :: MonadControlIO m => Action m a -> ConnectionPool -> m a runConnectionPool = runMongoDBConn (ConfirmWrites [u"j" =: True]) -withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig -> (ConnectionPool -> m b) -> m b +withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig DefaultEnv -> (ConnectionPool -> m b) -> m b withConnectionPool conf f = do - (database,host) <- liftIO $ loadConnParams (appEnv conf) - withMongoDBPool (u database) host (connectionPoolSize conf) f - where - -- | The database connection parameters. - -- loadConnParams :: AppEnvironment -> IO (Database, HostName) - loadConnParams env = do - allSettings <- (join $ YAML.decodeFile ("config/mongoDB.yml" :: String)) >>= fromMapping - settings <- lookupMapping (show env) allSettings - database <- lookupScalar "database" settings - host <- lookupScalar "host" settings - return (database, host) + dbConf <- liftIO $ loadMongo (appEnv conf) + withMongoDBPool (u $ mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f + diff --git a/yesod/scaffold/postgresqlConnPool.cg b/yesod/scaffold/postgresqlConnPool.cg index 9cf1129b..6619a88e 100644 --- a/yesod/scaffold/postgresqlConnPool.cg +++ b/yesod/scaffold/postgresqlConnPool.cg @@ -1,23 +1,10 @@ runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool = runSqlPool -withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a +withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a withConnectionPool conf f = do - cs <- liftIO $ loadConnStr (appEnv conf) - with~upper~Pool cs (connectionPoolSize conf) f - where - -- | The database connection string. The meaning of this string is backend- - -- specific. - loadConnStr :: AppEnvironment -> IO Text - loadConnStr env = do - allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping - settings <- lookupMapping (show env) allSettings - database <- lookupScalar "database" settings :: IO Text - - connPart <- fmap concat $ (flip mapM) ["user", "password", "host", "port"] $ \key -> do - value <- lookupScalar key settings - return $ [st| #{key}=#{value} |] - return $ [st|#{connPart} dbname=#{database}|] + dbConf <- liftIO $ load~upper~ (appEnv conf) + with~upper~Pool (pgConnStr dbConf) (pgPoolSize dbConf) f -- Example of making a dynamic configuration static -- use /return $(mkConnStr Production)/ instead of loadConnStr diff --git a/yesod/scaffold/project.cabal.cg b/yesod/scaffold/project.cabal.cg index 3109b5ed..3055a7e6 100644 --- a/yesod/scaffold/project.cabal.cg +++ b/yesod/scaffold/project.cabal.cg @@ -37,6 +37,8 @@ library Settings.StaticFiles Handler.Root + ghc-options: -Wall -threaded -O0 + executable ~project~ if flag(devel) Buildable: False @@ -45,7 +47,7 @@ executable ~project~ cpp-options: -DPRODUCTION ghc-options: -Wall -threaded -O2 else - ghc-options: -Wall -threaded + ghc-options: -Wall -threaded -O0 if os(windows) cpp-options: -DWINDOWS @@ -58,6 +60,7 @@ executable ~project~ , yesod-core , yesod-auth , yesod-static + , yesod-default , blaze-html , yesod-form , mime-mail diff --git a/yesod/scaffold/sqliteConnPool.cg b/yesod/scaffold/sqliteConnPool.cg index ba4981f2..56e1ae9d 100644 --- a/yesod/scaffold/sqliteConnPool.cg +++ b/yesod/scaffold/sqliteConnPool.cg @@ -1,18 +1,10 @@ runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a runConnectionPool = runSqlPool -withConnectionPool :: MonadControlIO m => AppConfig -> (ConnectionPool -> m a) -> m a +withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a withConnectionPool conf f = do - cs <- liftIO $ loadConnStr (appEnv conf) - with~upper~Pool cs (connectionPoolSize conf) f - where - -- | The database connection string. The meaning of this string is backend- - -- specific. - loadConnStr :: AppEnvironment -> IO Text - loadConnStr env = do - allSettings <- (join $ YAML.decodeFile ("config/~backendLower~.yml" :: String)) >>= fromMapping - settings <- lookupMapping (show env) allSettings - lookupScalar "database" settings + dbConf <- liftIO $ load~upper~ (appEnv conf) + with~upper~Pool (sqlDatabase dbConf) (sqlPoolSize dbConf) f -- Example of making a dynamic configuration static -- use /return $(mkConnStr Production)/ instead of loadConnStr diff --git a/yesod/scaffold/tiny/Application.hs.cg b/yesod/scaffold/tiny/Application.hs.cg index 99e4d7f9..0bd1d218 100644 --- a/yesod/scaffold/tiny/Application.hs.cg +++ b/yesod/scaffold/tiny/Application.hs.cg @@ -11,11 +11,12 @@ module Application import Foundation import Settings import Yesod.Static -import Yesod.Logger (makeLogger, flushLogger, Logger, logLazyText, logString) +import Yesod.Default.Config +import Yesod.Default.Main (defaultDevelApp) +import Yesod.Logger (Logger) import Data.ByteString (ByteString) import Network.Wai (Application) import Data.Dynamic (Dynamic, toDyn) -import Network.Wai.Middleware.Debug (debugHandle) -- Import all relevant handler modules here. import Handler.Root @@ -37,7 +38,7 @@ getRobotsR = return $ RepPlain $ toContent ("User-agent: *" :: ByteString) -- 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~ :: AppConfig -> Logger -> (Application -> IO a) -> IO a +with~sitearg~ :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO a with~sitearg~ conf logger f = do #ifdef PRODUCTION s <- static Settings.staticDir @@ -49,16 +50,4 @@ with~sitearg~ conf logger f = do -- for yesod devel withDevelAppPort :: Dynamic -withDevelAppPort = - toDyn go - where - go :: ((Int, Application) -> IO ()) -> IO () - go f = do - conf <- Settings.loadConfig Settings.Development - let port = appPort conf - logger <- makeLogger - logString logger $ "Devel application launched, listening on port " ++ show port - with~sitearg~ conf logger $ \app -> f (port, debugHandle (logHandle logger) app) - flushLogger logger - where - logHandle logger msg = logLazyText logger msg >> flushLogger logger +withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~ diff --git a/yesod/scaffold/tiny/Foundation.hs.cg b/yesod/scaffold/tiny/Foundation.hs.cg index 72993157..ca02521b 100644 --- a/yesod/scaffold/tiny/Foundation.hs.cg +++ b/yesod/scaffold/tiny/Foundation.hs.cg @@ -1,8 +1,9 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} module Foundation ( ~sitearg~ (..) , ~sitearg~Route (..) + , ~sitearg~Message (..) , resources~sitearg~ , Handler , Widget @@ -14,17 +15,15 @@ module Foundation ) where import Yesod.Core +import Yesod.Default.Config +import Yesod.Default.Util (addStaticContentExternal) import Yesod.Static (Static, base64md5, StaticRoute(..)) import Settings.StaticFiles import Yesod.Logger (Logger, logLazyText) import qualified Settings -import System.Directory -import qualified Data.ByteString.Lazy as L import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile) -import Control.Monad (unless) import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO) -import qualified Data.Text as T import Web.ClientSession (getKey) -- | The site argument for your application. This can be a good place to @@ -32,11 +31,14 @@ import Web.ClientSession (getKey) -- starts running, such as database connections. Every handler will have -- access to the data present here. data ~sitearg~ = ~sitearg~ - { settings :: Settings.AppConfig + { settings :: AppConfig DefaultEnv , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. } +-- Set up i18n messages. See the message folder. +mkMessage "~sitearg~" "messages" "en" + -- 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/ @@ -61,7 +63,7 @@ mkYesodData "~sitearg~" $(parseRoutesFile "config/routes") -- 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 . settings + approot = appRoot . settings -- Place the session key file in the config folder encryptKey _ = fmap Just $ getKey "config/client_session_key.aes" @@ -70,7 +72,8 @@ instance Yesod ~sitearg~ where mmsg <- getMessage pc <- widgetToPageContent $ do widget - addCassius $(cassiusFile "default-layout") + toWidget $(luciusFile "normalize") + toWidget $(luciusFile "default-layout") hamletToRepHtml $(hamletFile "default-layout") -- This is done to provide an optimization for serving static files from @@ -86,11 +89,4 @@ instance Yesod ~sitearg~ where -- 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 ++ '.' : 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", T.pack fn] [], []) + addStaticContent = addStaticContentExternal (const $ Left ()) base64md5 Settings.staticDir (StaticR . flip StaticRoute []) diff --git a/yesod/scaffold/tiny/Handler/Root.hs.cg b/yesod/scaffold/tiny/Handler/Root.hs.cg deleted file mode 100644 index e485b7cd..00000000 --- a/yesod/scaffold/tiny/Handler/Root.hs.cg +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} -module Handler.Root where - -import Foundation - --- This is a handler function for the GET request method on the RootR --- resource pattern. All of your resource patterns are defined in --- config/routes --- --- 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 - defaultLayout $ do - h2id <- lift newIdent - setTitle "~project~ homepage" - addWidget $(widgetFile "homepage") diff --git a/yesod/scaffold/tiny/Settings.hs.cg b/yesod/scaffold/tiny/Settings.hs.cg index bec5d248..605bc709 100644 --- a/yesod/scaffold/tiny/Settings.hs.cg +++ b/yesod/scaffold/tiny/Settings.hs.cg @@ -14,9 +14,6 @@ module Settings , widgetFile , staticRoot , staticDir - , loadConfig - , AppEnvironment(..) - , AppConfig(..) ) where import qualified Text.Hamlet as S @@ -27,60 +24,10 @@ 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) -~settingsTextImport~ -import Data.Object -import qualified Data.Object.Yaml as YAML -import Control.Monad (join) - -data AppEnvironment = Test - | Development - | Staging - | Production - deriving (Eq, Show, Read, Enum, Bounded) - --- | Dynamic per-environment configuration loaded from the YAML file Settings.yaml. --- Use dynamic settings to avoid the need to re-compile the application (between staging and production environments). --- --- By convention these settings should be overwritten by any command line arguments. --- See config/~sitearg~.hs for command line arguments --- Command line arguments provide some convenience but are also required for hosting situations where a setting is read from the environment (appPort on Heroku). --- -data AppConfig = AppConfig { - appEnv :: AppEnvironment - - , appPort :: Int - - -- | 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. - -- Please note that there is no trailing slash. - -- - -- You probably want to change this! If your domain name was "yesod.com", - -- you would probably want it to be: - -- > "http://yesod.com" - , appRoot :: Text -} deriving (Show) - -loadConfig :: AppEnvironment -> IO AppConfig -loadConfig env = do - allSettings <- (join $ YAML.decodeFile ("config/settings.yml" :: String)) >>= fromMapping - settings <- lookupMapping (show env) allSettings - hostS <- lookupScalar "host" settings - port <- fmap read $ lookupScalar "port" settings - return $ AppConfig { - appEnv = env - , appPort = port - , appRoot = pack $ hostS ++ addPort port - } - where - addPort :: Int -> String -#ifdef PRODUCTION - addPort _ = "" -#else - addPort p = ":" ++ (show p) -#endif +import Data.Text (Text) -- | The location of static files on your system. This is a file system -- path. The default value works properly with your scaffolded site. @@ -100,7 +47,7 @@ staticDir = "static" -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in ~project~.hs -staticRoot :: AppConfig -> Text +staticRoot :: AppConfig DefaultEnv -> Text staticRoot conf = [st|#{appRoot conf}/static|] -- The rest of this file contains settings which rarely need changing by a diff --git a/yesod/scaffold/tiny/hamlet/homepage.hamlet.cg b/yesod/scaffold/tiny/hamlet/homepage.hamlet.cg deleted file mode 100644 index 34432b74..00000000 --- a/yesod/scaffold/tiny/hamlet/homepage.hamlet.cg +++ /dev/null @@ -1,2 +0,0 @@ -<h1>Hello -<h2 ##{h2id}>You do not have Javascript enabled. diff --git a/yesod/scaffold/tiny/project.cabal.cg b/yesod/scaffold/tiny/project.cabal.cg index 527f265b..1cc7fb75 100644 --- a/yesod/scaffold/tiny/project.cabal.cg +++ b/yesod/scaffold/tiny/project.cabal.cg @@ -48,6 +48,7 @@ executable ~project~ build-depends: base >= 4 && < 5 , yesod-core >= 0.9 && < 0.10 , yesod-static + , yesod-default , clientsession , wai-extra , directory diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 9b13dcdf..ef65d087 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -17,8 +17,8 @@ homepage: http://www.yesodweb.com/ extra-source-files: input/*.cg - scaffold/cassius/default-layout.cassius.cg - scaffold/cassius/homepage.cassius.cg + scaffold/lucius/default-layout.lucius.cg + scaffold/lucius/homepage.lucius.cg scaffold/Model.hs.cg scaffold/Foundation.hs.cg scaffold/LICENSE.cg @@ -26,11 +26,9 @@ extra-source-files: scaffold/tiny/Foundation.hs.cg scaffold/tiny/project.cabal.cg scaffold/tiny/Application.hs.cg - scaffold/tiny/hamlet/homepage.hamlet.cg - scaffold/tiny/Handler/Root.hs.cg scaffold/tiny/config/routes.cg scaffold/tiny/Settings.hs.cg - scaffold/static/css/normalize.css.cg + scaffold/lucius/normalize.lucius.cg scaffold/postgresqlConnPool.cg scaffold/sqliteConnPool.cg scaffold/.ghci.cg @@ -52,6 +50,7 @@ extra-source-files: scaffold/config/routes.cg scaffold/Settings.hs.cg scaffold/Settings/StaticFiles.hs.cg + scaffold/messages/en.msg.cg flag ghc7