Add landing page

.ghci

@@ -1,2 +1,3 @@
 :set -isrc
 :set -hide-package monads-tf
+:set -fno-warn-unused-do-bind

src/DevelMain.hs

@@ -21,7 +21,7 @@ main =
      ref <- newIORef app
      tid <- forkIO
               (runSettings
-                 (defaultSettings { settingsPort = 1990 })
+                 (setPort 1990 defaultSettings)
                  (\req ->
                     do handler <- readIORef ref
                        handler req))

src/HL/C/Home.hs

@@ -1,13 +1,10 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- | Home page controller.
 
 module HL.C.Home where
 
-import HL.C.Markdown
 import HL.C
+import HL.V.Home
 
 -- | Home controller.
 getHomeR :: C Html
-getHomeR =
+getHomeR = senza homeV
-  markdownPage [] "Home" "home.md"

src/HL/C/Wiki.hs

@@ -10,7 +10,7 @@ import HL.C
 import HL.M.Wiki
 import HL.V.Wiki
 
-import Prelude hiding (readFile,catch)
+import Prelude hiding (readFile)
 
 -- | Wiki home (no page specified).
 getWikiHomeR :: C Html

src/HL/M/Markdown.hs

@@ -8,9 +8,8 @@ import           HL.C
 import           HL.Types
 
 import           Control.Exception
-import qualified Data.Text.IO      as ST
+import qualified Data.Text.IO as ST
-import qualified Data.Text.Lazy    as L
+import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.IO as LT
 import           System.Directory
 import           System.FilePath
 import           Text.Markdown

src/HL/M/News.hs

@@ -10,7 +10,7 @@ import HL.C
 import Data.Text.Lazy.Encoding
 import Data.Text.Lazy (toStrict)
 import Network.HTTP.Conduit
-import Prelude hiding (readFile,catch)
+import Prelude hiding (readFile)
 
 getHaskellNews :: IO Html
 getHaskellNews =

src/HL/M/Wiki.hs

@@ -16,7 +16,7 @@ import Data.Monoid
 import Data.Text (unpack)
 
 import Network.HTTP.Conduit
-import Prelude hiding (readFile,catch)
+import Prelude hiding (readFile)
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.MediaWiki

src/HL/V/Code.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Code highlighting.
+
+module HL.V.Code where
+
+import HL.V
+
+import Data.Text (unpack)
+import Language.Haskell.HsColour.CSS (hscolour)
+import Prelude hiding (readFile)
+import Text.Blaze.Html
+
+-- | Some syntax-highlighted code.
+haskellPre :: Text -> Senza
+haskellPre = preEscapedToHtml . hscolour False . unpack
+
+-- | Some syntax-highlighted code.
+haskellCode :: Text -> Senza
+haskellCode = preEscapedToHtml . preToCode . hscolour False . unpack
+
+-- | Convert a <pre> tag code sample to <code>.
+preToCode :: [Char] -> [Char]
+preToCode = codeEl . stripCPre . stripPre
+  where stripPre ('<':'p':'r':'e':'>':xs) = xs
+        stripPre xs = xs
+        stripCPre (reverse -> ('<':'/':'p':'r':'e':'>':xs)) = reverse xs
+        stripCPre xs = xs
+        codeEl xs = "<code>" ++ xs ++ "</code>"

