diff --git a/AddHandler.hs b/AddHandler.hs new file mode 100644 --- /dev/null +++ b/AddHandler.hs @@ -0,0 +1,113 @@ +module AddHandler (addHandler) where + +import Prelude hiding (readFile) +import System.IO (hFlush, stdout) +import Data.Char (isLower, toLower, isSpace) +import Data.List (isPrefixOf, isSuffixOf) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.Directory (getDirectoryContents) + +-- strict readFile +readFile :: FilePath -> IO String +readFile = fmap T.unpack . TIO.readFile + +addHandler :: IO () +addHandler = do + allFiles <- getDirectoryContents "." + cabal <- + case filter (".cabal" `isSuffixOf`) allFiles of + [x] -> return x + [] -> error "No cabal file found" + _ -> error "Too many cabal files found" + + putStr "Name of route (without trailing R): " + hFlush stdout + name <- getLine + case name of + [] -> error "Please provide a name" + c:_ + | isLower c -> error "Name must start with an upper case letter" + | otherwise -> return () + putStr "Enter route pattern: " + hFlush stdout + pattern <- getLine + putStr "Enter space-separated list of methods: " + hFlush stdout + methods <- getLine + + let modify fp f = readFile fp >>= writeFile fp . f + + modify "Application.hs" $ fixApp name + modify cabal $ fixCabal name + modify "config/routes" $ fixRoutes name pattern methods + writeFile ("Handler/" ++ name ++ ".hs") $ mkHandler name pattern methods + +fixApp :: String -> String -> String +fixApp name = + unlines . reverse . go . reverse . lines + where + l = "import Handler." ++ name + + go [] = [l] + go (x:xs) + | "import Handler." `isPrefixOf` x = l : x : xs + | otherwise = x : go xs + +fixCabal :: String -> String -> String +fixCabal name = + unlines . reverse . go . reverse . lines + where + l = "import Handler." ++ name + + go [] = [l] + go (x:xs) + | "Handler." `isPrefixOf` x' = (spaces ++ "Handler." ++ name) : x : xs + | otherwise = x : go xs + where + (spaces, x') = span isSpace x + +fixRoutes :: String -> String -> String -> String -> String +fixRoutes name pattern methods = + (++ l) + where + l = concat + [ pattern + , " " + , name + , "R " + , methods + , "\n" + ] + +mkHandler :: String -> String -> String -> String +mkHandler name pattern methods = unlines + $ ("module Handler." ++ name ++ " where") + : "" + : "import Import" + : concatMap go (words methods) + where + go method = + [ "" + , concat $ func : " :: " : map toArrow types ++ ["Handler RepHtml"] + , concat + [ func + , " = error \"Not yet implemented: " + , func + , "\"" + ] + ] + where + func = concat [map toLower method, name, "R"] + + types = getTypes pattern + + toArrow t = concat [t, " -> "] + + getTypes "" = [] + getTypes ('/':rest) = getTypes rest + getTypes ('#':rest) = + typ : getTypes rest' + where + (typ, rest') = break (== '/') rest + getTypes rest = getTypes $ dropWhile (/= '/') rest diff --git a/Keter.hs b/Keter.hs new file mode 100644 --- /dev/null +++ b/Keter.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} +module Keter + ( keter + ) where + +import Data.Yaml +import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T +import System.Exit +import System.Cmd +import Control.Monad +import System.Directory +import Data.Maybe (mapMaybe) +import qualified Filesystem.Path.CurrentOS as F +import qualified Filesystem as F +import qualified Codec.Archive.Tar as Tar +import Control.Exception +import qualified Data.ByteString.Lazy as L +import Codec.Compression.GZip (compress) + +run :: String -> [String] -> IO () +run a b = do + ec <- rawSystem a b + unless (ec == ExitSuccess) $ exitWith ec + +keter :: String -- ^ cabal command + -> Bool -- ^ no build? + -> IO () +keter cabal noBuild = do + mvalue <- decodeFile "config/keter.yaml" + value <- + case mvalue of + Nothing -> error "No config/keter.yaml found" + Just (Object value) -> + case Map.lookup "host" value of + Just (String s) | "<<" `T.isPrefixOf` s -> + error "Please set your hostname in config/keter.yaml" + _ -> return value + Just _ -> error "config/keter.yaml is not an object" + + files <- getDirectoryContents "." + project <- + case mapMaybe (T.stripSuffix ".cabal" . T.pack) files of + [x] -> return x + [] -> error "No cabal file found" + _ -> error "Too many cabal files found" + + exec <- + case Map.lookup "exec" value of + Just (String s) -> return $ F.collapse $ "config" F. F.fromText s + _ -> error "exec not found in config/keter.yaml" + + unless noBuild $ do + run cabal ["clean"] + run cabal ["configure"] + run cabal ["build"] + + _ <- try' $ F.removeTree "static/tmp" + + archive <- Tar.pack "" [F.encodeString exec, "config", "static"] + let fp = T.unpack project ++ ".keter" + L.writeFile fp $ compress $ Tar.write archive + + case Map.lookup "copy-to" value of + Just (String s) -> run "scp" [fp, T.unpack s] + _ -> return () + +try' :: IO a -> IO (Either SomeException a) +try' = try diff --git a/Scaffolding/Scaffolder.hs b/Scaffolding/Scaffolder.hs --- a/Scaffolding/Scaffolder.hs +++ b/Scaffolding/Scaffolder.hs @@ -47,7 +47,7 @@ | '0' <= c && c <= '9' = True validPN '-' = True validPN _ = False - project <- prompt $ \s -> all validPN s && not (null s) + project <- prompt $ \s -> all validPN s && not (null s) && s /= "test" let dir = project let sitearg = "App" @@ -60,7 +60,7 @@ "s" -> (Sqlite, "GenericSql", "SqlPersist", "Sqlite", "sqlSettings") "p" -> (Postgresql, "GenericSql", "SqlPersist", "Postgresql", "sqlSettings") "mysql" -> (Mysql, "GenericSql", "SqlPersist", "MySQL", "sqlSettings") - "mongo" -> (MongoDB, "MongoDB", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }") + "mongo" -> (MongoDB, "MongoDB hiding (master)", "Action", "MongoDB", "MkPersistSettings { mpsBackend = ConT ''Action }") _ -> error $ "Invalid backend: " ++ backendC (modelImports) = case backend of MongoDB -> "import Database.Persist." ++ importGenericDB ++ "\nimport Language.Haskell.TH.Syntax" @@ -72,6 +72,10 @@ backendLower = uncapitalize $ show backend upper = show backend + poolRunner = case backend of + MongoDB -> "runMongoDBPoolDef" + _ -> "runSqlPool" + let runMigration = case backend of MongoDB -> "" @@ -143,6 +147,7 @@ Mysql -> writeFile' ("config/" ++ backendLower ++ ".yml") $(codegen "config/mysql.yml") writeFile' "config/settings.yml" $(codegen "config/settings.yml") + writeFile' "config/keter.yaml" $(codegen "config/keter.yaml") writeFile' "main.hs" $(codegen "main.hs") writeFile' "devel.hs" $(codegen "devel.hs") writeFile' (project ++ ".cabal") $(codegen "project.cabal") @@ -188,6 +193,7 @@ mkDir "tests" writeFile' "tests/main.hs" $(codegen "tests/main.hs") writeFile' "tests/HomeTest.hs" $(codegen "tests/HomeTest.hs") + writeFile' "tests/TestImport.hs" $(codegen "tests/TestImport.hs") S.writeFile (dir ++ "/config/favicon.ico") $(runIO (S.readFile "scaffold/config/favicon.ico.cg") >>= \bs -> do diff --git a/Yesod.hs b/Yesod.hs --- a/Yesod.hs +++ b/Yesod.hs @@ -45,15 +45,13 @@ import Yesod.Form import Yesod.Json import Yesod.Persist -import Network.HTTP.Types (status200) import Control.Monad.IO.Class (liftIO, MonadIO(..)) import Control.Monad.Trans.Control (MonadBaseControl) import Network.Wai -import Network.Wai.Logger +import Network.Wai.Middleware.RequestLogger (logStdout) import Network.Wai.Handler.Warp (run) -import System.IO (stderr, stdout, hFlush, hPutStrLn) -import System.Log.FastLogger +import System.IO (stderr, hPutStrLn) #if MIN_VERSION_blaze_html(0, 5, 0) import Text.Blaze.Html (toHtml) #else @@ -80,23 +78,7 @@ 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 port $ logStdout waiApp -- | Run a development server, where your code changes are automatically -- reloaded. diff --git a/input/database.cg b/input/database.cg --- a/input/database.cg +++ b/input/database.cg @@ -5,6 +5,6 @@ s = sqlite p = postgresql mongo = mongodb - mysql = MySQL (experimental) + mysql = MySQL So, what'll it be? diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -11,6 +11,8 @@ import Build (touch) #endif import Devel (devel) +import AddHandler (addHandler) +import Keter (keter) windowsWarning :: String #ifdef WINDOWS @@ -46,6 +48,9 @@ rawSystem' cmd ["test"] ["version"] -> putStrLn $ "yesod-core version:" ++ yesodVersion "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith + ["add-handler"] -> addHandler + ["keter"] -> keter cmd False + ["keter", "--nobuild"] -> keter cmd True _ -> do putStrLn "Usage: yesod " putStrLn "Available commands:" @@ -59,6 +64,10 @@ putStrLn " use --dev devel to build with cabal-dev" putStrLn " test Build and run the integration tests" putStrLn " use --dev devel to build with cabal-dev" + putStrLn " add-handler Add a new handler and module to your project" + putStrLn " keter Build a keter bundle" + putStrLn " use --dev devel to build with cabal-dev" + putStrLn " use --nobuild to skip rebuilding" putStrLn " version Print the version of Yesod" -- | Like @rawSystem@, but exits if it receives a non-success result. diff --git a/scaffold/Application.hs.cg b/scaffold/Application.hs.cg --- a/scaffold/Application.hs.cg +++ b/scaffold/Application.hs.cg @@ -11,8 +11,7 @@ import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers -import Yesod.Logger (Logger, logBS, toProduction) -import Network.Wai.Middleware.RequestLogger (logCallback, logCallbackDev) +import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) import qualified Database.Persist.Store~importMigration~ import Network.HTTP.Conduit (newManager, def) @@ -29,25 +28,24 @@ -- 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. -makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application -makeApplication conf logger = do - foundation <- makeFoundation conf setLogger +makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication conf = do + foundation <- makeFoundation conf app <- toWaiAppPlain foundation return $ logWare app where - setLogger = if development then logger else toProduction logger - logWare = if development then logCallbackDev (logBS setLogger) - else logCallback (logBS setLogger) + logWare = if development then logStdoutDev + else logStdout -makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO ~sitearg~ -makeFoundation conf setLogger = do +makeFoundation :: AppConfig DefaultEnv Extra -> IO ~sitearg~ +makeFoundation conf = do manager <- newManager def s <- staticSite dbconf <- withYamlEnvironment "config/~dbConfigFile~.yml" (appEnv conf) Database.Persist.Store.loadConfig >>= Database.Persist.Store.applyEnv p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig)~runMigration~ - return $ ~sitearg~ conf setLogger s p manager dbconf + return $ ~sitearg~ conf s p manager dbconf -- for yesod devel getApplicationDev :: IO (Int, Application) diff --git a/scaffold/Foundation.hs.cg b/scaffold/Foundation.hs.cg --- a/scaffold/Foundation.hs.cg +++ b/scaffold/Foundation.hs.cg @@ -10,6 +10,7 @@ , requireAuth , module Settings , module Model + , getExtra ) where import Prelude @@ -20,7 +21,6 @@ import Yesod.Auth.GoogleEmail import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Logger (Logger, logMsg, formatLogText) import Network.HTTP.Conduit (Manager) import qualified Settings import qualified Database.Persist.Store @@ -38,7 +38,6 @@ -- access to the data present here. data ~sitearg~ = ~sitearg~ { settings :: AppConfig DefaultEnv Extra - , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , httpManager :: Manager @@ -107,9 +106,6 @@ -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR - messageLogger y loc level msg = - formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y) - -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of @@ -153,6 +149,10 @@ -- achieve customized and internationalized form validation messages. instance RenderMessage ~sitearg~ FormMessage where renderMessage _ _ = defaultFormMessage + +-- | Get the 'Extra' value, used to hold data from the settings.yml file. +getExtra :: Handler Extra +getExtra = fmap (appExtra . settings) getYesod -- Note: previous versions of the scaffolding included a deliver function to -- send emails. Unfortunately, there are too many different options for us to diff --git a/scaffold/Import.hs.cg b/scaffold/Import.hs.cg --- a/scaffold/Import.hs.cg +++ b/scaffold/Import.hs.cg @@ -15,7 +15,11 @@ import Prelude hiding (writeFile, readFile, head, tail, init, last) import Yesod hiding (Route(..)) import Foundation +#if __GLASGOW_HASKELL__ < 704 import Data.Monoid (Monoid (mappend, mempty, mconcat)) +#else +import Data.Monoid (Monoid (mappend, mempty, mconcat), (<>)) +#endif import Control.Applicative ((<$>), (<*>), pure) import Data.Text (Text) import Settings.StaticFiles diff --git a/scaffold/Settings.hs.cg b/scaffold/Settings.hs.cg --- a/scaffold/Settings.hs.cg +++ b/scaffold/Settings.hs.cg @@ -17,11 +17,13 @@ import Language.Haskell.TH.Syntax import Database.Persist.~importPersist~ (~configPersist~) import Yesod.Default.Config -import qualified Yesod.Default.Util +import Yesod.Default.Util import Data.Text (Text) import Data.Yaml import Control.Applicative import Settings.Development +import Data.Default (def) +import Text.Hamlet -- | Which Persistent backend this site is using. type PersistConfig = ~configPersist~ @@ -49,13 +51,22 @@ staticRoot :: AppConfig DefaultEnv x -> Text staticRoot conf = [st|#{appRoot conf}/static|] +-- | Settings for 'widgetFile', such as which template languages to support and +-- default Hamlet settings. +widgetFileSettings :: WidgetFileSettings +widgetFileSettings = def + { wfsHamletSettings = defaultHamletSettings + { hamletNewlines = AlwaysNewlines + } + } -- The rest of this file contains settings which rarely need changing by a -- user. widgetFile :: String -> Q Exp -widgetFile = if development then Yesod.Default.Util.widgetFileReload - else Yesod.Default.Util.widgetFileNoReload +widgetFile = (if development then widgetFileReload + else widgetFileNoReload) + widgetFileSettings data Extra = Extra { extraCopyright :: Text diff --git a/scaffold/config/keter.yaml.cg b/scaffold/config/keter.yaml.cg new file mode 100644 --- /dev/null +++ b/scaffold/config/keter.yaml.cg @@ -0,0 +1,8 @@ +exec: ../dist/build/~project~/~project~ +args: + - production +host: <> + +# Use the following to automatically copy your bundle upon creation via `yesod +# keter`. Uses `scp` internally, so you can set it to a remote destination +# copy-to: user@host:/opt/keter/incoming diff --git a/scaffold/config/mongoDB.yml.cg b/scaffold/config/mongoDB.yml.cg --- a/scaffold/config/mongoDB.yml.cg +++ b/scaffold/config/mongoDB.yml.cg @@ -2,9 +2,8 @@ user: ~project~ password: ~project~ host: localhost - port: 27017 database: ~project~ - poolsize: 10 + connections: 10 Development: <<: *defaults @@ -15,10 +14,11 @@ Staging: database: ~project~_staging - poolsize: 100 + connections: 100 <<: *defaults Production: database: ~project~_production - poolsize: 100 + connections: 100 + host: localhost <<: *defaults diff --git a/scaffold/deploy/Procfile.cg b/scaffold/deploy/Procfile.cg --- a/scaffold/deploy/Procfile.cg +++ b/scaffold/deploy/Procfile.cg @@ -15,18 +15,21 @@ # # Postgresql Yesod setup: # -# * add a dependency on the "heroku" package in your cabal file +# * add dependencies on the "heroku", "aeson" and "unordered-containers" packages in your cabal file # # * add code in Application.hs to use the heroku package and load the connection parameters. # The below works for Postgresql. # +# import Data.HashMap.Strict as H +# import Data.Aeson.Types as AT # #ifndef DEVELOPMENT # import qualified Web.Heroku # #endif # # -# makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application -# makeApplication conf logger = do +# +# makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App +# makeFoundation conf setLogger = do # manager <- newManager def # s <- staticSite # hconfig <- loadHerokuConfig @@ -35,17 +38,7 @@ # Database.Persist.Store.applyEnv # p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) # Database.Persist.Store.runPool dbconf (runMigration migrateAll) p -# let foundation = ~sitearg~ conf setLogger s p manager dbconf -# 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 +# return $ App conf setLogger s p manager dbconf # # #ifndef DEVELOPMENT # canonicalizeKey :: (Text, val) -> (Text, val) diff --git a/scaffold/mongoDBConnPool.cg b/scaffold/mongoDBConnPool.cg --- a/scaffold/mongoDBConnPool.cg +++ b/scaffold/mongoDBConnPool.cg @@ -1,8 +1,5 @@ -runConnectionPool :: MonadControlIO m => Action m a -> ConnectionPool -> m a -runConnectionPool = runMongoDBConn (ConfirmWrites [u"j" =: True]) - withConnectionPool :: (MonadControlIO m, Applicative m) => AppConfig DefaultEnv -> (ConnectionPool -> m b) -> m b withConnectionPool conf f = do dbConf <- liftIO $ loadMongo (appEnv conf) - withMongoDBPool (u $ mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f + withMongoDBPool (mgDatabase dbConf) (mgHost dbConf) (mgPoolSize dbConf) f diff --git a/scaffold/postgresqlConnPool.cg b/scaffold/postgresqlConnPool.cg --- a/scaffold/postgresqlConnPool.cg +++ b/scaffold/postgresqlConnPool.cg @@ -1,6 +1,3 @@ -runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a -runConnectionPool = runSqlPool - withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a withConnectionPool conf f = do dbConf <- liftIO $ load~upper~ (appEnv conf) diff --git a/scaffold/project.cabal.cg b/scaffold/project.cabal.cg --- a/scaffold/project.cabal.cg +++ b/scaffold/project.cabal.cg @@ -32,9 +32,9 @@ if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT - ghc-options: -Wall -threaded -O0 + ghc-options: -Wall -O0 else - ghc-options: -Wall -threaded -O2 + ghc-options: -Wall -O2 extensions: TemplateHaskell QuasiQuotes @@ -50,31 +50,32 @@ NoMonomorphismRestriction build-depends: base >= 4 && < 5 - , yesod-platform >= 1.0 && < 1.1 - , yesod >= 1.0 && < 1.1 - , yesod-core >= 1.0 && < 1.1 - , yesod-auth >= 1.0 && < 1.1 - , yesod-static >= 1.0 && < 1.1 - , yesod-default >= 1.0 && < 1.1 - , yesod-form >= 1.0 && < 1.1 - , yesod-test >= 0.2 && < 0.3 - , clientsession >= 0.7.3 && < 0.8 + -- , yesod-platform >= 1.1 && < 1.2 + , yesod >= 1.1 && < 1.2 + , yesod-core >= 1.1 && < 1.2 + , yesod-auth >= 1.1 && < 1.2 + , yesod-static >= 1.1 && < 1.2 + , yesod-default >= 1.1 && < 1.2 + , yesod-form >= 1.1 && < 1.2 + , yesod-test >= 0.3 && < 0.4 + , clientsession >= 0.8 && < 0.9 , bytestring >= 0.9 && < 0.10 , text >= 0.11 && < 0.12 - , persistent >= 0.9 && < 0.10 - , persistent-~backendLower~ >= 0.9 && < 0.10 + , persistent >= 1.0 && < 1.1 + , persistent-~backendLower~ >= 1.0 && < 1.1 , template-haskell - , hamlet >= 1.0 && < 1.1 + , hamlet >= 1.1 && < 1.2 , shakespeare-css >= 1.0 && < 1.1 , shakespeare-js >= 1.0 && < 1.1 , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.2 && < 1.3 - , yaml >= 0.7 && < 0.8 - , http-conduit >= 1.4 && < 1.5 + , wai-extra >= 1.3 && < 1.4 + , yaml >= 0.8 && < 0.9 + , http-conduit >= 1.5 && < 1.6 , directory >= 1.1 && < 1.2 - , warp >= 1.2 && < 1.3 + , warp >= 1.3 && < 1.4 + , data-default executable ~project~ if flag(library-only) @@ -86,25 +87,18 @@ , ~project~ , yesod-default + ghc-options: -threaded -O2 + test-suite test type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: tests ghc-options: -Wall - extensions: TemplateHaskell - QuasiQuotes - OverloadedStrings - NoImplicitPrelude - CPP - OverloadedStrings - MultiParamTypeClasses - TypeFamilies - GADTs - GeneralizedNewtypeDeriving - FlexibleContexts build-depends: base , ~project~ , yesod-test , yesod-default , yesod-core + , persistent >= 1.0 && < 1.1 + , persistent-~backendLower~ >= 1.0 && < 1.1 diff --git a/scaffold/sqliteConnPool.cg b/scaffold/sqliteConnPool.cg --- a/scaffold/sqliteConnPool.cg +++ b/scaffold/sqliteConnPool.cg @@ -1,6 +1,3 @@ -runConnectionPool :: MonadControlIO m => SqlPersist m a -> ConnectionPool -> m a -runConnectionPool = runSqlPool - withConnectionPool :: MonadControlIO m => AppConfig DefaultEnv -> (ConnectionPool -> m a) -> m a withConnectionPool conf f = do dbConf <- liftIO $ load~upper~ (appEnv conf) diff --git a/scaffold/templates/default-layout-wrapper.hamlet.cg b/scaffold/templates/default-layout-wrapper.hamlet.cg --- a/scaffold/templates/default-layout-wrapper.hamlet.cg +++ b/scaffold/templates/default-layout-wrapper.hamlet.cg @@ -1,3 +1,4 @@ +$newline never \ \ \ diff --git a/scaffold/templates/homepage.hamlet.cg b/scaffold/templates/homepage.hamlet.cg --- a/scaffold/templates/homepage.hamlet.cg +++ b/scaffold/templates/homepage.hamlet.cg @@ -6,7 +6,7 @@ You can also use this scaffolded site to explore some basic concepts.
  • This page was generated by the #{handlerName} handler in # - \Handler/Root.hs. + \Handler/Home.hs.
  • The #{handlerName} handler is set to generate your site's home screen in Routes file # config/routes diff --git a/scaffold/tests/HomeTest.hs.cg b/scaffold/tests/HomeTest.hs.cg --- a/scaffold/tests/HomeTest.hs.cg +++ b/scaffold/tests/HomeTest.hs.cg @@ -1,9 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} module HomeTest ( homeSpecs ) where -import Import -import Yesod.Test +import TestImport homeSpecs :: Specs homeSpecs = diff --git a/scaffold/tests/TestImport.hs.cg b/scaffold/tests/TestImport.hs.cg new file mode 100644 --- /dev/null +++ b/scaffold/tests/TestImport.hs.cg @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module TestImport + ( module Yesod.Test + , runDB + , Specs + ) where + +import Yesod.Test +import Database.Persist.~importGenericDB~ + +type Specs = SpecsConn Connection + +runDB :: ~dbMonad~ IO a -> OneSpec Connection a +runDB = runDBRunner ~poolRunner~ diff --git a/scaffold/tests/main.hs.cg b/scaffold/tests/main.hs.cg --- a/scaffold/tests/main.hs.cg +++ b/scaffold/tests/main.hs.cg @@ -6,17 +6,15 @@ import Import import Settings -import Yesod.Logger (defaultDevelopmentLogger) import Yesod.Default.Config import Yesod.Test import Application (makeFoundation) import HomeTest -main :: IO a +main :: IO () main = do conf <- loadConfig $ (configSettings Testing) { csParseExtra = parseExtra } - logger <- defaultDevelopmentLogger - foundation <- makeFoundation conf logger + foundation <- makeFoundation conf app <- toWaiAppPlain foundation runTests app (connPool foundation) homeSpecs diff --git a/yesod.cabal b/yesod.cabal --- a/yesod.cabal +++ b/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.0.1.6 +version: 1.1.0 license: MIT license-file: LICENSE author: Michael Snoyman @@ -31,6 +31,7 @@ scaffold/.ghci.cg scaffold/tests/main.hs.cg scaffold/tests/HomeTest.hs.cg + scaffold/tests/TestImport.hs.cg scaffold/Settings.hs.cg scaffold/Settings/Development.hs.cg scaffold/Settings/StaticFiles.hs.cg @@ -51,6 +52,7 @@ scaffold/templates/boilerplate-wrapper.hamlet.cg scaffold/templates/homepage.lucius.cg scaffold/messages/en.msg.cg + scaffold/config/keter.yaml.cg scaffold/config/models.cg scaffold/config/mysql.yml.cg scaffold/config/sqlite.yml.cg @@ -62,34 +64,23 @@ scaffold/config/mongoDB.yml.cg scaffold/devel.hs.cg -flag blaze_html_0_5 - description: use blaze-html 0.5 and blaze-markup 0.5 - default: True - library build-depends: base >= 4.3 && < 5 - , yesod-core >= 1.0 && < 1.1 - , yesod-auth >= 1.0 && < 1.1 - , yesod-json >= 1.0 && < 1.1 - , yesod-persistent >= 1.0 && < 1.1 - , yesod-form >= 1.0 && < 1.1 + , yesod-core >= 1.1 && < 1.2 + , yesod-auth >= 1.1 && < 1.2 + , yesod-json >= 1.1 && < 1.2 + , yesod-persistent >= 1.1 && < 1.2 + , yesod-form >= 1.1 && < 1.2 , monad-control >= 0.3 && < 0.4 , transformers >= 0.2.2 && < 0.4 - , wai >= 1.2 && < 1.3 - , wai-extra >= 1.2 && < 1.3 - , wai-logger >= 0.1.2 - , hamlet >= 1.0 && < 1.1 + , wai >= 1.3 && < 1.4 + , wai-extra >= 1.3 && < 1.4 + , hamlet >= 1.1 && < 1.2 , shakespeare-js >= 1.0 && < 1.1 , shakespeare-css >= 1.0 && < 1.1 - , warp >= 1.2 && < 1.3 - - if flag(blaze_html_0_5) - build-depends: - blaze-html >= 0.5 && < 0.6 - , blaze-markup >= 0.5.1 && < 0.6 - else - build-depends: - blaze-html >= 0.4 && < 0.5 + , warp >= 1.3 && < 1.4 + , blaze-html >= 0.5 && < 0.6 + , blaze-markup >= 0.5.1 && < 0.6 exposed-modules: Yesod ghc-options: -Wall @@ -109,17 +100,24 @@ , unix-compat >= 0.2 && < 0.4 , containers >= 0.2 , attoparsec >= 0.10 - , http-types >= 0.6.1 && < 0.7 + , http-types >= 0.7 && < 0.8 , blaze-builder >= 0.2.1.4 && < 0.4 , filepath >= 1.1 - , fast-logger >= 0.0.2 && < 0.1 , process + , zlib >= 0.5 && < 0.6 + , tar >= 0.4 && < 0.5 + , system-filepath >= 0.4 && < 0.5 + , system-fileio >= 0.3 && < 0.4 + , unordered-containers + , yaml >= 0.8 && < 0.9 ghc-options: -Wall -threaded main-is: main.hs other-modules: Scaffolding.CodeGen Scaffolding.Scaffolder Devel Build + Keter + AddHandler source-repository head type: git