diff --git a/yesod-bin/ChangeLog.md b/yesod-bin/ChangeLog.md index 9f38a06e..5f6a5c5c 100644 --- a/yesod-bin/ChangeLog.md +++ b/yesod-bin/ChangeLog.md @@ -1,3 +1,11 @@ +## 1.4.3.4 + +Scaffolding updates: + +* Improve `DevelMain` support +* Wipe out database during test runs +* Convenience `unsafeHandler` function + ## 1.4.3.3 More consistent whitespace in hamlet files in scaffolding [#50](https://github.com/yesodweb/yesod-scaffold/issues/50) diff --git a/yesod-bin/hsfiles/mongo.hsfiles b/yesod-bin/hsfiles/mongo.hsfiles index 10a071db..a49d4f18 100644 --- a/yesod-bin/hsfiles/mongo.hsfiles +++ b/yesod-bin/hsfiles/mongo.hsfiles @@ -32,15 +32,22 @@ module Application , 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 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 YesodAuthPersist App 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 @@ Flag library-only Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -446,7 +489,7 @@ library 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 @@ -683,40 +726,51 @@ import Yesod.Static (staticFiles) 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,27 +783,48 @@ update = do _ <- 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 #-} diff --git a/yesod-bin/hsfiles/mysql.hsfiles b/yesod-bin/hsfiles/mysql.hsfiles index 89ee49f8..d72e8dd0 100644 --- a/yesod-bin/hsfiles/mysql.hsfiles +++ b/yesod-bin/hsfiles/mysql.hsfiles @@ -32,6 +32,12 @@ module Application , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ 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, @@ -131,12 +137,15 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 Text.Jasmine (minifym) 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 YesodAuthPersist App 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 @@ Flag library-only Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ library 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 @@ -695,40 +737,51 @@ import Yesod.Static (staticFiles) 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,27 +794,48 @@ update = do _ <- 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 #-} @@ -9032,7 +9106,7 @@ module TestImport 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,8 +9115,11 @@ import Yesod.Test as X 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 @@ -9050,5 +9127,30 @@ withApp = before $ do ["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/yesod-bin/hsfiles/postgres-fay.hsfiles b/yesod-bin/hsfiles/postgres-fay.hsfiles index a76515be..a99bef30 100644 --- a/yesod-bin/hsfiles/postgres-fay.hsfiles +++ b/yesod-bin/hsfiles/postgres-fay.hsfiles @@ -35,6 +35,12 @@ module Application , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -45,7 +51,7 @@ 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, @@ -137,12 +143,15 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 YesodAuthPersist App 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 @@ Flag library-only Default: False library - hs-source-dirs: ., fay-shared + hs-source-dirs: ., fay-shared, app exposed-modules: Application Foundation Import @@ -502,7 +543,7 @@ library 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 @@ -755,40 +796,51 @@ import Yesod.Static (staticFiles) 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,27 +853,48 @@ update = do _ <- 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 #-} @@ -9153,7 +9226,7 @@ module TestImport 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,8 +9235,12 @@ import Yesod.Test as X 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 @@ -9171,5 +9248,24 @@ withApp = before $ do ["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/yesod-bin/hsfiles/postgres.hsfiles b/yesod-bin/hsfiles/postgres.hsfiles index ce6ad9f9..d4d1fed6 100644 --- a/yesod-bin/hsfiles/postgres.hsfiles +++ b/yesod-bin/hsfiles/postgres.hsfiles @@ -32,6 +32,12 @@ module Application , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ 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, @@ -131,12 +137,15 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 Text.Jasmine (minifym) 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 YesodAuthPersist App 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 @@ Flag library-only Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ library 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 @@ -695,40 +737,51 @@ import Yesod.Static (staticFiles) 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,27 +794,48 @@ update = do _ <- 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 #-} @@ -9032,7 +9106,7 @@ module TestImport 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,8 +9115,12 @@ import Yesod.Test as X 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 @@ -9050,5 +9128,24 @@ withApp = before $ do ["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/yesod-bin/hsfiles/simple.hsfiles b/yesod-bin/hsfiles/simple.hsfiles index e582fb83..e694909c 100644 --- a/yesod-bin/hsfiles/simple.hsfiles +++ b/yesod-bin/hsfiles/simple.hsfiles @@ -32,6 +32,11 @@ module Application , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler ) where import Control.Monad.Logger (liftLoc) @@ -40,7 +45,7 @@ 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, @@ -112,12 +117,15 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 Yesod App where 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 @@ Flag library-only Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -380,7 +417,7 @@ library 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 @@ -604,40 +641,51 @@ import Yesod.Static (staticFiles) 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,27 +698,48 @@ update = do _ <- 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 #-} diff --git a/yesod-bin/hsfiles/sqlite.hsfiles b/yesod-bin/hsfiles/sqlite.hsfiles index e9644232..303daa1e 100644 --- a/yesod-bin/hsfiles/sqlite.hsfiles +++ b/yesod-bin/hsfiles/sqlite.hsfiles @@ -32,6 +32,12 @@ module Application , appMain , develMain , makeFoundation + -- * for DevelMain + , getApplicationRepl + , shutdownApp + -- * for GHCI + , handler + , db ) where import Control.Monad.Logger (liftLoc, runLoggingT) @@ -42,7 +48,7 @@ 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, @@ -131,12 +137,15 @@ warpSettings foundation = -- | 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 @@ appMain = do -- 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 Text.Jasmine (minifym) 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 YesodAuthPersist App 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 @@ Flag library-only Default: False library + hs-source-dirs: ., app exposed-modules: Application Foundation Import @@ -458,7 +500,7 @@ library 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 @@ -695,40 +737,51 @@ import Yesod.Static (staticFiles) 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,27 +794,48 @@ update = do _ <- 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 #-} diff --git a/yesod-bin/yesod-bin.cabal b/yesod-bin/yesod-bin.cabal index 0ed985ac..63f6f0b3 100644 --- a/yesod-bin/yesod-bin.cabal +++ b/yesod-bin/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