Start of downloads split off

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

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)

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 =
+getDownloadsR = senza downloadsV
-  markdownPage [] "Downloads" "downloads.md"
+
+-- | Downloads for particular OS.
+getDownloadsForR :: OS -> C Html
+getDownloadsForR = senza . downloadsForV

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"

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

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

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

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)

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."))))

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)))))
+                     (toHtml (toHuman 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"
 
 -- | Set the background image for an element.
 background :: (Route App -> AttributeValue) -> Route Static -> Attribute

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