Skip to content

Instantly share code, notes, and snippets.

@gregwebs
Last active October 13, 2015 11:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save gregwebs/4191596 to your computer and use it in GitHub Desktop.
Save gregwebs/4191596 to your computer and use it in GitHub Desktop.
WAI static page generator with Yesod example
-- add to your yesod cabal file
executable static-pages
main-is: static-pages.hs
ghc-options: -Wall -Werror
build-depends: base >= 4.5
, yesod
, yesod-routes
, wai
, conduit
, text
, bytestring
, wai-test >= 1.2
, blaze-builder
, hamlet
, yesod-markdown
, shakespeare-text
, shakespeare-js
, shakespeare-css
, http-types
, data-default
---- Add deps from Settings in main app
, yesod-default
, persistent-mongoDB
, template-haskell
, yaml
, yesod-static
if flag(static-pages)
Buildable: True
else
Buildable: False
extensions: TemplateHaskell
QuasiQuotes
CPP
OverloadedStrings
MultiParamTypeClasses
TypeFamilies
import StaticPages (parseRoutePaths, renderStaticPages)
import Yesod
import Text.Hamlet
import qualified Data.Text as T
import Text.Shakespeare.Text
import Yesod.Markdown
import Settings.StaticFiles
import Yesod.Static
data StaticPages = StaticPages {fakeStatic::Static}
mkYesod "StaticPages" [parseRoutes|
/static StaticR Static fakeStatic
/pages PagesR GET
/pages/#String PageR GET
|]
staticPageRoutePaths :: [String]
staticPageRoutePaths = parseRoutePaths $ T.unpack [st|
/pages
/
about
faq
|]
instance Yesod StaticPages where
jsLoader _ = BottomOfBody
defaultLayout widget = do
pc <- widgetToPageContent $ do
addStylesheet $ StaticR css_pages_css
widget
hamletToRepHtml $(hamletFile "templates/static/layout.hamlet")
renderMarkdownFile :: String -> IO Html
renderMarkdownFile file =
fmap markdownToHtmlTrusted (markdownFromFile $ "templates/static/" ++ file ++ ".markdown")
getPageR :: String -> Handler RepHtml
getPageR page = do
defaultLayout $ do
content <- liftIO $ renderMarkdownFile page
toWidget [shamlet|#{content}|]
getPagesR :: Handler RepHtml
getPagesR = do
defaultLayout $ do
[whamlet|
<p>Home
|]
main :: IO ()
main = do
app <- toWaiAppPlain $ StaticPages undefined
renderStaticPages app "static/html/" staticPageRoutePaths
-- something like this can be used to make friendlier urls for the static pages
-- import Network.Wai.Middleware.Rewrite (rewritePure)
-- rewritePure rewriteConvert
rewriteConvert :: [Text] -> H.RequestHeaders -> [Text]
rewriteConvert pieces _ = staticRewrite pieces
where
staticRewrite :: [Text] -> [Text]
staticRewrite [] = homePage
staticRewrite ("static":"html":_) = homePage -- prevent direct access, not really necessary
staticRewrite route@("pages":_) | ".html" `T.isSuffixOf` last route = staticHtml ++ route
| otherwise = staticHtml ++ init route ++ [last route <> ".html"]
staticRewrite _ = pieces
where
homePage = staticHtml ++ ["pages.html"]
staticHtml = ["static", "html"]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment