diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,12 @@ +## 1.4.3.4 + +Scaffolding updates: + +* Improve `DevelMain` support +* Wipe out database during test runs +* Convenience `unsafeHandler` function +* Remove deprecated Chrome Frame code + ## 1.4.3.3 More consistent whitespace in hamlet files in scaffolding [#50](https://github.com/yesodweb/yesod-scaffold/issues/50) diff --git a/hsfiles/mongo.hsfiles b/hsfiles/mongo.hsfiles --- a/hsfiles/mongo.hsfiles +++ b/hsfiles/mongo.hsfiles @@ -32,15 +32,22 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc) +import Database.Persist.MongoDB (MongoContext) import Import import Language.Haskell.TH.Syntax (qLocation) import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -115,12 +122,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -145,16 +155,45 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT MongoContext (HandlerT App IO) a -> IO a +db = handler . runDB + {-# START_FILE Foundation.hs #-} module Foundation where import Database.Persist.MongoDB hiding (master) import Import.NoFoundation -import Text.Hamlet (hamletFile) -import Text.Jasmine (minifym) -import Yesod.Auth.BrowserId (authBrowserId) -import Yesod.Core.Types (Logger) -import Yesod.Default.Util (addStaticContentExternal) +import Text.Hamlet (hamletFile) +import Text.Jasmine (minifym) +import Yesod.Auth.BrowserId (authBrowserId) +import Yesod.Core.Types (Logger) +import Yesod.Default.Util (addStaticContentExternal) +import qualified Yesod.Core.Unsafe as Unsafe -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -291,6 +330,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -411,6 +453,7 @@ Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -446,7 +489,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-auth >= 1.4.0 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 @@ -522,9 +565,11 @@ , resourcet , monad-logger , transformers - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod + , mongoDB + , monad-control {-# START_FILE Settings.hs #-} -- | Settings are centralized, as much as possible, into this file. This @@ -683,40 +728,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -729,28 +785,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -8890,12 +8967,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg @@ -9026,14 +9097,22 @@ import Test.Hspec as X import Yesod.Default.Config2 (ignoreEnv, loadAppSettings) import Yesod.Test as X +-- Wiping the test database +import Database.MongoDB.Query (allCollections) +import Database.MongoDB.Admin (dropCollection) +import Control.Monad.Trans.Control (MonadBaseControl) runDB :: Action IO a -> YesodExample App a runDB action = do master <- getTestYesod + liftIO $ runDBWithApp master action + +runDBWithApp :: App -> Action IO a -> IO a +runDBWithApp app action = do liftIO $ runMongoDBPool - (mgAccessMode $ appDatabaseConf $ appSettings master) + (mgAccessMode $ appDatabaseConf $ appSettings app) action - (appConnPool master) + (appConnPool app) withApp :: SpecWith App -> Spec withApp = before $ do @@ -9041,5 +9120,19 @@ ["config/test-settings.yml", "config/settings.yml"] [] ignoreEnv - makeFoundation settings + app <- makeFoundation settings + wipeDB app + return app + +-- This function will wipe your database. +-- 'withApp' calls it before each test, creating a clean environment for each +-- spec to run in. +wipeDB :: App -> IO () +wipeDB app = void $ runDBWithApp app dropAllCollections + +dropAllCollections :: (MonadIO m, MonadBaseControl IO m) => Action m [Bool] +dropAllCollections = allCollections >>= return . filter (not . isSystemCollection) >>= mapM dropCollection + where + isSystemCollection = isPrefixOf "system." + diff --git a/hsfiles/mysql.hsfiles b/hsfiles/mysql.hsfiles --- a/hsfiles/mysql.hsfiles +++ b/hsfiles/mysql.hsfiles @@ -32,6 +32,12 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -131,12 +137,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -161,6 +170,34 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a +db = handler . runDB + {-# START_FILE Foundation.hs #-} module Foundation where @@ -171,6 +208,7 @@ import Yesod.Auth.BrowserId (authBrowserId) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) +import qualified Yesod.Core.Unsafe as Unsafe -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -306,6 +344,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -423,6 +464,7 @@ Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-auth >= 1.4.0 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 @@ -534,7 +576,7 @@ , resourcet , monad-logger , transformers - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod @@ -695,40 +737,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -741,28 +794,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -8903,12 +8977,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg @@ -9032,7 +9100,7 @@ import Application (makeFoundation) import ClassyPrelude as X import Database.Persist as X hiding (get) -import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) +import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName) import Foundation as X import Model as X import Test.Hspec as X @@ -9041,14 +9109,42 @@ runDB :: SqlPersistM a -> YesodExample App a runDB query = do - pool <- fmap appConnPool getTestYesod - liftIO $ runSqlPersistMPool query pool + app <- getTestYesod + liftIO $ runDBWithApp app query +runDBWithApp :: App -> SqlPersistM a -> IO a +runDBWithApp app query = runSqlPersistMPool query (appConnPool app) + withApp :: SpecWith App -> Spec withApp = before $ do settings <- loadAppSettings ["config/test-settings.yml", "config/settings.yml"] [] ignoreEnv - makeFoundation settings + foundation <- makeFoundation settings + wipeDB foundation + return foundation + +-- This function will truncate all of the tables in your database. +-- 'withApp' calls it before each test, creating a clean environment for each +-- spec to run in. +wipeDB :: App -> IO () +wipeDB app = do + runDBWithApp app $ do + tables <- getTables + sqlBackend <- ask + let queries = map (\t -> "TRUNCATE TABLE " ++ (connEscapeName sqlBackend $ DBName t)) tables + + -- In MySQL, a table cannot be truncated if another table references it via foreign key. + -- Since we're wiping both the parent and child tables, though, it's safe + -- to temporarily disable this check. + rawExecute "SET foreign_key_checks = 0;" [] + forM_ queries (\q -> rawExecute q []) + rawExecute "SET foreign_key_checks = 1;" [] + return () + +getTables :: MonadIO m => ReaderT SqlBackend m [Text] +getTables = do + tables <- rawSql "SHOW TABLES;" [] + return $ map unSingle tables diff --git a/hsfiles/postgres-fay.hsfiles b/hsfiles/postgres-fay.hsfiles --- a/hsfiles/postgres-fay.hsfiles +++ b/hsfiles/postgres-fay.hsfiles @@ -35,6 +35,12 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -45,7 +51,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -137,12 +143,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -167,15 +176,44 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a +db = handler . runDB + {-# START_FILE Foundation.hs #-} module Foundation where -import Database.Persist.Sql (ConnectionPool, runSqlPool) +import Database.Persist.Sql (ConnectionPool, runSqlPool) import Import.NoFoundation -import Text.Hamlet (hamletFile) -import Yesod.Auth.BrowserId (authBrowserId) -import Yesod.Core.Types (Logger) -import Yesod.Default.Util (addStaticContentExternal) +import Text.Hamlet (hamletFile) +import Yesod.Auth.BrowserId (authBrowserId) +import qualified Yesod.Core.Unsafe as Unsafe +import Yesod.Core.Types (Logger) +import Yesod.Default.Util (addStaticContentExternal) import Yesod.Fay -- | The foundation datatype for your application. This can be a good place to @@ -322,6 +360,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -463,7 +504,7 @@ Default: False library - hs-source-dirs: ., fay-shared + hs-source-dirs: ., fay-shared, app exposed-modules: Application Foundation Import @@ -502,7 +543,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-auth >= 1.4.0 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 @@ -579,7 +620,7 @@ , resourcet , monad-logger , transformers - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod @@ -755,40 +796,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -801,28 +853,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -9019,12 +9092,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg @@ -9153,7 +9220,7 @@ import Application (makeFoundation) import ClassyPrelude as X import Database.Persist as X hiding (get) -import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) +import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName) import Foundation as X import Model as X import Test.Hspec as X @@ -9162,14 +9229,37 @@ runDB :: SqlPersistM a -> YesodExample App a runDB query = do - pool <- fmap appConnPool getTestYesod - liftIO $ runSqlPersistMPool query pool + app <- getTestYesod + liftIO $ runDBWithApp app query +runDBWithApp :: App -> SqlPersistM a -> IO a +runDBWithApp app query = runSqlPersistMPool query (appConnPool app) + + withApp :: SpecWith App -> Spec withApp = before $ do settings <- loadAppSettings ["config/test-settings.yml", "config/settings.yml"] [] ignoreEnv - makeFoundation settings + foundation <- makeFoundation settings + wipeDB foundation + return foundation +-- This function will truncate all of the tables in your database. +-- 'withApp' calls it before each test, creating a clean environment for each +-- spec to run in. +wipeDB :: App -> IO () +wipeDB app = do + runDBWithApp app $ do + tables <- getTables + sqlBackend <- ask + + let escapedTables = map (connEscapeName sqlBackend . DBName) tables + query = "TRUNCATE TABLE " ++ (intercalate ", " escapedTables) + rawExecute query [] + +getTables :: MonadIO m => ReaderT SqlBackend m [Text] +getTables = do + tables <- rawSql "SELECT table_name FROM information_schema.tables WHERE table_schema = 'public';" [] + return $ map unSingle tables diff --git a/hsfiles/postgres.hsfiles b/hsfiles/postgres.hsfiles --- a/hsfiles/postgres.hsfiles +++ b/hsfiles/postgres.hsfiles @@ -32,6 +32,12 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -131,12 +137,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -161,6 +170,34 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a +db = handler . runDB + {-# START_FILE Foundation.hs #-} module Foundation where @@ -171,6 +208,7 @@ import Yesod.Auth.BrowserId (authBrowserId) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) +import qualified Yesod.Core.Unsafe as Unsafe -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -306,6 +344,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -423,6 +464,7 @@ Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-auth >= 1.4.0 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 @@ -534,7 +576,7 @@ , resourcet , monad-logger , transformers - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod @@ -695,40 +737,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -741,28 +794,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -8903,12 +8977,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg @@ -9032,7 +9100,7 @@ import Application (makeFoundation) import ClassyPrelude as X import Database.Persist as X hiding (get) -import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) +import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName) import Foundation as X import Model as X import Test.Hspec as X @@ -9041,14 +9109,37 @@ runDB :: SqlPersistM a -> YesodExample App a runDB query = do - pool <- fmap appConnPool getTestYesod - liftIO $ runSqlPersistMPool query pool + app <- getTestYesod + liftIO $ runDBWithApp app query +runDBWithApp :: App -> SqlPersistM a -> IO a +runDBWithApp app query = runSqlPersistMPool query (appConnPool app) + + withApp :: SpecWith App -> Spec withApp = before $ do settings <- loadAppSettings ["config/test-settings.yml", "config/settings.yml"] [] ignoreEnv - makeFoundation settings + foundation <- makeFoundation settings + wipeDB foundation + return foundation +-- This function will truncate all of the tables in your database. +-- 'withApp' calls it before each test, creating a clean environment for each +-- spec to run in. +wipeDB :: App -> IO () +wipeDB app = do + runDBWithApp app $ do + tables <- getTables + sqlBackend <- ask + + let escapedTables = map (connEscapeName sqlBackend . DBName) tables + query = "TRUNCATE TABLE " ++ (intercalate ", " escapedTables) + rawExecute query [] + +getTables :: MonadIO m => ReaderT SqlBackend m [Text] +getTables = do + tables <- rawSql "SELECT table_name FROM information_schema.tables WHERE table_schema = 'public';" [] + return $ map unSingle tables diff --git a/hsfiles/simple.hsfiles b/hsfiles/simple.hsfiles --- a/hsfiles/simple.hsfiles +++ b/hsfiles/simple.hsfiles @@ -32,6 +32,11 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler ) where import Control.Monad.Logger (liftLoc) @@ -40,7 +45,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -112,12 +117,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -142,14 +150,39 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + {-# START_FILE Foundation.hs #-} module Foundation where import Import.NoFoundation -import Text.Hamlet (hamletFile) -import Text.Jasmine (minifym) -import Yesod.Core.Types (Logger) -import Yesod.Default.Util (addStaticContentExternal) +import Text.Hamlet (hamletFile) +import Text.Jasmine (minifym) +import Yesod.Core.Types (Logger) +import Yesod.Default.Util (addStaticContentExternal) +import qualified Yesod.Core.Unsafe as Unsafe -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -244,6 +277,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -346,6 +382,7 @@ Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -380,7 +417,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 , classy-prelude >= 0.10.2 @@ -447,7 +484,7 @@ , yesod-test >= 1.4.2 && < 1.5 , yesod-core , yesod - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod @@ -604,40 +641,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -650,28 +698,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -8789,12 +8858,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg diff --git a/hsfiles/sqlite.hsfiles b/hsfiles/sqlite.hsfiles --- a/hsfiles/sqlite.hsfiles +++ b/hsfiles/sqlite.hsfiles @@ -32,6 +32,12 @@ , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, - setOnException, setPort) + setOnException, setPort, getPort) import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, @@ -131,12 +137,15 @@ -- | For yesod devel, return the Warp settings and WAI Application. getApplicationDev :: IO (Settings, Application) getApplicationDev = do - settings <- loadAppSettings [configSettingsYml] [] useEnv + settings <- getAppSettings foundation <- makeFoundation settings - app <- makeApplication foundation wsettings <- getDevSettings $ warpSettings foundation + app <- makeApplication foundation return (wsettings, app) +getAppSettings :: IO AppSettings +getAppSettings = loadAppSettings [configSettingsYml] [] useEnv + -- | main function for use by yesod devel develMain :: IO () develMain = develMainHelper getApplicationDev @@ -161,6 +170,34 @@ -- Run the application with Warp runSettings (warpSettings foundation) app + +-------------------------------------------------------------- +-- Functions for DevelMain.hs (a way to run the app from GHCi) +-------------------------------------------------------------- +getApplicationRepl :: IO (Int, App, Application) +getApplicationRepl = do + settings <- getAppSettings + foundation <- makeFoundation settings + wsettings <- getDevSettings $ warpSettings foundation + app1 <- makeApplication foundation + return (getPort wsettings, foundation, app1) + +shutdownApp :: App -> IO () +shutdownApp _ = return () + + +--------------------------------------------- +-- Functions for use in development with GHCi +--------------------------------------------- + +-- | Run a handler +handler :: Handler a -> IO a +handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a +db = handler . runDB + {-# START_FILE Foundation.hs #-} module Foundation where @@ -171,6 +208,7 @@ import Yesod.Auth.BrowserId (authBrowserId) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) +import qualified Yesod.Core.Unsafe as Unsafe -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -306,6 +344,9 @@ instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +unsafeHandler :: App -> Handler a -> IO a +unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger + -- Note: Some functionality previously present in the scaffolding has been -- moved to documentation in the Wiki. Following are some hopefully helpful -- links: @@ -423,6 +464,7 @@ Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ build-depends: base >= 4 && < 5 , yesod >= 1.4.1 && < 1.5 - , yesod-core >= 1.4.0 && < 1.5 + , yesod-core >= 1.4.6 && < 1.5 , yesod-auth >= 1.4.0 && < 1.5 , yesod-static >= 1.4.0.3 && < 1.5 , yesod-form >= 1.4.0 && < 1.5 @@ -534,7 +576,7 @@ , resourcet , monad-logger , transformers - , hspec + , hspec >= 2.0.0 , classy-prelude , classy-prelude-yesod @@ -695,40 +737,51 @@ staticFiles (appStaticDir compileTimeAppSettings) {-# START_FILE app/DevelMain.hs #-} --- | Development version to be run inside GHCi. +-- | Running your app inside GHCi. -- --- start this up with: +-- To start up GHCi for usage with Yesod, first make sure you are in dev mode: -- --- cabal repl --ghc-options="-O0 -fobject-code" +-- > cabal configure -fdev -- --- run with: +-- Note that @yesod devel@ automatically sets the dev flag. +-- Now launch the repl: -- --- :l DevelMain --- DevelMain.update +-- > cabal repl --ghc-options="-O0 -fobject-code" -- --- You will need to add these packages to your .cabal file --- * foreign-store >= 0.1 (very light-weight) --- * warp (you already depend on this, it just isn't in your .cabal file) +-- To start your app, run: -- +-- > :l DevelMain +-- > DevelMain.update +-- +-- You can also call @DevelMain.shutdown@ to stop the app +-- +-- You will need to add the foreign-store package to your .cabal file. +-- It is very light-weight. +-- -- If you don't use cabal repl, you will need --- to add settings to your .ghci file. +-- to run the following in GHCi or to add it to +-- your .ghci file. -- -- :set -DDEVELOPMENT -- --- There is more information about using ghci +-- There is more information about this approach, -- on the wiki: https://github.com/yesodweb/yesod/wiki/ghci module DevelMain where -import Application (getApplicationDev) +import Prelude +import Application (getApplicationRepl, shutdownApp) import Control.Exception (finally) +import Control.Monad ((>=>)) import Control.Concurrent import Data.IORef import Foreign.Store import Network.Wai.Handler.Warp +import GHC.Word -- | Start or restart the server. +-- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads update :: IO () update = do @@ -741,28 +794,49 @@ _ <- storeAction (Store tidStoreNum) (newIORef tid) return () -- server is already running - Just tidStore -> - -- shut the server down with killThread and wait for the done signal - modifyStoredIORef tidStore $ \tid -> do - killThread tid - withStore doneStore takeMVar >> readStore doneStore >>= start + Just tidStore -> restartAppInNewThread tidStore where + doneStore :: Store (MVar ()) doneStore = Store 0 - tidStoreNum = 1 - modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () - modifyStoredIORef store f = withStore store $ \ref -> do - v <- readIORef ref - f v >>= writeIORef ref + -- shut the server down with killThread and wait for the done signal + restartAppInNewThread :: Store (IORef ThreadId) -> IO () + restartAppInNewThread tidStore = modifyStoredIORef tidStore $ \tid -> do + killThread tid + withStore doneStore takeMVar + readStore doneStore >>= start --- | Start the server in a separate thread. -start :: MVar () -- ^ Written to when the thread is killed. - -> IO ThreadId -start done = do - (settings,app) <- getApplicationDev - forkIO (finally (runSettings settings app) - (putMVar done ())) + -- | Start the server in a separate thread. + start :: MVar () -- ^ Written to when the thread is killed. + -> IO ThreadId + start done = do + (port, site, app) <- getApplicationRepl + forkIO (finally (runSettings (setPort port defaultSettings) app) + -- Note that this implies concurrency + -- between shutdownApp and the next app that is starting. + -- Normally this should be fine + (putMVar done () >> shutdownApp site)) + +-- | kill the server +shutdown :: IO () +shutdown = do + mtidStore <- lookupStore tidStoreNum + case mtidStore of + -- no server running + Nothing -> putStrLn "no Yesod app running" + Just tidStore -> do + withStore tidStore $ readIORef >=> killThread + putStrLn "Yesod app is shutdown" + +tidStoreNum :: Word32 +tidStoreNum = 1 + +modifyStoredIORef :: Store (IORef a) -> (a -> IO a) -> IO () +modifyStoredIORef store f = withStore store $ \ref -> do + v <- readIORef ref + f v >>= writeIORef ref + {-# START_FILE app/devel.hs #-} {-# LANGUAGE PackageImports #-} import "PROJECTNAME" Application (develMain) @@ -8921,12 +8995,6 @@ \ var s = document.getElementsByTagName('script')[0]; s.parentNode.insertBefore(ga, s); })(); } - \ - \ {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg @@ -9050,13 +9118,20 @@ import Application (makeFoundation) import ClassyPrelude as X import Database.Persist as X hiding (get) -import Database.Persist.Sql (SqlPersistM, runSqlPersistMPool) +import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName) import Foundation as X import Model as X import Test.Hspec as X import Yesod.Default.Config2 (ignoreEnv, loadAppSettings) import Yesod.Test as X +-- Wiping the database +import Database.Persist.Sqlite (sqlDatabase, wrapConnection, createSqlPool) +import qualified Database.Sqlite as Sqlite +import Control.Monad.Logger (runLoggingT) +import Settings (appDatabaseConf) +import Yesod.Core (messageLoggerSource) + runDB :: SqlPersistM a -> YesodExample App a runDB query = do pool <- fmap appConnPool getTestYesod @@ -9068,5 +9143,43 @@ ["config/test-settings.yml", "config/settings.yml"] [] ignoreEnv - makeFoundation settings + foundation <- makeFoundation settings + wipeDB foundation + return foundation +-- This function will truncate all of the tables in your database. +-- 'withApp' calls it before each test, creating a clean environment for each +-- spec to run in. +wipeDB :: App -> IO () +wipeDB app = do + -- In order to wipe the database, we need to temporarily disable foreign key checks. + -- Unfortunately, disabling FK checks in a transaction is a noop in SQLite. + -- Normal Persistent functions will wrap your SQL in a transaction, + -- so we create a raw SQLite connection to disable foreign keys. + -- Foreign key checks are per-connection, so this won't effect queries outside this function. + + -- Aside: SQLite by default *does not enable foreign key checks* + -- (disabling foreign keys is only necessary for those who specifically enable them). + let settings = appSettings app + sqliteConn <- rawConnection (sqlDatabase $ appDatabaseConf settings) + disableForeignKeys sqliteConn + + let logFunc = messageLoggerSource app (appLogger app) + pool <- runLoggingT (createSqlPool (wrapConnection sqliteConn) 1) logFunc + + flip runSqlPersistMPool pool $ do + tables <- getTables + sqlBackend <- ask + let queries = map (\t -> "DELETE FROM " ++ (connEscapeName sqlBackend $ DBName t)) tables + forM_ queries (\q -> rawExecute q []) + +rawConnection :: Text -> IO Sqlite.Connection +rawConnection t = Sqlite.open t + +disableForeignKeys :: Sqlite.Connection -> IO () +disableForeignKeys conn = Sqlite.prepare conn "PRAGMA foreign_keys = OFF;" >>= void . Sqlite.step + +getTables :: MonadIO m => ReaderT SqlBackend m [Text] +getTables = do + tables <- rawSql "SELECT name FROM sqlite_master WHERE type = 'table';" [] + return (fmap unSingle tables) diff --git a/yesod-bin.cabal b/yesod-bin.cabal --- a/yesod-bin.cabal +++ b/yesod-bin.cabal @@ -1,5 +1,5 @@ name: yesod-bin -version: 1.4.3.3 +version: 1.4.3.4 license: MIT license-file: LICENSE author: Michael Snoyman