src/HL/V/Home.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Home/landing page.
+
+module HL.V.Home where
+
+import HL.V hiding (list)
+import HL.V.Code
+import HL.V.Template
+
+-- | Home view.
+homeV :: FromSenza App
+homeV =
+  skeleton
+    "Haskell Programming Language"
+    (\_ url ->
+       do navigation False Nothing url
+          header url
+          try
+          community url
+          features
+          events)
+
+header :: (Route App -> AttributeValue) -> Senza
+header url =
+  div [class_ "header"]
+      (container
+         (row
+            (do div [class_ "span6 col-md-6"]
+                    (div [class_ "branding"]
+                         (do branding
+                             summation))
+                div [class_ "span6 col-md-6"]
+                    (div [class_ "branding"]
+                         (do tag
+                             sample)))))
+  where branding =
+          span [class_ "name"
+               ,background url img_logo_png]
+               "Haskell"
+        summation =
+          span [class_ "summary"]
+               "An advanced purely-functional programming language"
+        tag =
+          span [class_ "tag"]
+               "Natural, declarative, statically typed code."
+        sample = div [class_ "code-sample"]
+                     (haskellPre codeSample)
+
+codeSample :: Text
+codeSample =
+  "primes = sieve [2..]\n\
+  \    where sieve (p:xs) = \n\
+  \      p : sieve [x | x <- xs, x `mod` p /= 0]"
+
+try :: Senza
+try =
+  div [class_ "try"]
+      (container
+         (row
+            (do div [class_ "span6 col-md-6"] repl
+                div [class_ "span6 col-md-6"] rhs)))
+  where
+    repl =
+      do h2 [] "Try it"
+         p [class_ "muted"] "Coming soon."
+    rhs =
+      do h2 [] "Got 5 minutes?"
+         p [] (do "Type "
+                  span [class_ "highlight"]
+                       "help"
+                  " to start an interactive tutorial.")
+         p [] "Or try typing these out and see what happens (click to insert):"
+         p [] (do haskellCode "23 * 36"
+                  " or "
+                  haskellCode "reverse \"hello\""
+                  " or"
+                  haskellCode "foldr (:) [] [1,2,3]"
+                  " or "
+                  haskellCode "do line <- getLine; putStrLn line or readFile \"/welcome\"")
+         p [] (do a [href "https://hackage.haskell.org/package/pure-io-0.2.0/docs/PureIO.html#g:2"]
+                    "These"
+                  " IO actions are supported in this app.")
+
+community :: (Route App -> AttributeValue) -> Senza
+community url =
+  div [class_ "community"
+      ,background url img_community_png]
+      (do container
+            (do row
+                  (div [class_ "span8 col-md-8"]
+                       (do h1 []
+                              "An open source community effort for over 20 years"
+                           p [class_ "learn-more"]
+                             (a [href (url CommunityR)]
+                                "Learn more")))))
+
+features :: Senza
+features =
+  div [class_ "features"]
+      (container
+         (do h1 [] "Features"
+             row (do div [class_ "span6 col-md-6"]
+                         (do h2 [] "Purely functional"
+                             p [] lorem
+                             p [] (a [] "View examples"))
+                     div [class_ "span6 col-md-6"]
+                         (do h2 [] "Statically typed"
+                             p [] lorem
+                             p [] (a [] "View examples")))
+             row (do div [class_ "span6 col-md-6"]
+                         (do h2 [] "Concurrent"
+                             p [] lorem
+                             p [] (a [] "View examples"))
+                     div [class_ "span6 col-md-6"]
+                         (do h2 [] "Type inference"
+                             p [] lorem
+                             p [] (a [] "View examples")))
+             row (do div [class_ "span6 col-md-6"]
+                         (do h2 [] "Lazy"
+                             p [] lorem
+                             p [] (a [] "View examples"))
+                     div [class_ "span6 col-md-6"]
+                         (do h2 [] "Packages"
+                             p [] lorem
+                             p [] (a [] "View examples")))))
+  where
+    lorem =
+      "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean viverra nisl non elit consectetur sodales. Ut condimentum odio in augue scelerisque, eget ultricies arcu placerat. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Mauris a blandit purus, vitae tincidunt leo. "
+
+events :: Senza
+events =
+  return ()

src/HL/V/Template.hs

@@ -8,7 +8,6 @@ module HL.V.Template where
 
 import HL.V hiding (item)
 
-import Data.Maybe
 import Data.Monoid
 import Data.Text (pack)
 import Yesod.Static (Static)
@@ -23,9 +22,10 @@ template crumbs ptitle inner =
   skeleton
     ptitle
     (\cur url ->
-       do navigation True cur url
+       div [class_ "template"]
-          container (bread url crumbs)
+           (do navigation True cur url
-          inner url)
+               container (bread url crumbs)
+               inner url))
 
 -- | Render the basic site skeleton.
 skeleton
