diff options
Diffstat (limited to 'Foundation.hs')
-rw-r--r-- | Foundation.hs | 122 |
1 files changed, 122 insertions, 0 deletions
diff --git a/Foundation.hs b/Foundation.hs new file mode 100644 index 0000000..777f4fa --- /dev/null +++ b/Foundation.hs @@ -0,0 +1,122 @@ +module Foundation where + +import Prelude +import Yesod +import Yesod.Static +import Yesod.Default.Config +import Yesod.Default.Util (addStaticContentExternal) +import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager)) +import qualified Settings +import Settings.Development (development) +import Settings.StaticFiles +import Settings (widgetFile, Extra (..)) +import Text.Jasmine (minifym) +import Text.Hamlet (hamletFile) +import Yesod.Core.Types (Logger) + +-- | The site argument 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 + { settings :: AppConfig DefaultEnv Extra + , getStatic :: Static -- ^ Settings for static file serving. + , httpManager :: Manager + , appLogger :: Logger + } + +instance HasHttpManager App where + getHttpManager = httpManager + +-- Set up i18n messages. See the message folder. +mkMessage "App" "messages" "en" + +-- 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 linked documentation for an +-- explanation for this split. +mkYesodData "App" $(parseRoutesFile "config/routes") + +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 = ApprootMaster $ appRoot . settings + + -- Store session data on the client in encrypted cookies, + -- default session idle timeout is 120 minutes + makeSessionBackend _ = fmap Just $ defaultClientSessionBackend + 120 -- timeout in minutes + "config/client_session_key.aes" + + defaultLayout widget = do + master <- getYesod + mmsg <- getMessage + + -- 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 + $(combineStylesheets 'StaticR + [ css_normalize_css + , css_bootstrap_css + ]) + $(widgetFile "default-layout") + withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") + + -- This is done to provide an optimization for serving static files from + -- a separate domain. Please see the staticRoot setting in Settings.hs + urlRenderOverride y (StaticR s) = + Just $ uncurry (joinPath y (Settings.staticRoot $ settings y)) $ renderRoute s + urlRenderOverride _ _ = Nothing + + -- Routes not requiring authenitcation. + isAuthorized FaviconR _ = return Authorized + isAuthorized RobotsR _ = return Authorized + -- Default to Authorized for now. + isAuthorized _ _ = return Authorized + + -- 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 = + addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute []) + where + -- Generate a unique filename based on the content itself + genFileName lbs + | development = "autogen-" ++ base64md5 lbs + | otherwise = base64md5 lbs + + -- Place Javascript at bottom of the body tag so the rest of the page loads first + jsLoader _ = BottomOfBody + + -- What messages should be logged. The following includes all messages when + -- in development, and warnings and errors in production. + shouldLog _ _source level = + development || level == LevelWarn || level == LevelError + + makeLogger = return . appLogger + +-- 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 + +-- | Get the 'Extra' value, used to hold data from the settings.yml file. +getExtra :: Handler Extra +getExtra = fmap (appExtra . settings) getYesod + +-- Note: previous versions of the scaffolding included a deliver function to +-- send emails. Unfortunately, there are too many different options for us to +-- give a reasonable default. Instead, the information is available on the +-- wiki: +-- +-- https://github.com/yesodweb/yesod/wiki/Sending-email |