Rename foundation type

This commit is contained in:
Gregor Kleen 2017-10-04 14:17:10 +02:00
parent e2e6ab3798
commit ef3be262aa
2 changed files with 27 additions and 27 deletions

View File

@ -45,13 +45,13 @@ import Handler.Profile
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
-- comments there for more details. -- comments there for more details.
mkYesodDispatch "App" resourcesApp mkYesodDispatch "UniWorX" resourcesUniWorX
-- | This function allocates resources (such as a database connection pool), -- | This function allocates resources (such as a database connection pool),
-- performs initialization and returns a foundation datatype value. This is also -- performs initialization and returns a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database -- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod. -- migrations handled by Yesod.
makeFoundation :: AppSettings -> IO App makeFoundation :: AppSettings -> IO UniWorX
makeFoundation appSettings = do makeFoundation appSettings = do
-- Some basic initializations: HTTP connection manager, logger, and static -- Some basic initializations: HTTP connection manager, logger, and static
-- subsite. -- subsite.
@ -66,8 +66,8 @@ makeFoundation appSettings = do
-- logging function. To get out of this loop, we initially create a -- logging function. To get out of this loop, we initially create a
-- temporary foundation without a real connection pool, get a log function -- temporary foundation without a real connection pool, get a log function
-- from there, and then create the real foundation. -- from there, and then create the real foundation.
let mkFoundation appConnPool = App {..} let mkFoundation appConnPool = UniWorX {..}
-- The App {..} syntax is an example of record wild cards. For more -- The UniWorX {..} syntax is an example of record wild cards. For more
-- information, see: -- information, see:
-- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
tempFoundation = mkFoundation $ error "connPool forced in tempFoundation" tempFoundation = mkFoundation $ error "connPool forced in tempFoundation"
@ -86,14 +86,14 @@ makeFoundation appSettings = do
-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applying some additional middlewares. -- applying some additional middlewares.
makeApplication :: App -> IO Application makeApplication :: UniWorX -> IO Application
makeApplication foundation = do makeApplication foundation = do
logWare <- makeLogWare foundation logWare <- makeLogWare foundation
-- Create the WAI application and apply middlewares -- Create the WAI application and apply middlewares
appPlain <- toWaiAppPlain foundation appPlain <- toWaiAppPlain foundation
return $ logWare $ defaultMiddlewaresNoLogging appPlain return $ logWare $ defaultMiddlewaresNoLogging appPlain
makeLogWare :: App -> IO Middleware makeLogWare :: UniWorX -> IO Middleware
makeLogWare foundation = makeLogWare foundation =
mkRequestLogger def mkRequestLogger def
{ outputFormat = { outputFormat =
@ -108,7 +108,7 @@ makeLogWare foundation =
-- | Warp settings for the given foundation value. -- | Warp settings for the given foundation value.
warpSettings :: App -> Settings warpSettings :: UniWorX -> Settings
warpSettings foundation = warpSettings foundation =
setPort (appPort $ appSettings foundation) setPort (appPort $ appSettings foundation)
$ setHost (appHost $ appSettings foundation) $ setHost (appHost $ appSettings foundation)
@ -162,7 +162,7 @@ appMain = do
-------------------------------------------------------------- --------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi) -- Functions for DevelMain.hs (a way to run the app from GHCi)
-------------------------------------------------------------- --------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application) getApplicationRepl :: IO (Int, UniWorX, Application)
getApplicationRepl = do getApplicationRepl = do
settings <- getAppDevSettings settings <- getAppDevSettings
foundation <- makeFoundation settings foundation <- makeFoundation settings
@ -170,7 +170,7 @@ getApplicationRepl = do
app1 <- makeApplication foundation app1 <- makeApplication foundation
return (getPort wsettings, foundation, app1) return (getPort wsettings, foundation, app1)
shutdownApp :: App -> IO () shutdownApp :: UniWorX -> IO ()
shutdownApp _ = return () shutdownApp _ = return ()
@ -183,5 +183,5 @@ handler :: Handler a -> IO a
handler h = getAppDevSettings >>= makeFoundation >>= flip unsafeHandler h handler h = getAppDevSettings >>= makeFoundation >>= flip unsafeHandler h
-- | Run DB queries -- | Run DB queries
db :: ReaderT SqlBackend (HandlerT App IO) a -> IO a db :: ReaderT SqlBackend (HandlerT UniWorX IO) a -> IO a
db = handler . runDB db = handler . runDB

View File