@@ -112,6 +112,7 @@ navigation showBrand mroute url =
 
 -- | The logo character in the right font. Style it with an additional
 -- class or wrapper as you wish.
+logo :: Senza
 logo =
   span [class_ "logo"]
        "\xe000"
@@ -157,7 +158,12 @@ routeToSlug r =
     NewsR          -> "news"
     StaticR{}      -> "static"
     DownloadsR     -> "downloads"
-    WikiR t        -> "wiki"
+    WikiR{}        -> "wiki"
-    ReportR i _    -> "report"
+    ReportR{}      -> "report"
-    ReportHomeR i  -> "report"
+    ReportHomeR{}  -> "report"
     WikiHomeR{}    -> "wiki"
+
+-- | Set the background image for an element.
+background :: (Route App -> AttributeValue) -> Route Static -> Attribute
+background url route =
+  style ("background-image: url(" <> url (StaticR route) <> ")")

src/HL/V/Wiki.hs

@@ -7,12 +7,13 @@
 module HL.V.Wiki where
 
 import HL.V
+import HL.V.Code
 import HL.V.Template
 
 import Data.List (isPrefixOf)
 import Data.Text (unpack,pack)
 import Language.Haskell.HsColour.CSS (hscolour)
-import Prelude hiding (readFile,catch)
+import Prelude hiding (readFile)
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Walk
@@ -62,10 +63,5 @@ highlightBlock = walk codes
 highlightInline :: Pandoc -> Pandoc
 highlightInline = walk codes
   where codes (Code ("",["haskell"],[]) text) =
-          RawInline "html" (codeEl (stripCPre (stripPre (hscolour False text))))
+          RawInline "html" (preToCode (hscolour False text))
         codes x = x
-        stripPre ('<':'p':'r':'e':'>':xs) = xs
-        stripPre xs = xs
-        stripCPre (reverse -> ('<':'/':'p':'r':'e':'>':xs)) = reverse xs
-        stripCPre xs = xs
-        codeEl xs = "<code>" ++ xs ++ "</code>"

static/css/hl.css

