diff --git a/config/routes b/config/routes index c18e3fb..b9fcfd2 100644 --- a/config/routes +++ b/config/routes @@ -2,6 +2,7 @@ / HomeR GET /reload ReloadR GET /downloads DownloadsR GET +/downloads/#OS DownloadsForR GET /community CommunityR GET /irc IrcR GET /mailing-lists MailingListsR GET diff --git a/src/HL/C.hs b/src/HL/C.hs index e91ff39..24cdfdd 100644 --- a/src/HL/C.hs +++ b/src/HL/C.hs @@ -8,7 +8,8 @@ module HL.C where import HL.Foundation (Handler) -import HL.Foundation as C (Route(..),App(..)) +import HL.Foundation as C (Route(..)) +import HL.Types as C import Control.Monad.Extra import Data.Text as C (Text) diff --git a/src/HL/C/Downloads.hs b/src/HL/C/Downloads.hs index 77bfeeb..e027be4 100644 --- a/src/HL/C/Downloads.hs +++ b/src/HL/C/Downloads.hs @@ -4,10 +4,13 @@ module HL.C.Downloads where -import HL.C.Markdown import HL.C +import HL.V.Downloads -- | Downloads controller. getDownloadsR :: C Html -getDownloadsR = - markdownPage [] "Downloads" "downloads.md" +getDownloadsR = senza downloadsV + +-- | Downloads for particular OS. +getDownloadsForR :: OS -> C Html +getDownloadsForR = senza . downloadsForV diff --git a/src/HL/Foundation.hs b/src/HL/Foundation.hs index 5fdef6c..dd85750 100644 --- a/src/HL/Foundation.hs +++ b/src/HL/Foundation.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-} @@ -12,9 +13,13 @@ module HL.Foundation ,Route(..) ,Handler ,Widget - ,resourcesApp) + ,resourcesApp + ,Slug(..) + ,Human(..)) where +import Data.Monoid +import Data.Text (pack) import HL.Static import HL.Types @@ -35,3 +40,39 @@ instance Yesod App where (date,_) <- clockDateCacher return (Logger {loggerSet = set ,loggerDate = date}) + +instance Human (Route App) where + toHuman r = + case r of + CommunityR -> "Community" + IrcR -> "IRC" + DocumentationR -> "Documentation" + HomeR -> "Home" + ReloadR -> "Reload" + MailingListsR -> "Mailing Lists" + NewsR -> "News" + StaticR{} -> "Static" + DownloadsR -> "Downloads" + DownloadsForR os -> "Downloads for " <> toHuman os + WikiR t -> "Wiki: " <> t + ReportR i _ -> "Report " <> pack (show i) + ReportHomeR i -> "Report " <> pack (show i) + WikiHomeR{} -> "Wiki" + +instance Slug (Route App) where + toSlug r = + case r of + CommunityR -> "community" + IrcR -> "irc" + DocumentationR -> "documentation" + HomeR -> "home" + ReloadR -> "reload" + MailingListsR -> "mailing-lists" + NewsR -> "news" + StaticR{} -> "static" + DownloadsR -> "downloads" + WikiR{} -> "wiki" + ReportR{} -> "report" + ReportHomeR{} -> "report" + WikiHomeR{} -> "wiki" + DownloadsForR{} -> "downloads" diff --git a/src/HL/M/Markdown.hs b/src/HL/M/Markdown.hs index 38226da..69d8f20 100644 --- a/src/HL/M/Markdown.hs +++ b/src/HL/M/Markdown.hs @@ -6,10 +6,8 @@ module HL.M.Markdown where import HL.C -import HL.Types import HL.V.Code - import Control.Exception import qualified Data.Text.IO as ST import qualified Data.Text.Lazy as L diff --git a/src/HL/M/Report.hs b/src/HL/M/Report.hs index e105101..404bac7 100644 --- a/src/HL/M/Report.hs +++ b/src/HL/M/Report.hs @@ -8,7 +8,6 @@ module HL.M.Report where import HL.C -import HL.Types import Control.Exception import qualified Data.ByteString as S diff --git a/src/HL/Types.hs b/src/HL/Types.hs index 3365f50..fae4466 100644 --- a/src/HL/Types.hs +++ b/src/HL/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Side-wide datatypes. @@ -6,9 +7,19 @@ module HL.Types where import Control.Concurrent.Chan import Control.Exception +import Data.Text (Text) import Data.Typeable +import Yesod import Yesod.Static +-- | Make a human-readable version of the value. +class Human a where + toHuman :: a -> Text + +-- | Make a slug version of the value. +class Slug a where + toSlug :: a -> Text + -- | A haskell-lang exception. data HaskellLangException = MarkdownFileUnavailable !FilePath @@ -22,3 +33,29 @@ data App = App { appStatic :: !Static , appReload :: !(Chan ()) } + +data OS = Windows | OSX | Linux + deriving (Read,Show,Typeable,Eq,Enum,Bounded) + +instance Slug OS where + toSlug o = + case o of + Windows -> "windows" + OSX -> "osx" + Linux -> "linux" + +instance Human OS where + toHuman o = + case o of + Windows -> "Windows" + OSX -> "OS X" + Linux -> "Linux" + +instance PathPiece OS where + toPathPiece = toSlug + fromPathPiece t = + case t of + "osx" -> Just OSX + "windows" -> Just Windows + "linux" -> Just Linux + _ -> Nothing diff --git a/src/HL/V.hs b/src/HL/V.hs index c579bed..1413270 100644 --- a/src/HL/V.hs +++ b/src/HL/V.hs @@ -6,8 +6,9 @@ module HL.V ,module V) where -import HL.Foundation as V (Route(..),App) +import HL.Foundation as V (Route(..),App,Human(..),Slug(..)) import HL.Static as V +import HL.Types as C import Control.Monad as V import Data.Text as V (Text) diff --git a/src/HL/V/Downloads.hs b/src/HL/V/Downloads.hs new file mode 100644 index 0000000..6d5ac64 --- /dev/null +++ b/src/HL/V/Downloads.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Downloads page view. + +module HL.V.Downloads where + +import Data.Monoid +import HL.Types +import HL.V hiding (list) +import HL.V.Template + +-- | Downloads view. +downloadsV :: FromSenza App +downloadsV = + template + [] + "Downloads" + (\url -> + container + (row + (span12 + [] + (do h1 [] "Downloads" + h2 [] "Compiler and base libraries" + p [] "Downloads are available on a per operating system basis:" + ul [] + (forM_ [minBound .. maxBound] + (\os -> li [] (a [href (url (DownloadsForR os))] + (toHtml (toHuman os))))) + h2 [] "Third party libraries" + p [class_ "muted"] + "Explanation of Hackage and Stackage here.")))) + +-- | OS-specific downloads view. +downloadsForV :: OS -> FromSenza App +downloadsForV os = + template + [DownloadsR + ,DownloadsForR os] + ("Downloads for " <> toHuman os) + (\_ -> + container + (row + (span12 + [] + (do h1 [] (toHtml ("Downloads for " <> toHuman os)) + p [] "Coming soon.")))) diff --git a/src/HL/V/Template.hs b/src/HL/V/Template.hs index bb7a383..4a195fd 100644 --- a/src/HL/V/Template.hs +++ b/src/HL/V/Template.hs @@ -6,10 +6,10 @@ module HL.V.Template where +import HL.Types import HL.V hiding (item) import Data.Monoid -import Data.Text (pack) import Yesod.Static (Static) -- | Render a template. @@ -38,7 +38,7 @@ skeleton ptitle innerhead innerbody mroute url = docTypeHtml (do head [] headinner body (maybe [] - (\route -> [class_ (toValue ("page-" <> routeToSlug route))]) + (\route -> [class_ (toValue ("page-" <> toSlug route))]) mroute) (do bodyinner analytics) @@ -113,7 +113,7 @@ navigation showBrand mroute url = where item route = li theclass (a [href (url route)] - (toHtml (routeToHuman route))) + (toHtml (toHuman route))) where theclass | Just route == mroute = [class_ "active"] | otherwise = [] @@ -139,43 +139,7 @@ bread url crumbs = (\route -> li [] (a [href (url route)] - (toHtml (routeToHuman route))))) - --- | Generate a human-readable string from a route. -routeToHuman :: Route App -> Text -routeToHuman r = - case r of - CommunityR -> "Community" - IrcR -> "IRC" - DocumentationR -> "Documentation" - HomeR -> "Home" - ReloadR -> "Reload" - MailingListsR -> "Mailing Lists" - NewsR -> "News" - StaticR{} -> "Static" - DownloadsR -> "Downloads" - WikiR t -> "Wiki: " <> t - ReportR i _ -> "Report " <> pack (show i) - ReportHomeR i -> "Report " <> pack (show i) - WikiHomeR{} -> "Wiki" - --- | Generate a slug string from a route. -routeToSlug :: Route App -> Text -routeToSlug r = - case r of - CommunityR -> "community" - IrcR -> "irc" - DocumentationR -> "documentation" - HomeR -> "home" - ReloadR -> "reload" - MailingListsR -> "mailing-lists" - NewsR -> "news" - StaticR{} -> "static" - DownloadsR -> "downloads" - WikiR{} -> "wiki" - ReportR{} -> "report" - ReportHomeR{} -> "report" - WikiHomeR{} -> "wiki" + (toHtml (toHuman route))))) -- | Set the background image for an element. background :: (Route App -> AttributeValue) -> Route Static -> Attribute diff --git a/static/markdown/downloads.md b/static/markdown/downloads.md index ca4a235..5b6176c 100644 --- a/static/markdown/downloads.md +++ b/static/markdown/downloads.md @@ -1,5 +1,13 @@ # Downloads +## Compiler and base libraries + +Downloads are available on a per operating system basis: + +* Windows +* OS X +* Linux + ## Package manager If you are using an operating system which has an up-to-date package