Merge pull request #23 from srid/add-real-example

Add real example

README.md

@@ -5,13 +5,15 @@ Credit for this image: https://www.svgrepo.com/svg/24439/ribs
 -->
 <img src="https://raw.githubusercontent.com/srid/rib/master/example/a/static/ribs.svg?sanitize=true" width="150" />
 
-Rib is a static site generator written in Haskell that reuses existing tools (`Shake`, `Lucid` and `Clay`) and is thus non-monolithic. It is nearly done but still a work in progress and will soon be ready for general use.
+Rib is a static site generator written in Haskell that reuses existing tools
+(`Shake`, `Lucid` and `Clay`) and is thus non-monolithic. It is nearly done but
+still a work in progress and will soon be ready for general use.
 
 ## Example
 
-See `./example` (Rib's project site in fact) to see how the `Rib` library
-can be used to write your own static site generator in a few lines of code which
-includes the HTML and CSS of the site:
+See `./example` to see how the `Rib` library can be used to write your own
+static site generator in a few lines of code which includes the HTML and CSS of
+the site:
 
 ```
 $ cloc --by-file example/Main.hs
@@ -19,15 +21,19 @@ $ cloc --by-file example/Main.hs
 -------------------------------------------------------------------------------
 File                             blank        comment           code
 -------------------------------------------------------------------------------
-example/Main.hs                     14              5             86
+example/Main.hs                     10              3             45
 -------------------------------------------------------------------------------
 ```
 
-(See `Rib.Simple` if you need further customization.)
+See `./doc` for a real-world example---Rib's own documentation site.
+
+(Refer to `Rib.Simple` if you need further customization of the Shake action.)
 
 With Rib you do not have to deal with less powerful template engines or
 write raw HTML/CSS by hand. Do everything in Haskell, and concisely at that!
 
+---
+
 To get the example site up and running run:
 
 ```bash

doc/Main.hs

@@ -0,0 +1,125 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main where
+
+import Prelude hiding (div, (**))
+
+import Control.Monad
+import Data.Aeson
+import qualified Data.ByteString.Lazy as BSL
+import Data.Functor ((<&>))
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+
+
+import Clay hiding (type_)
+import Development.Shake
+import Development.Shake.FilePath
+import Lucid
+
+import qualified Rib.App as App
+import Rib.Pandoc (getPandocMetaHTML, highlightingCss, pandoc2Html, parsePandoc)
+import Rib.Server (getHTMLFileUrl)
+import Rib.Simple (Page (..), Post (..), isDraft)
+import qualified Rib.Simple as Simple
+
+main :: IO ()
+main = App.run buildAction
+
+buildAction :: Action ()
+buildAction = do
+  toc <- guideToc
+  void $ Simple.buildStaticFiles ["static//**"]
+  posts <- Simple.buildPostFiles ["*.md"] renderPage
+  let postMap = Map.fromList $ posts <&> \post -> (_post_srcPath post, post)
+  guidePosts <- forM toc $ \slug -> maybe (fail "slug not found") pure $
+    Map.lookup slug postMap
+  Simple.buildIndex guidePosts renderPage
+
+guideToc :: Action [FilePath]
+guideToc = do
+  toc :: Maybe [FilePath] <- fmap (decode . BSL.fromStrict . encodeUtf8 . T.pack) $
+    readFile' $ App.ribInputDir </> "guide.json"
+  pure $ fromMaybe (fail "bad guide.json") toc
+
+renderPage :: Page -> Html ()
+renderPage page = with html_ [lang_ "en"] $ do
+  head_ $ do
+    meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]
+    meta_ [name_ "description", content_ "Rib - Haskell static site generator"]
+    meta_ [name_ "author", content_ "Sridhar Ratnakumar"]
+    meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"]
+    title_ $ maybe siteTitle (<> " - " <> siteTitle) pageTitle
+    style_ [type_ "text/css"] $ Clay.render pageStyle
+    style_ [type_ "text/css"] highlightingCss
+    link_ [rel_ "stylesheet", href_ "https://cdn.jsdelivr.net/npm/semantic-ui@2.4.2/dist/semantic.min.css"]
+  body_ $ do
+    with div_ [class_ "ui text container", id_ "thesite"] $
+      with div_ [class_ "ui raised segment"] $ do
+        with a_ [class_ "ui violet ribbon label", href_ "/"] "Rib"
+        -- Main content
+        with h1_ [class_ "ui huge header"] $ fromMaybe siteTitle pageTitle
+        with div_ [class_ "ui note message"] $ pandoc2Html $ parsePandoc
+          "Please note: Rib is still a **work in progress**. The API might change before the initial public release. The content you read here should be considered draft version of the upcoming documentation."
+        case page of
+          Page_Index posts -> do
+            p_ "Rib is a static site generator written in Haskell that reuses existing tools (Shake, Lucid and Clay) and is thus non-monolithic."
+            with div_ [class_ "ui relaxed divided list"] $ forM_ posts $ \x ->
+              with div_ [class_ "item"] $ do
+                with a_ [class_ "header", href_ (getHTMLFileUrl $ _post_srcPath x)] $
+                  postTitle x
+                small_ $ fromMaybe mempty $ getPandocMetaHTML "description" $ _post_doc x
+          Page_Post post -> do
+            when (isDraft post) $
+              with div_ [class_ "ui warning message"] "This is a draft"
+            with article_ [class_ "post"] $
+              pandoc2Html $ _post_doc post
+        with a_ [class_ "ui green right ribbon label", href_ "https://github.com/srid/rib"] "Github"
+    -- Load Google fonts at the very end for quicker page load.
+    forM_ googleFonts $ \f ->
+      link_ [href_ $ "https://fonts.googleapis.com/css?family=" <> T.replace " " "+" f, rel_ "stylesheet"]
+
+  where
+    siteTitle = "Rib - Haskell static site generator"
+    pageTitle = case page of
+      Page_Index _ -> Nothing
+      Page_Post post -> Just $ postTitle post
+
+    -- Render the post title (Markdown supported)
+    postTitle = fromMaybe "Untitled" . getPandocMetaHTML "title" . _post_doc
+
+    -- | CSS
+    pageStyle :: Css
+    pageStyle = div # "#thesite" ? do
+      marginTop $ em 1
+      marginBottom $ em 2
+      fontFamily [contentFont] [sansSerif]
+      forM_ [h1, h2, h3, h4, h5, h6, ".header"] $ \sel -> sel ?
+        fontFamily [headerFont] [sansSerif]
+      forM_ [pre, code, "tt"] $ \sel -> sel ? do
+        fontFamily [codeFont] [monospace]
+      "div.sourceCode" ? do
+        sym padding $ em 1
+        backgroundColor "#EBF5FB"
+      h1 ? textAlign center
+      (article ** h2) ? color darkviolet
+      (article ** img) ? do
+        display block
+        marginLeft auto
+        marginRight auto
+        width $ pct 50
+      footer ? textAlign center
+
+    googleFonts :: [Text]
+    googleFonts = [headerFont, contentFont, codeFont]
+
+    headerFont :: Text
+    headerFont = "Roboto"
+    contentFont :: Text
+    contentFont = "Literata"
+    codeFont :: Text
+    codeFont = "Inconsolata"

doc/a/getting-started.md

@@ -10,7 +10,7 @@ be under directory `b`).
 
 
 ```bash
-mkdir -p mysite/a/static
+mkdir -p mysite/a mysite/b
 cd mysite
 ```
 
@@ -51,29 +51,37 @@ import Prelude hiding (div, (**))
 import Control.Monad
 
 import Clay hiding (type_)
+import Development.Shake
 import Lucid
 
 import qualified Rib.App as App
 import Rib.Pandoc (getPandocMetaHTML, highlightingCss, pandoc2Html)
+import Rib.Server (getHTMLFileUrl)
 import Rib.Simple (Page (..), Post (..), isDraft)
 import qualified Rib.Simple as Simple
 
 main :: IO ()
-main = App.run $ Simple.buildAction renderPage
+main = App.run buildAction
+
+buildAction :: Action ()
+buildAction = Simple.buildAction renderPage
 
 renderPage :: Page -> Html ()
 renderPage page = with html_ [lang_ "en"] $ do
   head_ $ do
+    meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]
     title_ pageTitle
     style_ [type_ "text/css"] $ Clay.render pageStyle
     style_ [type_ "text/css"] highlightingCss
-  body_ $ do
+  body_ $
     with div_ [id_ "thesite"] $ do
       -- Main content
       h1_ pageTitle
       case page of
         Page_Index posts ->
-          postList posts
+          div_ $ forM_ posts $ \post -> div_ $ do
+            with a_ [href_ (getHTMLFileUrl $ _post_srcPath post)] $ postTitle post
+            small_ $ maybe mempty toHtmlRaw $ getPandocMetaHTML "description" $ _post_doc post
         Page_Post post -> do
           when (isDraft post) $
             div_ "This is a draft"
@@ -87,17 +95,11 @@ renderPage page = with html_ [lang_ "en"] $ do
     -- Render the post title (Markdown supported)
     postTitle = maybe "Untitled" toHtmlRaw . getPandocMetaHTML "title" . _post_doc
 
-    -- Render a list of posts
-    postList :: [Post] -> Html ()
-    postList xs = div_ $ forM_ xs $ \x -> div_ $ do
-      with a_ [href_ (_post_url x)] $ postTitle x
-      small_ $ maybe mempty toHtmlRaw $ getPandocMetaHTML "description" $ _post_doc x
-
     -- | CSS
     pageStyle :: Css
     pageStyle = div # "#thesite" ? do
-      marginTop $ em 1
-      marginBottom $ em 2
+      marginLeft $ pct 20
+      marginTop $ em 4
 ```
 
 Include the `rib` library in your repo, install Nix and invoke the ghcid script:

example/Main.hs

@@ -1,28 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 module Main where
 
 import Prelude hiding (div, (**))
 
 import Control.Monad
-import Data.Aeson
-import qualified Data.ByteString.Lazy as BSL
-import Data.Functor ((<&>))
-import qualified Data.Map as Map
-import Data.Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
-
 
 import Clay hiding (type_)
 import Development.Shake
-import Development.Shake.FilePath
 import Lucid
 
 import qualified Rib.App as App
-import Rib.Pandoc (getPandocMetaHTML, highlightingCss, pandoc2Html, parsePandoc)
+import Rib.Pandoc (getPandocMetaHTML, highlightingCss, pandoc2Html)
 import Rib.Server (getHTMLFileUrl)
 import Rib.Simple (Page (..), Post (..), isDraft)
 import qualified Rib.Simple as Simple
@@ -31,95 +20,39 @@ main :: IO ()
 main = App.run buildAction
 
 buildAction :: Action ()
-buildAction = do
-  toc <- guideToc
-  void $ Simple.buildStaticFiles ["static//**"]
-  posts <- Simple.buildPostFiles ["*.md"] renderPage
-  let postMap = Map.fromList $ posts <&> \post -> (_post_srcPath post, post)
-  guidePosts <- forM toc $ \slug -> maybe (fail "slug not found") pure $
-    Map.lookup slug postMap
-  Simple.buildIndex guidePosts renderPage
-
-guideToc :: Action [FilePath]
-guideToc = do
-  toc :: Maybe [FilePath] <- fmap (decode . BSL.fromStrict . encodeUtf8 . T.pack) $
-    readFile' $ App.ribInputDir </> "guide.json"
-  pure $ fromMaybe (fail "bad guide.json") toc
+buildAction = Simple.buildAction renderPage
 
 renderPage :: Page -> Html ()
 renderPage page = with html_ [lang_ "en"] $ do
   head_ $ do
     meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]
