haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-22 08:51:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Initial older releases code

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-15 18:13:48 +02:00
parent f56119fc18
commit 46c1b6e97f
3 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Data/WebsiteContent.hs
View File

@ -10,17 +10,22 @@ data WebsiteContent = WebsiteContent
{ wcHomepage :: !Html { wcHomepage :: !Html
, wcAuthors :: !Html , wcAuthors :: !Html
, wcInstall :: !Html , wcInstall :: !Html
, wcOlderReleases :: !Html
} }
loadWebsiteContent :: FilePath -> IO WebsiteContent loadWebsiteContent :: FilePath -> IO WebsiteContent
loadWebsiteContent dir = do loadWebsiteContent dir = do
wcHomepage <- fmap (preEscapedToMarkup :: Text -> Html) wcHomepage <- readHtml "homepage.html"
$ readFile $ dir </> "homepage.html" wcAuthors <- readHtml "authors.html"
wcAuthors <- fmap (preEscapedToMarkup :: Text -> Html) wcInstall <- readMarkdown "install.md"
$ readFile $ dir </> "authors.html" wcOlderReleases <- readHtml "older-releases.html" `catchIO`
wcInstall <- fmap (markdown def \_ -> readMarkdown "older-releases.md"
return WebsiteContent {..}
where
readHtml fp = fmap (preEscapedToMarkup :: Text -> Html)
$ readFile $ dir </> fp
readMarkdown fp = fmap (markdown def
{ msXssProtect = False { msXssProtect = False
, msAddHeadingId = True , msAddHeadingId = True
}) })
$ readFile $ dir </> "install.md" $ readFile $ dir </> fp
return WebsiteContent {..}

3
Handler/Home.hs
View File

@ -22,6 +22,9 @@ getAuthorsR = contentHelper "Library Authors" wcAuthors
getInstallR :: Handler Html getInstallR :: Handler Html
getInstallR = contentHelper "Haskell Installation Instructions" wcInstall getInstallR = contentHelper "Haskell Installation Instructions" wcInstall
getOlderReleasesR :: Handler Html
getOlderReleasesR = contentHelper "Older Releases" wcOlderReleases
contentHelper :: Html -> (WebsiteContent -> Html) -> Handler Html contentHelper :: Html -> (WebsiteContent -> Html) -> Handler Html
contentHelper title accessor = do contentHelper title accessor = do
homepage <- getYesod >>= fmap accessor . liftIO . grContent . websiteContent homepage <- getYesod >>= fmap accessor . liftIO . grContent . websiteContent

1
config/routes
View File

@ -49,3 +49,4 @@
/authors AuthorsR GET /authors AuthorsR GET
/install InstallR GET /install InstallR GET
/older-releases OlderReleasesR GET