diff --git a/.ghci b/.ghci index 82fed62..cc98a31 100755 --- a/.ghci +++ b/.ghci @@ -1,2 +1,3 @@ :set -isrc :set -hide-package monads-tf +:set -fno-warn-unused-do-bind diff --git a/src/DevelMain.hs b/src/DevelMain.hs index b635241..a72d5c5 100644 --- a/src/DevelMain.hs +++ b/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)) diff --git a/src/HL/C/Home.hs b/src/HL/C/Home.hs index df0a5fb..5a28ecf 100644 --- a/src/HL/C/Home.hs +++ b/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 = - markdownPage [] "Home" "home.md" +getHomeR = senza homeV diff --git a/src/HL/C/Wiki.hs b/src/HL/C/Wiki.hs index ed87b2f..6b790ed 100644 --- a/src/HL/C/Wiki.hs +++ b/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 diff --git a/src/HL/M/Markdown.hs b/src/HL/M/Markdown.hs index 8a035a7..d67c954 100644 --- a/src/HL/M/Markdown.hs +++ b/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.Lazy as L -import qualified Data.Text.Lazy.IO as LT +import qualified Data.Text.IO as ST +import qualified Data.Text.Lazy as L import System.Directory import System.FilePath import Text.Markdown diff --git a/src/HL/M/News.hs b/src/HL/M/News.hs index bb0a025..8cbccd4 100644 --- a/src/HL/M/News.hs +++ b/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 = diff --git a/src/HL/M/Wiki.hs b/src/HL/M/Wiki.hs index cf364b6..af674e0 100644 --- a/src/HL/M/Wiki.hs +++ b/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 diff --git a/src/HL/V/Code.hs b/src/HL/V/Code.hs new file mode 100644 index 0000000..19df1c2 --- /dev/null +++ b/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
 tag code sample to .
+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 = "" ++ xs ++ ""
diff --git a/src/HL/V/Home.hs b/src/HL/V/Home.hs
new file mode 100644
index 0000000..52c719f
--- /dev/null
+++ b/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 ()
diff --git a/src/HL/V/Template.hs b/src/HL/V/Template.hs
index a0b57ab..70a98cc 100644
--- a/src/HL/V/Template.hs
+++ b/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
-          container (bread url crumbs)
-          inner url)
+       div [class_ "template"]
+           (do navigation True cur 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"
-    ReportR i _    -> "report"
-    ReportHomeR i  -> "report"
+    WikiR{}        -> "wiki"
+    ReportR{}      -> "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) <> ")")
diff --git a/src/HL/V/Wiki.hs b/src/HL/V/Wiki.hs
index eee6982..dbd0f0e 100644
--- a/src/HL/V/Wiki.hs
+++ b/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 = "" ++ xs ++ ""
diff --git a/static/css/hl.css b/static/css/hl.css
index 45b726a..ce16fe6 100644
--- a/static/css/hl.css
+++ b/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;
-  color:#366354;
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+   Template
+   */
+
+.template .navbar {
+  margin-bottom:.5em;
 }
 
-pre {
-  font-size:14px;
+.template code {
+  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;
+}
diff --git a/static/img/community.png b/static/img/community.png
new file mode 100644
index 0000000..8653d9f
Binary files /dev/null and b/static/img/community.png differ
diff --git a/static/img/logo.png b/static/img/logo.png
new file mode 100644
index 0000000..ac4162e
Binary files /dev/null and b/static/img/logo.png differ