@ -26,7 +26,7 @@ import qualified Data.Text.Encoding as TE
-- keep settings and values requiring initialization before your application -- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have -- starts running, such as database connections. Every handler will have
-- access to the data present here. -- access to the data present here.
data App = App data UniWorX = UniWorX
{ appSettings :: AppSettings { appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving. , appStatic :: Static -- ^ Settings for static file serving.
, appConnPool :: ConnectionPool -- ^ Database connection pool. , appConnPool :: ConnectionPool -- ^ Database connection pool.
@ -36,7 +36,7 @@ data App = App
data MenuItem = MenuItem data MenuItem = MenuItem
{ menuItemLabel :: Text { menuItemLabel :: Text
, menuItemRoute :: Route App , menuItemRoute :: Route UniWorX
, menuItemAccessCallback :: Bool , menuItemAccessCallback :: Bool
} }
@ -54,16 +54,16 @@ data MenuTypes
-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules -- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
-- --
-- This function also generates the following type synonyms: -- This function also generates the following type synonyms:
-- type Handler = HandlerT App IO -- type Handler = HandlerT UniWorX IO
-- type Widget = WidgetT App IO () -- type Widget = WidgetT UniWorX IO ()
mkYesodData "App" $(parseRoutesFile "routes") mkYesodData "UniWorX" $(parseRoutesFile "routes")
-- | A convenient synonym for creating forms. -- | A convenient synonym for creating forms.
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) type Form x = Html -> MForm (HandlerT UniWorX IO) (FormResult x, Widget)
-- Please see the documentation for the Yesod typeclass. There are a number -- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here. -- of settings which can be configured by overriding methods here.
instance Yesod App where instance Yesod UniWorX where
-- Controls the base of generated URLs. For more information on modifying, -- Controls the base of generated URLs. For more information on modifying,
-- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
approot = ApprootRequest $ \app req -> approot = ApprootRequest $ \app req ->
@ -178,23 +178,23 @@ instance Yesod App where
makeLogger = return . appLogger makeLogger = return . appLogger
-- Define breadcrumbs. -- Define breadcrumbs.
instance YesodBreadcrumbs App where instance YesodBreadcrumbs UniWorX where
breadcrumb HomeR = return ("Home", Nothing) breadcrumb HomeR = return ("Home", Nothing)
breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb (AuthR _) = return ("Login", Just HomeR)
breadcrumb ProfileR = return ("Profile", Just HomeR) breadcrumb ProfileR = return ("Profile", Just HomeR)
breadcrumb _ = return ("home", Nothing) breadcrumb _ = return ("home", Nothing)
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist UniWorX where
type YesodPersistBackend App = SqlBackend type YesodPersistBackend UniWorX = SqlBackend
runDB action = do runDB action = do
master <- getYesod master <- getYesod
runSqlPool action $ appConnPool master runSqlPool action $ appConnPool master
instance YesodPersistRunner App where instance YesodPersistRunner UniWorX where
getDBRunner = defaultGetDBRunner appConnPool getDBRunner = defaultGetDBRunner appConnPool
instance YesodAuth App where instance YesodAuth UniWorX where
type AuthId App = UserId type AuthId UniWorX = UserId
-- Where to send a user after successful login -- Where to send a user after successful login
loginDest _ = HomeR loginDest _ = HomeR
@ -227,20 +227,20 @@ isAuthenticated = do
Nothing -> Unauthorized "You must login to access this page" Nothing -> Unauthorized "You must login to access this page"
Just _ -> Authorized Just _ -> Authorized
instance YesodAuthPersist App instance YesodAuthPersist UniWorX
-- This instance is required to use forms. You can modify renderMessage to -- This instance is required to use forms. You can modify renderMessage to
-- achieve customized and internationalized form validation messages. -- achieve customized and internationalized form validation messages.
instance RenderMessage App FormMessage where instance RenderMessage UniWorX FormMessage where
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage
-- Useful when writing code that is re-usable outside of the Handler context. -- Useful when writing code that is re-usable outside of the Handler context.
-- An example is background jobs that send email. -- An example is background jobs that send email.
-- This can also be useful for writing code that works across multiple Yesod applications. -- This can also be useful for writing code that works across multiple Yesod applications.
instance HasHttpManager App where instance HasHttpManager UniWorX where
getHttpManager = appHttpManager getHttpManager = appHttpManager
unsafeHandler :: App -> Handler a -> IO a unsafeHandler :: UniWorX -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-- Note: Some functionality previously present in the scaffolding has been -- Note: Some functionality previously present in the scaffolding has been