-    meta_ [name_ "description", content_ "Rib - Haskell static site generator"]
-    meta_ [name_ "author", content_ "Sridhar Ratnakumar"]
-    meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"]
-    title_ $ maybe siteTitle (<> " - " <> siteTitle) pageTitle
+    title_ pageTitle
     style_ [type_ "text/css"] $ Clay.render pageStyle
     style_ [type_ "text/css"] highlightingCss
-    link_ [rel_ "stylesheet", href_ "https://cdn.jsdelivr.net/npm/semantic-ui@2.4.2/dist/semantic.min.css"]
-  body_ $ do
-    with div_ [class_ "ui text container", id_ "thesite"] $
-      with div_ [class_ "ui raised segment"] $ do
-        with a_ [class_ "ui violet ribbon label", href_ "/"] "Rib"
-        -- Main content
-        with h1_ [class_ "ui huge header"] $ fromMaybe siteTitle pageTitle
-        with div_ [class_ "ui note message"] $ pandoc2Html $ parsePandoc
-          "Please note: Rib is still a **work in progress**. The API might change before the initial public release. The content you read here should be considered draft version of the upcoming documentation."
-        case page of
-          Page_Index posts -> do
-            p_ "Rib is a static site generator written in Haskell that reuses existing tools (Shake, Lucid and Clay) and is thus non-monolithic."
-            with div_ [class_ "ui relaxed divided list"] $ forM_ posts $ \x ->
-              with div_ [class_ "item"] $ do
-                with a_ [class_ "header", href_ (getHTMLFileUrl $ _post_srcPath x)] $
-                  postTitle x
-                small_ $ fromMaybe mempty $ getPandocMetaHTML "description" $ _post_doc x
-          Page_Post post -> do
-            when (isDraft post) $
-              with div_ [class_ "ui warning message"] "This is a draft"
-            with article_ [class_ "post"] $
-              pandoc2Html $ _post_doc post
-        with a_ [class_ "ui green right ribbon label", href_ "https://github.com/srid/rib"] "Github"
-    -- Load Google fonts at the very end for quicker page load.
-    forM_ googleFonts $ \f ->
-      link_ [href_ $ "https://fonts.googleapis.com/css?family=" <> T.replace " " "+" f, rel_ "stylesheet"]
-
+  body_ $
+    with div_ [id_ "thesite"] $ do
+      -- Main content
+      h1_ pageTitle
+      case page of
+        Page_Index posts ->
+          div_ $ forM_ posts $ \post -> div_ $ do
+            with a_ [href_ (getHTMLFileUrl $ _post_srcPath post)] $ postTitle post
+            small_ $ maybe mempty toHtmlRaw $ getPandocMetaHTML "description" $ _post_doc post
+        Page_Post post -> do
+          when (isDraft post) $
+            div_ "This is a draft"
+          with article_ [class_ "post"] $
+            toHtmlRaw $ pandoc2Html $ _post_doc post
   where
-    siteTitle = "Rib - Haskell static site generator"
     pageTitle = case page of
-      Page_Index _ -> Nothing
-      Page_Post post -> Just $ postTitle post
+      Page_Index _ -> "My website!"
+      Page_Post post -> postTitle post
 
     -- Render the post title (Markdown supported)
-    postTitle = fromMaybe "Untitled" . getPandocMetaHTML "title" . _post_doc
+    postTitle = maybe "Untitled" toHtmlRaw . getPandocMetaHTML "title" . _post_doc
 
     -- | CSS
     pageStyle :: Css
     pageStyle = div # "#thesite" ? do
-      marginTop $ em 1
-      marginBottom $ em 2
-      fontFamily [contentFont] [sansSerif]
-      forM_ [h1, h2, h3, h4, h5, h6, ".header"] $ \sel -> sel ?
-        fontFamily [headerFont] [sansSerif]
-      forM_ [pre, code, "tt"] $ \sel -> sel ? do
-        fontFamily [codeFont] [monospace]
-      "div.sourceCode" ? do
-        sym padding $ em 1
-        backgroundColor "#EBF5FB"
-      h1 ? textAlign center
-      (article ** h2) ? color darkviolet
-      (article ** img) ? do
-        display block
-        marginLeft auto
-        marginRight auto
-        width $ pct 50
-      footer ? textAlign center
-
-    googleFonts :: [Text]
-    googleFonts = [headerFont, contentFont, codeFont]
-
-    headerFont :: Text
-    headerFont = "Roboto"
-    contentFont :: Text
-    contentFont = "Literata"
-    codeFont :: Text
-    codeFont = "Inconsolata"
+      marginLeft $ pct 20
+      marginTop $ em 4

