{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} module Foundation ( ~sitearg~ (..) , ~sitearg~Route (..) , resources~sitearg~ , Handler , Widget , module Yesod.Core , module Settings , StaticRoute (..) , lift , liftIO ) where import Yesod.Core import Yesod.Static (Static, base64md5, StaticRoute(..)) import Settings.StaticFiles import Yesod.Logger (Logger, logLazyText) import qualified Settings import System.Directory import qualified Data.ByteString.Lazy as L import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile) import Control.Monad (unless) import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Web.ClientSession (getKey) -- | 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 ~sitearg~ = ~sitearg~ { settings :: Settings.AppConfig , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. } -- This is where we define all of the routes in our application. For a full -- explanation of the syntax, please see: -- http://docs.yesodweb.com/book/web-routes-quasi/ -- -- This function does three things: -- -- * Creates the route datatype ~sitearg~Route. Every valid URL in your -- application can be represented as a value of this type. -- * Creates the associated type: -- type instance Route ~sitearg~ = ~sitearg~Route -- * Creates the value resources~sitearg~ which contains information on the -- resources declared below. This is used in Handler.hs by the call to -- mkYesodDispatch -- -- What this function does *not* do is create a YesodSite instance for -- ~sitearg~. Creating that instance requires all of the handler functions -- for our application to be in scope. However, the handler functions -- usually require access to the ~sitearg~Route datatype. Therefore, we -- split these actions into two functions and place them in separate files. mkYesodData "~sitearg~" $(parseRoutesFile "config/routes") -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. instance Yesod ~sitearg~ where approot = Settings.appRoot . settings -- Place the session key file in the config folder encryptKey _ = fmap Just $ getKey "config/client_session_key.aes" defaultLayout widget = do mmsg <- getMessage pc <- widgetToPageContent $ do widget addCassius $(cassiusFile "default-layout") hamletToRepHtml $(hamletFile "default-layout") -- 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 messageLogger y loc level msg = formatLogMessage loc level msg >>= logLazyText (getLogger y) -- 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 ext' _ content = do let fn = base64md5 content ++ '.' : T.unpack ext' let statictmp = Settings.staticDir ++ "/tmp/" liftIO $ createDirectoryIfMissing True statictmp let fn' = statictmp ++ fn exists <- liftIO $ doesFileExist fn' unless exists $ liftIO $ L.writeFile fn' content return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], [])