module Foundation where import Import.NoFoundation hiding (requestHeaders) import Database.Persist.Sql (ConnectionPool, runSqlPool) import Text.Hamlet (hamletFile) 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 -- starts running, such as database connections. Every handler will have -- access to the data present here. data App = App { appSettings :: AppSettings , appStatic :: EmbeddedStatic , appConnPool :: ConnectionPool -- ^ Database connection pool. , appHttpManager :: Manager , appLogger :: Logger } data MenuItem = MenuItem { menuItemLabel :: Text , menuItemRoute :: Route App } -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: -- http://www.yesodweb.com/book/routing-and-handlers -- -- Note that this is really half the story; in Application.hs, mkYesodDispatch -- generates the rest of the code. Please see the following documentation -- for an explanation for this split: -- 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: -- type Handler = HandlerT App IO -- type Widget = WidgetT App IO () mkYesodData "App" $(parseRoutesFile "config/routes") -- | A convenient synonym for creating forms. type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. instance Yesod App where approot = ApprootRequest $ \app req -> case appRoot $ appSettings app of Nothing -> getApprootText guessApproot app req Just root -> root -- Store session data on the client in encrypted cookies, -- default session idle timeout is 120 minutes makeSessionBackend _ = Just <$> defaultClientSessionBackend 120 -- timeout in minutes "client_session_key.aes" -- Yesod Middleware allows you to run code before and after each handler function. -- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks. -- Some users may also want to add the defaultCsrfMiddleware, which: -- a) Sets a cookie with a CSRF token in it. -- b) Validates that incoming write requests include that token in either a header or POST parameter. -- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware -- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package. yesodMiddleware = defaultYesodMiddleware defaultLayout widget = do msgs <- getMessages mCurrentRoute <- getCurrentRoute -- Define the menu items of the header. let menuItems = [ MenuItem "List" InventoryListR , MenuItem "Table" InventoryListingR , MenuItem "Reference" ReferenceListingR , MenuItem "Shopping List" ListR ] currentMenu = listToMaybe [ menuItemLabel | MenuItem{..} <- menuItems , Just menuItemRoute == mCurrentRoute ] -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and -- default-layout-wrapper is the entire page. Since the final -- value passed to hamletToRepHtml cannot be a widget, this allows -- you to use normal widget features in default-layout. pc <- widgetToPageContent $ do setTitle . toHtml . maybe "Bar Inventory" ("Bar Inventory – " <>) $ do cM <- currentMenu guard $ cM /= "Inventory" return cM addScript $ StaticR jquery_js addScript $ StaticR webshim_polyfiller_js $(widgetFile "default-layout") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content. addStaticContent = embedStaticContent appStatic StaticR Right -- What messages should be logged. The following includes all messages when -- in development, and warnings and errors in production. shouldLog app _source level = appShouldLogAll (appSettings app) || level == LevelWarn || level == LevelError makeLogger = return . appLogger -- Provide proper Bootstrap styling for default displays, like -- error pages defaultMessageWidget title body = $(widgetFile "default-message-widget") -- How to run database actions. instance YesodPersist App where type YesodPersistBackend App = SqlBackend runDB action = do master <- getYesod runSqlPool action $ appConnPool master instance YesodPersistRunner App where getDBRunner = defaultGetDBRunner appConnPool -- This instance is required to use forms. You can modify renderMessage to -- achieve customized and internationalized form validation messages. instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage -- Useful when writing code that is re-usable outside of the Handler context. -- An example is background jobs that send email. -- This can also be useful for writing code that works across multiple Yesod applications. instance HasHttpManager App where getHttpManager = appHttpManager 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: -- -- https://github.com/yesodweb/yesod/wiki/Sending-email -- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain -- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding