yesod 0.9.4.1 → 0.10.1
raw patch · 31 files changed
+391/−254 lines, 31 filesdep +fast-loggerdep +wai-loggerdep ~Cabaldep ~filepathdep ~monad-control
Dependencies added: fast-logger, wai-logger
Dependency ranges changed: Cabal, filepath, monad-control, shakespeare-js, wai, wai-extra, warp, yesod-auth, yesod-core, yesod-form, yesod-json, yesod-persistent
Files
- Devel.hs +10/−56
- Scaffolding/CodeGen.hs +1/−1
- Scaffolding/Scaffolder.hs +21/−18
- Yesod.hs +26/−18
- input/database.cg +7/−2
- scaffold/.ghci.cg +0/−1
- scaffold/Application.hs.cg +28/−18
- scaffold/Foundation.hs.cg +24/−16
- scaffold/Import.hs.cg +2/−0
- scaffold/LICENSE.cg +0/−1
- scaffold/Model.hs.cg +3/−2
- scaffold/Settings.hs.cg +16/−2
- scaffold/Settings/StaticFiles.hs.cg +1/−2
- scaffold/config/mysql.yml.cg +24/−0
- scaffold/config/settings.yml.cg +3/−1
- scaffold/deploy/Procfile.cg +41/−9
- scaffold/devel.hs.cg +26/−0
- scaffold/main.hs.cg +4/−3
- scaffold/project.cabal.cg +14/−12
- scaffold/templates/boilerplate-wrapper.hamlet.cg +0/−42
- scaffold/templates/default-layout-wrapper.hamlet.cg +39/−5
- scaffold/templates/default-layout.hamlet.cg +2/−1
- scaffold/templates/default-layout.lucius.cg +0/−1
- scaffold/templates/homepage.julius.cg +0/−1
- scaffold/templates/homepage.lucius.cg +0/−1
- scaffold/tiny/Application.hs.cg +32/−11
- scaffold/tiny/Foundation.hs.cg +7/−9
- scaffold/tiny/Import.hs.cg +18/−0
- scaffold/tiny/Settings.hs.cg +16/−1
- scaffold/tiny/project.cabal.cg +7/−5
- yesod.cabal +19/−15
Devel.hs view
@@ -10,7 +10,6 @@ import qualified Distribution.Simple.Utils as D import qualified Distribution.Verbosity as D-import qualified Distribution.Package as D import qualified Distribution.PackageDescription.Parse as D import qualified Distribution.PackageDescription as D @@ -21,11 +20,8 @@ import qualified Data.List as L import qualified Data.Map as Map import Data.Maybe (listToMaybe)-import qualified Data.Text as T-import qualified Data.Text.IO as T import System.Directory (createDirectoryIfMissing, removeFile,- doesFileExist, getDirectoryContents) import System.Exit (exitFailure, exitSuccess) import System.Posix.Types (EpochTime)@@ -33,10 +29,7 @@ import System.Process (runCommand, terminateProcess, waitForProcess, rawSystem) -import Text.Shakespeare.Text (st)- import Build (recompDeps, getDeps,findHaskellFiles)-import Control.Monad (unless) #if __GLASGOW_HASKELL__ >= 700 #define ST st@@ -56,18 +49,17 @@ removeLock = try_ (removeFile lockFile) devel :: Bool -> IO ()-devel isDevel = do+devel isCabalDev = do writeLock putStrLn "Yesod devel server. Press ENTER to quit" _ <- forkIO $ do cabal <- D.findPackageDesc "." gpd <- D.readPackageDescription D.normal cabal- let pid = (D.package . D.packageDescription) gpd checkCabalFile gpd - _ <- if isDevel+ _ <- if isCabalDev then rawSystem "cabal-dev" [ "configure" , "--cabal-install-arg=-fdevel" -- legacy@@ -81,10 +73,7 @@ , "--disable-library-profiling" ] - exists <- doesFileExist "dist/devel.hs"- unless exists $ T.writeFile "dist/devel.hs" (develFile pid)-- mainLoop isDevel+ mainLoop isCabalDev _ <- getLine writeLock@@ -93,20 +82,21 @@ mainLoop :: Bool -> IO ()-mainLoop isDevel = forever $ do+mainLoop isCabalDev = forever $ do putStrLn "Rebuilding application..." recompDeps list <- getFileList- _ <- if isDevel+ _ <- if isCabalDev then rawSystem "cabal-dev" ["build"] else rawSystem "cabal" ["build"] removeLock- putStrLn "Starting development server..."- pkg <- pkgConfigs isDevel- ph <- runCommand $ concat ["runghc ", pkg, " dist/devel.hs"]+ pkg <- pkgConfigs isCabalDev+ let start = concat ["runghc ", pkg, " devel.hs"]+ putStrLn $ "Starting development server: " ++ start+ ph <- runCommand start watchTid <- forkIO . try_ $ do watchForChanges list putStrLn "Stopping development server..."@@ -153,42 +143,6 @@ then return () else threadDelay 1000000 >> watchForChanges list -showPkgName :: D.PackageId -> String-showPkgName = (\(D.PackageName n) -> n) . D.pkgName--develFile :: D.PackageId -> T.Text-develFile pid = [ST|-{-# LANGUAGE PackageImports #-}-import "#{showPkgName pid}" Application (withDevelAppPort)-import Data.Dynamic (fromDynamic)-import Network.Wai.Handler.Warp- (runSettings, defaultSettings, settingsPort, settingsHost)-import Data.Maybe (fromJust)-import Control.Concurrent (forkIO)-import System.Directory (doesFileExist, removeFile)-import System.Exit (exitSuccess)-import Control.Concurrent (threadDelay)--main :: IO ()-main = do- putStrLn "Starting devel application"- wdap <- (return . fromJust . fromDynamic) withDevelAppPort- forkIO . wdap $ \(port, app) -> runSettings defaultSettings- { settingsPort = port- , settingsHost = "0.0.0.0"- } app- loop--loop :: IO ()-loop = do- threadDelay 100000- e <- doesFileExist "dist/devel-terminate"- if e then terminateDevel else loop--terminateDevel :: IO ()-terminateDevel = exitSuccess-|]- checkCabalFile :: D.GenericPackageDescription -> IO () checkCabalFile gpd = case D.condLibrary gpd of Nothing -> do@@ -197,7 +151,7 @@ Just ct -> case lookupDevelLib ct of Nothing -> do- putStrLn "Error: no library configuration for -fdevel"+ putStrLn "Error: no development flag found in your configuration file. Expected a 'library-only' flag or the older 'devel' flag" exitFailure Just dLib -> case (D.hsSourceDirs . D.libBuildInfo) dLib of
Scaffolding/CodeGen.hs view
@@ -14,7 +14,7 @@ codegenDir :: FilePath -> FilePath -> Q Exp codegenDir dir fp = do s' <- qRunIO $ L.readFile $ (dir ++ "/" ++ fp ++ ".cg")- let s = init $ LT.unpack $ LT.decodeUtf8 s'+ let s = LT.unpack $ LT.decodeUtf8 s' case parse (many parseToken) s s of Left e -> error $ show e Right tokens' -> do
Scaffolding/Scaffolder.hs view
@@ -22,7 +22,8 @@ if f s then return s else do- putStrLn "That was not a valid entry, please try again: "+ putStr "That was not a valid entry, please try again: "+ hFlush stdout prompt f qq :: String@@ -32,11 +33,11 @@ qq = "$" #endif -data Backend = Sqlite | Postgresql | MongoDB | Tiny+data Backend = Sqlite | Postgresql | Mysql | MongoDB | Tiny deriving (Eq, Read, Show, Enum, Bounded) puts :: String -> IO ()-puts s = putStr s >> hFlush stdout+puts s = putStr (init s) >> hFlush stdout backends :: [Backend] backends = [minBound .. maxBound]@@ -45,7 +46,7 @@ scaffold :: IO () scaffold = do puts $(codegenDir "input" "welcome")- name <- getLine+ name <- prompt $ not . null puts $(codegenDir "input" "project-name") let validPN c@@ -54,7 +55,7 @@ | '0' <= c && c <= '9' = True validPN '-' = True validPN _ = False- project <- prompt $ all validPN+ project <- prompt $ \s -> all validPN s && not (null s) let dir = project puts $(codegenDir "input" "site-arg")@@ -63,18 +64,20 @@ puts $(codegenDir "input" "database") - backendC <- prompt $ flip elem $ map (return . toLower . head . show) backends+ backendC <- prompt $ flip elem $ words "s p mysql mongo t" let (backend, importGenericDB, dbMonad, importPersist, mkPersistSettings) = case backendC of "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlSettings") "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlSettings")- "m" -> (MongoDB, "MongoDB", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }")+ "mysql" -> (Mysql, "GenericSql", "SqlPersist", "MySQL", "sqlSettings")+ "mongo" -> (MongoDB, "MongoDB", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }") "t" -> (Tiny, "","","",undefined) _ -> error $ "Invalid backend: " ++ backendC (modelImports) = case backend of MongoDB -> "import Database.Persist." ++ importGenericDB ++ "\nimport Language.Haskell.TH.Syntax" Sqlite -> "" Postgresql -> ""+ Mysql -> "" Tiny -> undefined uncapitalize s = toLower (head s) : tail s@@ -84,7 +87,7 @@ let runMigration = case backend of MongoDB -> ""- _ -> "\n Database.Persist.Base.runPool dbconf (runMigration migrateAll) p"+ _ -> "\n Database.Persist.Store.runPool dbconf (runMigration migrateAll) p" let importMigration = case backend of@@ -96,6 +99,7 @@ MongoDB -> "mongoDB" Sqlite -> "sqlite" Postgresql -> "postgresql"+ Mysql -> "mysql" Tiny -> error "Accessing dbConfigFile for Tiny" let configPersist =@@ -103,6 +107,7 @@ MongoDB -> "MongoConf" Sqlite -> "SqliteConf" Postgresql -> "PostgresConf"+ Mysql -> "MySQLConf" Tiny -> error "Accessing configPersist for Tiny" putStrLn "That's it! I'm creating your files now..."@@ -110,18 +115,16 @@ let withConnectionPool = case backend of Sqlite -> $(codegen $ "sqliteConnPool") Postgresql -> $(codegen $ "postgresqlConnPool")+ Mysql -> "" MongoDB -> $(codegen $ "mongoDBConnPool") Tiny -> "" packages = if backend == MongoDB- then " , persistent-mongoDB >= 0.6.1 && < 0.7\n , mongoDB >= 1.1\n , bson >= 0.1.5\n"- else " , persistent-" ++ backendLower ++ " >= 0.6 && < 0.7"+ then " , persistent-mongoDB >= 0.8 && < 0.9\n , mongoDB >= 1.1\n , bson >= 0.1.5\n"+ else " , persistent-" ++ backendLower ++ " >= 0.8 && < 0.9" - monadControlVersion =- if backend == MongoDB- then "== 0.2.*"- else "== 0.3.*"+ monadControlVersion = "== 0.3.*" let fst3 (x, _, _) = x@@ -149,6 +152,7 @@ Sqlite -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/sqlite.yml")) Postgresql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/postgresql.yml")) MongoDB -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/mongoDB.yml"))+ Mysql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen ("config/mysql.yml")) Tiny -> return () let isTiny = backend == Tiny@@ -156,11 +160,12 @@ writeFile' ("config/settings.yml") $(codegen "config/settings.yml") writeFile' ("main.hs") $(codegen "main.hs")+ writeFile' ("devel.hs") $(codegen "devel.hs") writeFile' (project ++ ".cabal") $ ifTiny $(codegen "tiny/project.cabal") $(codegen "project.cabal") writeFile' ".ghci" $(codegen ".ghci") writeFile' "LICENSE" $(codegen "LICENSE") writeFile' ("Foundation.hs") $ ifTiny $(codegen "tiny/Foundation.hs") $(codegen "Foundation.hs")- writeFile' "Import.hs" $(codegen "Import.hs")+ writeFile' ("Import.hs") $ ifTiny $(codegen "tiny/Import.hs") $(codegen "Import.hs") writeFile' "Application.hs" $ ifTiny $(codegen "tiny/Application.hs") $(codegen "Application.hs") writeFile' "Handler/Root.hs" $(codegen "Handler/Root.hs") unless isTiny $ writeFile' "Model.hs" $(codegen "Model.hs")@@ -172,8 +177,6 @@ $(codegen "templates/default-layout.hamlet") writeFile' "templates/default-layout-wrapper.hamlet" $(codegen "templates/default-layout-wrapper.hamlet")- writeFile' "templates/boilerplate-wrapper.hamlet"- $(codegen "templates/boilerplate-wrapper.hamlet") writeFile' "templates/normalize.lucius" $(codegen "templates/normalize.lucius") writeFile' "templates/homepage.hamlet"@@ -199,4 +202,4 @@ $(runIO (S.readFile "scaffold/config/robots.txt.cg") >>= \bs -> do [|S.pack $(return $ LitE $ StringL $ S.unpack bs)|]) - puts $(codegenDir "input" "done")+ putStr $(codegenDir "input" "done")
Yesod.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} -- | This module simply re-exports from other modules for your convenience. module Yesod ( -- * Re-exports from yesod-core@@ -13,13 +12,8 @@ , develServer -- * Commonly referenced functions/datatypes , Application- , lift , liftIO-#if MIN_VERSION_monad_control(0, 3, 0) , MonadBaseControl-#else- , MonadControlIO-#endif -- * Utilities , showIntegral , readIntegral@@ -50,18 +44,15 @@ import Yesod.Form import Yesod.Json import Yesod.Persist-import Network.Wai (Application)-import Network.Wai.Middleware.RequestLogger-import Control.Monad.Trans.Class (lift)-import Control.Monad.IO.Class (liftIO)-#if MIN_VERSION_monad_control(0, 3, 0)+import Network.HTTP.Types (status200)+import Control.Monad.IO.Class (liftIO, MonadIO(..)) import Control.Monad.Trans.Control (MonadBaseControl)-#else-import Control.Monad.IO.Control (MonadControlIO)-#endif +import Network.Wai+import Network.Wai.Logger import Network.Wai.Handler.Warp (run)-import System.IO (stderr, hPutStrLn)+import System.IO (stderr, stdout, hFlush, hPutStrLn)+import System.Log.FastLogger import Text.Blaze (toHtml) showIntegral :: Integral a => a -> String@@ -81,9 +72,26 @@ -- | Same as 'warp', but also sends a message to stdout for each request, and -- an \"application launched\" message as well. Can be useful for development. warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()-warpDebug port a = do- hPutStrLn stderr $ "Application launched, listening on port " ++ show port- toWaiApp a >>= run port . logStdout+warpDebug port app = do+ hPutStrLn stderr $ "Application launched, listening on port " ++ show port+ waiApp <- toWaiApp app+ dateRef <- dateInit+ run port $ (logStdout dateRef) waiApp++logStdout :: DateRef -> Middleware+logStdout dateRef waiApp =+ \req -> do+ logRequest dateRef req+ waiApp req++logRequest :: Control.Monad.IO.Class.MonadIO m =>+ DateRef -> Network.Wai.Request -> m ()+logRequest dateRef req = do+ date <- liftIO $ getDate dateRef+ let status = status200+ len = 4+ liftIO $ hPutLogStr stdout $ apacheFormat FromSocket date req status (Just len)+ liftIO $ hFlush stdout -- | Run a development server, where your code changes are automatically -- reloaded.
input/database.cg view
@@ -5,5 +5,10 @@ We have another option: a tiny project with minimal dependencies. Mostly this means no database and no authentication. -So, what'll it be?-s for sqlite, p for postgresql, m for mongodb, or t for tiny: + s = sqlite+ p = postgresql+ mongo = mongodb+ t = tiny+ mysql = MySQL (experimental)++So, what'll it be?
scaffold/.ghci.cg view
@@ -1,2 +1,1 @@ :set -i.:config:dist/build/autogen-
scaffold/Application.hs.cg view
@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Application- ( with~sitearg~- , withDevelAppPort+ ( getApplication+ , getApplicationDev ) where import Import@@ -11,15 +11,15 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers-import Data.Dynamic (Dynamic, toDyn) #if DEVELOPMENT-import Yesod.Logger (Logger, logBS, flushLogger)-import Network.Wai.Middleware.RequestLogger (logHandleDev)+import Yesod.Logger (Logger, logBS)+import Network.Wai.Middleware.RequestLogger (logCallbackDev) #else-import Yesod.Logger (Logger)-import Network.Wai.Middleware.RequestLogger (logStdout)+import Yesod.Logger (Logger, logBS, toProduction)+import Network.Wai.Middleware.RequestLogger (logCallback) #endif-import qualified Database.Persist.Base~importMigration~+import qualified Database.Persist.Store~importMigration~+import Network.HTTP.Conduit (newManager, def) -- Import all relevant handler modules here. import Handler.Root@@ -33,21 +33,31 @@ -- 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 DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()-with~sitearg~ conf logger f = do+getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application+getApplication conf logger = do+ manager <- newManager def s <- staticSite dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf)- $ either error return . Database.Persist.Base.loadConfig- Database.Persist.Base.withPool (dbconf :: Settings.PersistConfig) $ \p -> do~runMigration~- let h = ~sitearg~ conf logger s p- defaultRunner (f . logWare) h+ Database.Persist.Store.loadConfig >>=+ Database.Persist.Store.applyEnv+ p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~+ let foundation = ~sitearg~ conf setLogger s p manager dbconf+ app <- toWaiAppPlain foundation+ return $ logWare app where #ifdef DEVELOPMENT- logWare = logHandleDev (\msg -> logBS logger msg >> flushLogger logger)+ logWare = logCallbackDev (logBS setLogger)+ setLogger = logger #else- logWare = logStdout+ setLogger = toProduction logger -- by default the logger is set for development+ logWare = logCallback (logBS setLogger) #endif -- for yesod devel-withDevelAppPort :: Dynamic-withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~+getApplicationDev :: IO (Int, Application)+getApplicationDev =+ defaultDevelApp loader getApplication+ where+ loader = loadConfig (configSettings Development)+ { csParseExtra = parseExtra+ }
scaffold/Foundation.hs.cg view
@@ -1,6 +1,6 @@ module Foundation ( ~sitearg~ (..)- , ~sitearg~Route (..)+ , Route (..) , ~sitearg~Message (..) , resources~sitearg~ , Handler@@ -8,30 +8,29 @@ , Form , maybeAuth , requireAuth- , module Yesod , module Settings , module Model- , StaticRoute (..)- , AuthRoute (..) ) where import Prelude-import Yesod hiding (Form, AppConfig (..), withYamlEnvironment)-import Yesod.Static (Static, base64md5, StaticRoute(..))+import Yesod+import Yesod.Static import Settings.StaticFiles import Yesod.Auth-import Yesod.Auth.OpenId+import Yesod.Auth.BrowserId+import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) import Yesod.Logger (Logger, logMsg, formatLogText)+import Network.HTTP.Conduit (Manager) #ifdef DEVELOPMENT import Yesod.Logger (logLazyText) #endif import qualified Settings import qualified Data.ByteString.Lazy as L-import qualified Database.Persist.Base+import qualified Database.Persist.Store import Database.Persist.~importGenericDB~-import Settings (widgetFile)+import Settings (widgetFile, Extra (..)) import Model import Text.Jasmine (minifym) import Web.ClientSession (getKey)@@ -47,10 +46,12 @@ -- starts running, such as database connections. Every handler will have -- access to the data present here. data ~sitearg~ = ~sitearg~- { settings :: AppConfig DefaultEnv ()+ { settings :: AppConfig DefaultEnv Extra , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving.- , connPool :: Database.Persist.Base.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.+ , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool.+ , httpManager :: Manager+ , persistConfig :: Settings.PersistConfig } -- Set up i18n messages. See the message folder.@@ -82,12 +83,13 @@ -- 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 = appRoot . settings+ approot = ApprootMaster $ appRoot . settings -- Place the session key file in the config folder encryptKey _ = fmap Just $ getKey "config/client_session_key.aes" defaultLayout widget = do+ master <- getYesod mmsg <- getMessage -- We break up the default layout into two components:@@ -125,8 +127,12 @@ -- How to run database actions. instance YesodPersist ~sitearg~ where type YesodPersistBackend ~sitearg~ = ~dbMonad~- runDB f = liftIOHandler- $ fmap connPool getYesod >>= Database.Persist.Base.runPool (undefined :: Settings.PersistConfig) f+ runDB f = do+ master <- getYesod+ Database.Persist.Store.runPool+ (persistConfig master)+ f+ (connPool master) instance YesodAuth ~sitearg~ where type AuthId ~sitearg~ = UserId@@ -139,12 +145,14 @@ getAuthId creds = runDB $ do x <- getBy $ UniqueUser $ credsIdent creds case x of- Just (uid, _) -> return $ Just uid+ Just (Entity uid _) -> return $ Just uid Nothing -> do fmap Just $ insert $ User (credsIdent creds) Nothing -- You can add other plugins like BrowserID, email or OAuth here- authPlugins = [authOpenId]+ authPlugins _ = [authBrowserId, authGoogleEmail]++ authHttpManager = httpManager -- Sends off your mail. Requires sendmail in production! deliver :: ~sitearg~ -> L.ByteString -> IO ()
scaffold/Import.hs.cg view
@@ -1,5 +1,6 @@ module Import ( module Prelude+ , module Yesod , module Foundation , (<>) , Text@@ -8,6 +9,7 @@ ) where import Prelude hiding (writeFile, readFile)+import Yesod hiding (Route(..)) import Foundation import Data.Monoid (Monoid (mappend, mempty, mconcat)) import Control.Applicative ((<$>), (<*>), pure)
scaffold/LICENSE.cg view
@@ -23,4 +23,3 @@ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-
scaffold/Model.hs.cg view
@@ -3,11 +3,12 @@ import Prelude import Yesod import Data.Text (Text)+import Database.Persist.Quasi ~modelImports~ -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities -- at: -- http://www.yesodweb.com/book/persistent/-share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"] $(persistFile "config/models")-+share [mkPersist ~mkPersistSettings~, mkMigrate "migrateAll"]+ $(persistFileWith lowerCaseSettings "config/models")
scaffold/Settings.hs.cg view
@@ -8,15 +8,19 @@ , PersistConfig , staticRoot , staticDir+ , Extra (..)+ , parseExtra ) where -import Prelude (FilePath, String)+import Prelude import Text.Shakespeare.Text (st) import Language.Haskell.TH.Syntax import Database.Persist.~importPersist~ (~configPersist~) import Yesod.Default.Config import qualified Yesod.Default.Util import Data.Text (Text)+import Data.Yaml+import Control.Applicative -- | Which Persistent backend this site is using. type PersistConfig = ~configPersist~@@ -41,7 +45,7 @@ -- have to make a corresponding change here. -- -- To see how this value is used, see urlRenderOverride in Foundation.hs-staticRoot :: AppConfig DefaultEnv x -> Text+staticRoot :: AppConfig DefaultEnv x -> Text staticRoot conf = [~qq~st|#{appRoot conf}/static|] @@ -54,3 +58,13 @@ #else widgetFile = Yesod.Default.Util.widgetFileNoReload #endif++data Extra = Extra+ { extraCopyright :: Text+ , extraAnalytics :: Maybe Text -- ^ Google Analytics+ } deriving Show++parseExtra :: DefaultEnv -> Object -> Parser Extra+parseExtra _ o = Extra+ <$> o .: "copyright"+ <*> o .:? "analytics"
scaffold/Settings/StaticFiles.hs.cg view
@@ -1,7 +1,7 @@ module Settings.StaticFiles where import Prelude (IO)-import Yesod.Static (staticFiles, StaticRoute (StaticRoute))+import Yesod.Static import qualified Yesod.Static as Static import Settings (staticDir) @@ -19,4 +19,3 @@ -- Warning: any files added to your static directory during run-time can't be -- accessed this way. You'll have to use their FilePath or URL to access them. $(staticFiles Settings.staticDir)-
+ scaffold/config/mysql.yml.cg view
@@ -0,0 +1,24 @@+Default: &defaults+ user: ~project~+ password: ~project~+ host: localhost+ port: 3306+ database: ~project~+ poolsize: 10++Development:+ <<: *defaults++Test:+ database: ~project~_test+ <<: *defaults++Staging:+ database: ~project~_staging+ poolsize: 100+ <<: *defaults++Production:+ database: ~project~_production+ poolsize: 100+ <<: *defaults
scaffold/config/settings.yml.cg view
@@ -1,11 +1,13 @@ Default: &defaults host: "localhost" port: 3000+ copyright: Insert copyright statement here+ #analytics: UA-YOURCODE Development: <<: *defaults -Test:+Testing: <<: *defaults Staging:
scaffold/deploy/Procfile.cg view
@@ -15,30 +15,62 @@ # # Postgresql Yesod setup: #-# * add code to read DATABASE_URL environment variable.+# * add code to read the DATABASE_URL environment variable. # # import System.Environment # main = do-# durl <- getEnv "DATABASE_URL" # # parse env variable+# durl <- getEnv "DATABASE_URL" # # pass settings to withConnectionPool instead of directly using loadConnStr+# defaultMain (fromArgsExtra loadExtra) withYesodHeroku # # * add a dependency on the "heroku" package in your cabal file # -# * add code in Settings.hs to turn that url into connection parameters. The below works for Postgresql.+# * add code in Application.hs to turn the url into connection parameters. The below works for Postgresql. # # #ifdef !DEVELOPMENT # import qualified Web.Heroku # #endif #-# dbConnParams :: AppEnvironment -> IO [(Text, Text)]-# #ifdef !DEVELOPMENT-# dbConnParams _ = Web.Heroku.dbConnParams+#+# canonicalizeKey :: (Text, val) -> (Text, val)+# canonicalizeKey ("dbname", val) = ("database", val)+# canonicalizeKey pair = pair+#+# toMapping :: [(key, val)] -> DO.Object key val+# toMapping = DO.Mapping . map (\(key, val) -> (key, DO.Scalar val))+#+# combineMappings :: DO.Object key val -> DO.Object key val -> DO.Object key val+# combineMappings (DO.Mapping m1) (DO.Mapping m2) = DO.Mapping $ m1 ++ m2+# combineMappings _ _ = error "Data.Object is not a Mapping."+#+# loadHerokuConfig :: DO.TextObject -> IO Settings.PersistConfig+# loadHerokuConfig ymlenv = do+# #if DEVELOPMENT+# let urlMap = DO.Mapping [] # #else-# dbConnParams env = do-# ...+# urlMap <- Web.Heroku.dbConnParams >>= return . toMapping . map canonicalizeKey+# #endif+# either error return $ Database.Persist.Base.loadConfig (combineMappings urlMap ymlenv) # #+# withYesodHeroku :: AppConfig DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()+# withYesodHeroku conf logger f = do+# s <- staticSite+# dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf) loadHerokuConfig+# Database.Persist.Base.withPool (dbconf :: Settings.PersistConfig) $ \p -> do+# Database.Persist.Base.runPool dbconf (runMigration migrateAll) p+# let h = YesodHeroku conf logger s p+# defaultRunner (f . logWare) h+# where+# #ifdef DEVELOPMENT+# logWare = logStdoutDev+# #else+# logWare = logStdout+# #endif+++ # Heroku setup: # Find the Heroku guide. Roughly: #@@ -63,4 +95,4 @@ # Heroku configuration that runs your app-web: ./dist/build/~project~/~project~ -p $PORT+web: ./dist/build/~project~/~project~ production -p $PORT
+ scaffold/devel.hs.cg view
@@ -0,0 +1,26 @@+{-# LANGUAGE PackageImports #-}+import "~project~" Application (getApplicationDev)+import Network.Wai.Handler.Warp+ (runSettings, defaultSettings, settingsPort)+import Control.Concurrent (forkIO)+import System.Directory (doesFileExist, removeFile)+import System.Exit (exitSuccess)+import Control.Concurrent (threadDelay)++main :: IO ()+main = do+ putStrLn "Starting devel application"+ (port, app) <- getApplicationDev+ forkIO $ runSettings defaultSettings+ { settingsPort = port+ } app+ loop++loop :: IO ()+loop = do+ threadDelay 100000+ e <- doesFileExist "dist/devel-terminate"+ if e then terminateDevel else loop++terminateDevel :: IO ()+terminateDevel = exitSuccess
scaffold/main.hs.cg view
@@ -1,7 +1,8 @@+import Prelude (IO) import Yesod.Default.Config (fromArgs) import Yesod.Default.Main (defaultMain)-import Application (with~sitearg~)-import Prelude (IO)+import Settings (parseExtra)+import Application (getApplication) main :: IO ()-main = defaultMain fromArgs with~sitearg~+main = defaultMain (fromArgs parseExtra) getApplication
scaffold/project.cabal.cg view
@@ -57,7 +57,7 @@ cpp-options: -DDEVELOPMENT ghc-options: -Wall -threaded -O0 else- ghc-options: -Wall -threaded+ ghc-options: -Wall -threaded -O2 main-is: main.hs @@ -74,24 +74,26 @@ FlexibleContexts build-depends: base >= 4 && < 5- , yesod >= 0.9.3.4 && < 0.10- , yesod-core >= 0.9.3 && < 0.10- , yesod-auth >= 0.7.3 && < 0.8- , yesod-static >= 0.3.1 && < 0.4- , yesod-default >= 0.5 && < 0.6- , yesod-form >= 0.3.4 && < 0.4+ , yesod >= 0.10 && < 0.11+ , yesod-core >= 0.10 && < 0.11+ , yesod-auth >= 0.8 && < 0.9+ , yesod-static >= 0.10 && < 0.11+ , yesod-default >= 0.6 && < 0.7+ , yesod-form >= 0.4 && < 0.5 , mime-mail >= 0.3.0.3 && < 0.5 , clientsession >= 0.7.3 && < 0.8 , bytestring >= 0.9 && < 0.10 , text >= 0.11 && < 0.12- , persistent >= 0.6.2 && < 0.7- , persistent-~backendLower~ >= 0.6 && < 0.7+ , persistent >= 0.8 && < 0.9+ , persistent-~backendLower~ >= 0.8 && < 0.9 , template-haskell , hamlet >= 0.10 && < 0.11 , shakespeare-css >= 0.10 && < 0.11- , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-js >= 0.11 && < 0.12 , shakespeare-text >= 0.10 && < 0.11 , hjsmin >= 0.0.14 && < 0.1- , monad-control ~monadControlVersion~- , wai-extra >= 0.4.6 && < 0.5+ , monad-control >= 0.3 && < 0.4+ , wai-extra >= 1.0 && < 1.2+ , yaml >= 0.5 && < 0.6+ , http-conduit >= 1.2 && < 1.3
− scaffold/templates/boilerplate-wrapper.hamlet.cg
@@ -1,42 +0,0 @@-\<!doctype html>-\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->-\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->-\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->-\<!--[if gt IE 8]><!-->-<html class="no-js" lang="en"> <!--<![endif]-->- <head>- <meta charset="UTF-8">-- <title>#{pageTitle pc}- <meta name="description" content="">- <meta name="author" content="">-- <meta name="viewport" content="width=device-width,initial-scale=1">-- ^{pageHead pc}-- \<!--[if lt IE 9]>- \<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>- \<![endif]-->-- <script>- document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');- <body>- <div id="container">- <header>- <div id="main" role="main">- ^{pageBody pc}- <footer>-- \<!-- Change UA-XXXXX-X to be your site's ID -->- <script>- window._gaq = [['_setAccount','UAXXXXXXXX1'],['_trackPageview'],['_trackPageLoadTime']];- YepNope.load({- \ load: ('https:' == location.protocol ? '//ssl' : '//www') + '.google-analytics.com/ga.js'- });- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]-->
scaffold/templates/default-layout-wrapper.hamlet.cg view
@@ -1,8 +1,42 @@-!!!-<html>- <head+\<!doctype html>+\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->+\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->+\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->+\<!--[if gt IE 8]><!-->+<html class="no-js" lang="en"> <!--<![endif]-->+ <head>+ <meta charset="UTF-8">+ <title>#{pageTitle pc}+ <meta name="description" content="">+ <meta name="author" content="">++ <meta name="viewport" content="width=device-width,initial-scale=1">+ ^{pageHead pc}- <body- ^{pageBody pc} + \<!--[if lt IE 9]>+ \<script src="http://html5shiv.googlecode.com/svn/trunk/html5.js"></script>+ \<![endif]-->++ <script>+ document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/,'js');+ <body>+ <div id="container">+ <header>+ <div id="main" role="main">+ ^{pageBody pc}+ <footer>++ $maybe analytics <- extraAnalytics $ appExtra $ settings master+ <script>+ window._gaq = [['_setAccount','#{analytics}'],['_trackPageview'],['_trackPageLoadTime']];+ YepNope.load({+ \ load: ('https:' == location.protocol ? '//ssl' : '//www') + '.google-analytics.com/ga.js'+ });+ \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->+ \<!--[if lt IE 7 ]>+ <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">+ <script>+ window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})+ \<![endif]-->
scaffold/templates/default-layout.hamlet.cg view
@@ -1,4 +1,5 @@ $maybe msg <- mmsg <div #message>#{msg} ^{widget}-+<footer>+ #{extraCopyright $ appExtra $ settings master}
scaffold/templates/default-layout.lucius.cg view
@@ -1,4 +1,3 @@ body { font-family: sans-serif; }-
scaffold/templates/homepage.julius.cg view
@@ -1,2 +1,1 @@ document.getElementById("#{h2id}").innerHTML = "<i>Added from JavaScript.</i>";-
scaffold/templates/homepage.lucius.cg view
@@ -4,4 +4,3 @@ h2##{h2id} { color: #990 }-
scaffold/tiny/Application.hs.cg view
@@ -1,17 +1,23 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Application- ( with~sitearg~- , withDevelAppPort+ ( getApplication+ , getApplicationDev ) where import Import+import Settings (parseExtra) import Settings.StaticFiles (staticSite) import Yesod.Default.Config-import Yesod.Default.Main (defaultDevelApp, defaultRunner)+import Yesod.Default.Main (defaultDevelApp) import Yesod.Default.Handlers (getFaviconR, getRobotsR)-import Yesod.Logger (Logger)+#if DEVELOPMENT+import Yesod.Logger (Logger, logBS)+import Network.Wai.Middleware.RequestLogger (logCallbackDev)+#else+import Yesod.Logger (Logger, logBS, toProduction)+import Network.Wai.Middleware.RequestLogger (logCallback)+#endif import Network.Wai (Application)-import Data.Dynamic (Dynamic, toDyn) -- Import all relevant handler modules here. import Handler.Root@@ -25,12 +31,27 @@ -- 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 DefaultEnv () -> Logger -> (Application -> IO ()) -> IO ()-with~sitearg~ conf logger f = do+getApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application+getApplication conf logger = do s <- staticSite- let h = ~sitearg~ conf logger s- defaultRunner f h+ let foundation = ~sitearg~ conf setLogger s+ app <- toWaiAppPlain foundation+ return $ logWare app+ where+#ifdef DEVELOPMENT+ logWare = logCallbackDev (logBS setLogger)+ setLogger = logger+#else+ setLogger = toProduction logger -- by default the logger is set for development+ logWare = logCallback (logBS setLogger)+#endif -- for yesod devel-withDevelAppPort :: Dynamic-withDevelAppPort = toDyn $ defaultDevelApp with~sitearg~+getApplicationDev :: IO (Int, Application)+getApplicationDev =+ defaultDevelApp loader getApplication+ where+ loader = loadConfig (configSettings Development)+ { csParseExtra = parseExtra+ }+
scaffold/tiny/Foundation.hs.cg view
@@ -1,27 +1,24 @@ module Foundation ( ~sitearg~ (..)- , ~sitearg~Route (..)+ , Route (..) , ~sitearg~Message (..) , resources~sitearg~ , Handler , Widget , module Yesod.Core , module Settings- , StaticRoute (..)- , lift , liftIO ) where import Prelude-import Yesod.Core hiding (AppConfig (..))+import Yesod.Core hiding (Route) import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal)-import Yesod.Static (Static, base64md5, StaticRoute(..))+import Yesod.Static import Settings.StaticFiles import Yesod.Logger (Logger, logMsg, formatLogText) import qualified Settings-import Settings (widgetFile)-import Control.Monad.Trans.Class (lift)+import Settings (Extra (..), widgetFile) import Control.Monad.IO.Class (liftIO) import Web.ClientSession (getKey) import Text.Hamlet (hamletFile)@@ -31,7 +28,7 @@ -- starts running, such as database connections. Every handler will have -- access to the data present here. data ~sitearg~ = ~sitearg~- { settings :: AppConfig DefaultEnv ()+ { settings :: AppConfig DefaultEnv Extra , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. }@@ -63,12 +60,13 @@ -- 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 = appRoot . settings+ approot = ApprootMaster $ appRoot . settings -- Place the session key file in the config folder encryptKey _ = fmap Just $ getKey "config/client_session_key.aes" defaultLayout widget = do+ master <- getYesod mmsg <- getMessage -- We break up the default layout into two components:
+ scaffold/tiny/Import.hs.cg view
@@ -0,0 +1,18 @@+module Import+ ( module Prelude+ , module Foundation+ , (<>)+ , Text+ , module Data.Monoid+ , module Control.Applicative+ ) where++import Prelude hiding (writeFile, readFile)+import Foundation+import Data.Monoid (Monoid (mappend, mempty, mconcat))+import Control.Applicative ((<$>), (<*>), pure)+import Data.Text (Text)++infixr 5 <>+(<>) :: Monoid m => m -> m -> m+(<>) = mappend
scaffold/tiny/Settings.hs.cg view
@@ -7,14 +7,18 @@ ( widgetFile , staticRoot , staticDir+ , Extra (..)+ , parseExtra ) where -import Prelude (FilePath, String)+import Prelude import Text.Shakespeare.Text (st) import Language.Haskell.TH.Syntax import Yesod.Default.Config import qualified Yesod.Default.Util import Data.Text (Text)+import Data.Yaml+import Control.Applicative -- | The location of static files on your system. This is a file system -- path. The default value works properly with your scaffolded site.@@ -43,3 +47,14 @@ #else widgetFile = Yesod.Default.Util.widgetFileNoReload #endif++data Extra = Extra+ { extraCopyright :: Text+ , extraAnalytics :: Maybe Text -- ^ Google Analytics+ }++parseExtra :: DefaultEnv -> Object -> Parser Extra+parseExtra _ o = Extra+ <$> o .: "copyright"+ <*> o .:? "analytics"+
scaffold/tiny/project.cabal.cg view
@@ -52,7 +52,7 @@ cpp-options: -DDEVELOPMENT ghc-options: -Wall -threaded -O0 else- ghc-options: -Wall -threaded+ ghc-options: -Wall -threaded -O2 main-is: main.hs @@ -66,16 +66,18 @@ TypeFamilies build-depends: base >= 4 && < 5- , yesod-core >= 0.9.3 && < 0.10- , yesod-static >= 0.3.1 && < 0.4- , yesod-default >= 0.5 && < 0.6+ , yesod-core >= 0.10 && < 0.11+ , yesod-static >= 0.10 && < 0.11+ , yesod-default >= 0.6 && < 0.7 , clientsession >= 0.7.3 && < 0.8 , bytestring >= 0.9 && < 0.10 , text >= 0.11 && < 0.12 , template-haskell , hamlet >= 0.10 && < 0.11 , shakespeare-text >= 0.10 && < 0.11- , wai >= 0.4.2 && < 0.5+ , wai >= 1.1 && < 1.2+ , wai-extra >= 1.1 && < 1.2 , transformers >= 0.2 && < 0.3 , monad-control >= 0.3 && < 0.4+ , yaml >= 0.5 && < 0.6
yesod.cabal view
@@ -1,5 +1,5 @@ name: yesod-version: 0.9.4.1+version: 0.10.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -26,6 +26,7 @@ scaffold/Foundation.hs.cg scaffold/LICENSE.cg scaffold/mongoDBConnPool.cg+ scaffold/tiny/Import.hs.cg scaffold/tiny/Foundation.hs.cg scaffold/tiny/project.cabal.cg scaffold/tiny/Application.hs.cg@@ -41,15 +42,16 @@ scaffold/templates/homepage.hamlet.cg scaffold/templates/default-layout.hamlet.cg scaffold/templates/default-layout-wrapper.hamlet.cg- scaffold/templates/boilerplate-wrapper.hamlet.cg scaffold/deploy/Procfile.cg scaffold/main.hs.cg+ scaffold/devel.hs.cg scaffold/Handler/Root.hs.cg scaffold/config/models.cg scaffold/config/sqlite.yml.cg scaffold/config/settings.yml.cg scaffold/config/favicon.ico.cg scaffold/config/postgresql.yml.cg+ scaffold/config/mysql.yml.cg scaffold/config/mongoDB.yml.cg scaffold/config/routes.cg scaffold/config/robots.txt.cg@@ -71,19 +73,20 @@ cpp-options: -DGHC7 else build-depends: base >= 4 && < 4.3- build-depends: yesod-core >= 0.9.3.4 && < 0.10- , yesod-auth >= 0.7 && < 0.8- , yesod-json >= 0.2.2 && < 0.3- , yesod-persistent >= 0.2 && < 0.3- , yesod-form >= 0.3 && < 0.4- , monad-control >= 0.2 && < 0.4+ build-depends: yesod-core >= 0.10.1 && < 0.11+ , yesod-auth >= 0.8.1 && < 0.9+ , yesod-json >= 0.3.1 && < 0.4+ , yesod-persistent >= 0.3.1 && < 0.4+ , yesod-form >= 0.4.1 && < 0.5+ , monad-control >= 0.3 && < 0.4 , transformers >= 0.2.2 && < 0.3- , wai >= 0.4 && < 0.5- , wai-extra >= 0.4.6 && < 0.5+ , wai >= 1.1 && < 1.2+ , wai-extra >= 1.1 && < 1.2+ , wai-logger >= 0.1.2 , hamlet >= 0.10 && < 0.11- , shakespeare-js >= 0.10 && < 0.11+ , shakespeare-js >= 0.11 && < 0.12 , shakespeare-css >= 0.10 && < 0.11- , warp >= 0.4 && < 0.5+ , warp >= 1.1 && < 1.2 , blaze-html >= 0.4.1.3 && < 0.5 exposed-modules: Yesod ghc-options: -Wall@@ -103,13 +106,14 @@ , time >= 1.1.4 , template-haskell , directory >= 1.0 && < 1.2- , Cabal >= 1.8 && < 1.13+ , Cabal , unix-compat >= 0.2 && < 0.4 , containers >= 0.2 && < 0.5 , attoparsec >= 0.10 , http-types >= 0.6.1 && < 0.7 , blaze-builder >= 0.2.1.4 && < 0.4- , filepath >= 1.1 && < 1.3+ , filepath >= 1.1+ , fast-logger >= 0.0.2 && < 0.1 , process ghc-options: -Wall if flag(threaded)@@ -122,4 +126,4 @@ source-repository head type: git- location: git://github.com/yesodweb/yesod.git+ location: https://github.com/yesodweb/yesod