mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-11 19:58:28 +01:00
authors and install pages
This commit is contained in:
parent
cab4e08fcc
commit
6b25df3e59
@ -5,13 +5,20 @@ module Data.WebsiteContent
|
||||
|
||||
import ClassyPrelude.Yesod
|
||||
import Text.Blaze.Html (preEscapedToMarkup)
|
||||
import Text.Markdown (markdown, msXssProtect)
|
||||
|
||||
data WebsiteContent = WebsiteContent
|
||||
{ wcHomepage :: !Html
|
||||
, wcAuthors :: !Html
|
||||
, wcInstall :: !Html
|
||||
}
|
||||
|
||||
loadWebsiteContent :: FilePath -> IO WebsiteContent
|
||||
loadWebsiteContent dir = do
|
||||
wcHomepage <- fmap (preEscapedToMarkup :: Text -> Html)
|
||||
$ readFile $ dir </> "homepage.html"
|
||||
wcAuthors <- fmap (preEscapedToMarkup :: Text -> Html)
|
||||
$ readFile $ dir </> "authors.html"
|
||||
wcInstall <- fmap (markdown def { msXssProtect = False })
|
||||
$ readFile $ dir </> "install.md"
|
||||
return WebsiteContent {..}
|
||||
|
||||
@ -14,10 +14,19 @@ import Yesod.GitRepo (grContent)
|
||||
-- functions. You can spread them across multiple files if you are so
|
||||
-- inclined, or create a single monolithic file.
|
||||
getHomeR :: Handler Html
|
||||
getHomeR = do
|
||||
getHomeR = contentHelper wcHomepage
|
||||
|
||||
getAuthorsR :: Handler Html
|
||||
getAuthorsR = contentHelper wcAuthors
|
||||
|
||||
getInstallR :: Handler Html
|
||||
getInstallR = contentHelper wcInstall
|
||||
|
||||
contentHelper :: (WebsiteContent -> Html) -> Handler Html
|
||||
contentHelper accessor = do
|
||||
windowsLatest <- linkFor "unstable-ghc78hp-inclusive"
|
||||
restLatest <- linkFor "unstable-ghc78-inclusive"
|
||||
homepage <- getYesod >>= fmap wcHomepage . liftIO . grContent . websiteContent
|
||||
homepage <- getYesod >>= fmap accessor . liftIO . grContent . websiteContent
|
||||
defaultLayout $ do
|
||||
setTitle "Stackage Server"
|
||||
$(combineStylesheets 'StaticR
|
||||
|
||||
@ -44,3 +44,6 @@
|
||||
|
||||
/lts/*Texts LtsR GET
|
||||
/nightly/*Texts NightlyR GET
|
||||
|
||||
/authors AuthorsR GET
|
||||
/install InstallR GET
|
||||
|
||||
Loading…
Reference in New Issue
Block a user