example/a/first-post.md

@@ -0,0 +1,10 @@
+---
+title: Hello World
+---
+
+Welcome to your [`Rib`](https://rib.srid.ca) generated site.
+
+> Be totally sincere ... most definitely utterly sincere, as genuineness is essential. But serious ... no way
+
+--*Someone free*
+

example/a/second-post.md

@@ -0,0 +1,7 @@
+---
+title: Eat meat
+---
+
+**Meat** has a bad reputation.  Most people think of meat, especially red meat, as dangerously unhealthy. However, meat has unique properties that make it *more nutritious, easier to digest, and less likely to irritate your body* than **vegetables**. Does the science behind meat-phobia hold up under the microscope?
+
+[Read more](http://www.diagnosisdiet.com/food/meats/), by Georgia Ede MD.

src/Rib/Simple.hs

@@ -12,6 +12,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.ByteString.Char8 as BSC
 import Data.Maybe
 import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
 import GHC.Generics (Generic)
 
 import Development.Shake
@@ -86,7 +87,7 @@ buildIndex posts renderPage = do
 
 readPage :: FilePath -> Action Page
 readPage f = do
-  doc <- parsePandoc . T.decodeUtf8 . BSC.pack <$> readFile' (ribInputDir </> f)
+  doc <- parsePandoc . T.decodeUtf8With T.lenientDecode . BSC.pack <$> readFile' (ribInputDir </> f)
   pure $ Page_Post $ Post doc f
 
 writePage :: MonadIO m => (Page -> Html ()) -> FilePath -> Page -> m ()