haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Scaffolding update

Browse Source
This commit is contained in:
Michael Snoyman 2015-01-15 08:38:34 +02:00
parent 9a3a2a5aa5
commit f9ee741b92
8 changed files with 747 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
yesod-bin/ChangeLog.md
View File

@ -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)

151
yesod-bin/hsfiles/mongo.hsfiles
View File

@ -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 #-}

176
yesod-bin/hsfiles/mysql.hsfiles
View File

@ -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

182
yesod-bin/hsfiles/postgres-fay.hsfiles
View File

@ -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

171
yesod-bin/hsfiles/postgres.hsfiles
View File

@ -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

143
yesod-bin/hsfiles/simple.hsfiles
View File

@ -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 #-}

140
yesod-bin/hsfiles/sqlite.hsfiles
View File

@ -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 #-}

2
yesod-bin/yesod-bin.cabal
View File

@ -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>