yesod-bin 1.4.3.3 → 1.4.3.4
raw patch · 8 files changed
+828/−273 lines, 8 files
Files
- ChangeLog.md +9/−0
- hsfiles/mongo.hsfiles +141/−48
- hsfiles/mysql.hsfiles +140/−44
- hsfiles/postgres-fay.hsfiles +140/−50
- hsfiles/postgres.hsfiles +135/−44
- hsfiles/simple.hsfiles +107/−44
- hsfiles/sqlite.hsfiles +155/−42
- yesod-bin.cabal +1/−1
ChangeLog.md view
@@ -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)
hsfiles/mongo.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# 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."+
hsfiles/mysql.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# 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
hsfiles/postgres-fay.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# 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
hsfiles/postgres.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# 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
hsfiles/simple.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# START_FILE templates/default-layout.hamlet #-} $maybe msg <- mmsg
hsfiles/sqlite.hsfiles view
@@ -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); })(); }- \<!-- Prompt IE 6 users to install Chrome Frame. Remove this if you want to support IE 6. chromium.org/developers/how-tos/chrome-frame-getting-started -->- \<!--[if lt IE 7 ]>- <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.3/CFInstall.min.js">- <script>- window.attachEvent('onload',function(){CFInstall.check({mode:'overlay'})})- \<![endif]--> {-# 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)
yesod-bin.cabal view
@@ -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 <michael@snoyman.com>