@@ -1,3 +1,7 @@
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+   Global styles
+   */
+
 html {
   position:relative;
   min-height:100%;
@@ -30,24 +34,10 @@ h2 {
   color:#6e618d;
 }
 
-.container > .row {
-  margin-left:0;
-  margin-right:0;
-  max-width:none;
-}
-
-.breadcrumb {
-  margin-left:0;
-  padding-left:0;
-  background-color:inherit;
-  margin-bottom:0;
-}
-
 .navbar {
   background-color:#352f44;
   border-radius:0;
   border:0;
-  margin-bottom:.5em;
 }
 
 .navbar-header .navbar-brand {
@@ -101,21 +91,67 @@ h2 {
   font-size:13px;
 }
 
-code {
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-  background-color:#f5f5f5;
+   Template
-  color:#366354;
+   */
+
+.template .navbar {
+  margin-bottom:.5em;
 }
 
-pre {
+.template code {
-  font-size:14px;
+  background-color:#f5f5f5;
+  color:#366354;
+  font-family: monospace;
 }
 
+.template pre {
+  font-size:14px;
+  font-family: monospace;
+}
+
+.template .container > .row {
+  margin-left:0;
+  margin-right:0;
+  max-width:none;
+}
+
+.template .breadcrumb {
+  margin-left:0;
+  padding-left:0;
+  background-color:inherit;
+  margin-bottom:0;
+}
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+   News page
+   */
+
 .page-news .span6 {
   padding-left:0;
 }
 
-.landing-header {
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-  height: 30em;
+   Home page
+   */
+
+.page-home .navbar-collapse {
+  margin-left: -30px;
+}
+
+.page-home .navbar {
+  margin-bottom:0;
+  background: #150e1a; /* Old browsers */
+  background: -moz-linear-gradient(left, #150e1a 0%, #22172a 100%); /* FF3.6+ */
+  background: -webkit-gradient(linear, left top, right top, color-stop(0%,#150e1a), color-stop(100%,#22172a)); /* Chrome,Safari4+ */
+  background: -webkit-linear-gradient(left, #150e1a 0%,#22172a 100%); /* Chrome10+,Safari5.1+ */
+  background: -o-linear-gradient(left, #150e1a 0%,#22172a 100%); /* Opera 11.10+ */
+  background: -ms-linear-gradient(left, #150e1a 0%,#22172a 100%); /* IE10+ */
+  background: linear-gradient(to right, #150e1a 0%,#22172a 100%); /* W3C */
+  filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#150e1a', endColorstr='#22172a',GradientType=1 ); /* IE6-9 */
+}
+
+.page-home .header {
   color: #fff;
   background: #19111f; /* Old browsers */
   background: -moz-linear-gradient(left, #19111f 0%, #2c1e37 100%); /* FF3.6+ */
@@ -126,3 +162,126 @@ pre {
   background: linear-gradient(to right, #19111f 0%,#2c1e37 100%); /* W3C */
   filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#19111f', endColorstr='#2c1e37',GradientType=1 ); /* IE6-9 */
 }
+
+.page-home .header .branding {
+  margin-top: 50px;
+}
+
+.page-home .header {
+  padding-bottom: 40px;
+}
+
+.page-home .header .branding .name {
+  display: block;
+  font-size: 50px;
+  font-family: ubuntu;
+  line-height: 50px;
+  padding-left: 80px;
+  font-family: ubuntu;
+  font-weight: bold;
+  background-position: left;
+  background-repeat: no-repeat;
+  background-size: 70px;
+}
+
+.page-home .header .branding .summary {
+  margin-top: 20px;
+  display: block;
+  font-size: 20px;
+}
+
+.page-home .header .branding .tag {
+  display: block;
+  font-size: 30px;
+}
+
+.page-home .header .code-sample pre {
+  background: inherit;
+  border: 0;
+  font-family: monospace;
+}
+
+.page-home .header .code-sample * {
+  color: #c3c3c3;
+}
+
+.page-home .header .code-sample .hs-definition {
+  color: #9ec7e9;
+}
+
+.page-home .header .code-sample .hs-num {
+  color: #c3a6e0;
+}
+
+.page-home .header .code-sample .hs-keyword {
+  color: #fff;
+}
+
+.page-home .header .code-sample .hs-layout,
+.page-home .header .code-sample .hs-keyglyph {
+  color: #4c4c4c;
+}
+
+.page-home .muted {
+  opacity: 0.6;
+}
+
+.page-home .try {
+  margin-top: 10px;
+  margin-bottom: 30px;
+}
+
+.page-home .try code * {
+  background: inherit;
+}
+
+.page-home .try code {
+  background-color: #f7f7f9;
+  color: #366354;
+  border: 1px solid #e1e1e8;
+}
+
+.page-home .try h2 {
+  font-size: 25px;
+  color: #000;
+  margin-bottom: 20px;
+}
+
+.page-home .community {
+  margin-top: 30px;
+  padding-top: 40px;
+  background-repeat: no-repeat;
+  background-position: center;
+  -webkit-background-size: cover;
+  -moz-background-size: cover;
+  -o-background-size: cover;
+  background-size: cover;
+}
+
+.page-home .community h1 {
+  color: #fff;
+  text-shadow: 0px 0px 10px #555;
+}
+
+.page-home .community .learn-more {
+  margin-top: 80px;
+  margin-bottom: 40px;
+}
+
+.page-home .community .learn-more a {
+  color: #fff;
+}
+
+.page-home .features h1 {
+  margin-top: 40px;
+}
+
+.page-home .features h2 {
+  font-size: 25px;
+  margin-bottom: 0.7em;
+  color: #222;
+}
+
+.page-home .features {
+  margin-bottom: 40px;
+}