Cleanup and refactor

CHANGELOG.md

@@ -2,12 +2,13 @@
 
 ## 0.5.0.0 (UNRELEASED)
 
-This release comes with major API refactor. Key changes:
+This release comes with a major API refactor. Key changes:
 
-- Support for both Pandoc and MMark parsers
-- Add `Rib.Markup.Markup` type class to polymorphically select the parser
-- Add top-level `Rib` import namespace to ease of use
-- Replace complex metadata handling using straightforward aeson `Value` parsing
+- Added MMark support, as an alternative to Pandoc
+- Allows using arbitrary records to load metadata
+  - This replaces the previous complex metadata API
+- Added `Document` type that uses the custom metadata record
+- Add top-level `Rib` import namespace for ease of use
 - Remove the following:
   - JSON cache
   - `Rib.Simple`
@@ -17,6 +18,7 @@ Other changes:
 
 - Use type-safe path types using the [path](http://hackage.haskell.org/package/path) library.
 - Fix #40: Gracefully handle rendering/ parsing errors, without dying.
+- Misc error reporting improvements
 
 ## 0.4.1.0
 

README.md

@@ -31,15 +31,19 @@ using Rib:
 -- itself. Second, the metadata associated with each document.
 
 -- | A generated page is either an index of documents, or an individual document.
-data Page doc
-  = Page_Index [Document doc]
-  | Page_Doc (Document doc)
+--
+-- The `Document` type takes two type variables:
+-- 1. The first type variable specifies the parser to use: MMark or Pandoc
+-- 2. The second type variable should be your metadata record
+data Page
+  = Page_Index [Document MMark DocMeta]
+  | Page_Doc (Document MMark DocMeta)
 
 -- | Type representing the metadata in our Markdown documents
 --
 -- Note that if a field is not optional (i.e., not Maybe) it must be present.
-data Meta
-  = Meta
+data DocMeta
+  = DocMeta
       { title :: Text,
         description :: Maybe Text
       }
@@ -60,51 +64,46 @@ main = Rib.run [reldir|a|] [reldir|b|] $ do
   -- Copy over the static files
   Rib.buildStaticFiles [[relfile|static/**|]]
   -- Build individual markdown files, generating .html for each.
-  --
-  -- NOTE: We use TypeApplications to specify the type of the `doc` type
-  -- variable, as used in the `Markup doc` constraint in the functions below.
-  -- There are currently two possible values: `MMark` (if you choose to use the
-  -- `mmark` parser) and `Pandoc` (if using pandoc).
-  posts <- Rib.buildHtmlMulti @MMark [relfile|*.md|] (renderPage . Page_Doc)
+  posts <- Rib.buildHtmlMulti [relfile|*.md|] (renderPage . Page_Doc)
   -- Build an index.html linking to the aforementioned files.
   Rib.buildHtml [relfile|index.html|]
     $ renderPage
     $ Page_Index posts
   where
     -- Define your site HTML here
-    renderPage :: Markup doc => Page doc -> Html ()
+    renderPage :: Page -> Html ()
     renderPage page = with html_ [lang_ "en"] $ do
       head_ $ do
         meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]
         title_ $ case page of
           Page_Index _ -> "My website!"
-          Page_Doc doc -> toHtml $ title $ Rib.getDocumentMeta doc
+          Page_Doc doc -> toHtml $ title $ Rib._document_meta doc
         style_ [type_ "text/css"] $ Clay.render pageStyle
       body_
         $ with div_ [id_ "thesite"]
         $ do
-          -- Main content
           with a_ [href_ "/"] "Back to Home"
           hr_ []
           case page of
             Page_Index docs ->
-              div_ $ forM_ docs $ \doc -> li_ $ do
-                let meta = Rib.getDocumentMeta doc
+              div_ $ forM_ docs $ \doc -> with li_ [class_ "links"] $ do
+                let meta = Rib._document_meta doc
                 b_ $ with a_ [href_ (Rib.getDocumentUrl doc)] $ toHtml $ title meta
-                case description meta of
-                  Just s -> em_ $ small_ $ toHtml s
-                  Nothing -> mempty
+                maybe mempty Rib.renderMarkdown $
+                  description meta
             Page_Doc doc ->
               with article_ [class_ "post"] $ do
-                h1_ $ toHtml $ title $ Rib.getDocumentMeta doc
-                Rib.renderDoc doc
+                h1_ $ toHtml $ title $ Rib._document_meta doc
+                Rib._document_html doc
     -- Define your site CSS here
     pageStyle :: Css
-    pageStyle = div # "#thesite" ? do
-      marginLeft $ pct 20
-      marginTop $ em 4
-      "h1" ? do
-        fontSize $ em 2.3
+    pageStyle = "div#thesite" ? do
+      margin (em 4) (pc 20) (em 1) (pc 20)
+      "li.links" ? do
+        listStyleType none
+        marginTop $ em 1
+        "b" ? fontSize (em 1.2)
+        "p" ? sym margin (px 0)
 ```
 
 (View full [`Main.hs`](https://github.com/srid/rib-sample/blob/master/Main.hs) at rib-sample)

src/Rib/Document.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -8,6 +7,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Rib.Document
   ( -- * Document type
@@ -59,31 +59,33 @@ instance Markup repr => Show (DocumentError repr) where
 --
 -- Return the Document type containing converted values.
 mkDocumentFrom ::
-  forall b repr meta.
-  (Markup repr, FromJSON meta) =>
+  forall m b repr meta.
+  (MonadError (DocumentError repr) m, MonadIO m, Markup repr, FromJSON meta) =>
   -- | File path, used only to identify (not access) the document
   "relpath" :! Path Rel File ->
   -- | Actual file path, for access and reading
   "path" :! Path b File ->
-  IO (Either (DocumentError repr) (Document repr meta))
-mkDocumentFrom (Arg k) (Arg f) = runExceptT $ do
-  -- HACK: this looks bad
-  v :: repr <-
+  m (Document repr meta)
+mkDocumentFrom k@(arg #relpath -> k') f = do
+  v <-
     liftEither
-      =<< ( lift $ fmap (first DocumentError_MarkupError) $
-              readDoc @repr @b
-                ! #relpath k
-                ! #path f
-          )
-  h <- withExceptT DocumentError_MarkupError $ liftEither $ renderDoc v
+      . first DocumentError_MarkupError
+        =<< liftIO (readDoc k f)
+  html <-
+    liftEither
+      $ first DocumentError_MarkupError
+      $ renderDoc v
   let metaValueM = extractMeta v
-  metaValue <- maybeToEither DocumentError_MetadataMissing metaValueM
+  metaValue <-
+    maybeToEither
+      DocumentError_MetadataMissing
+      metaValueM
   meta <-
-    withExceptT DocumentError_MetadataBadJSON
-      $ liftEither
+    liftEither
+      $ first DocumentError_MetadataBadJSON
       $ resultToEither
       $ fromJSON metaValue
-  pure $ Document k v h metaValueM meta
+  pure $ Document k' v html metaValueM meta
   where
     maybeToEither e = \case
       Nothing -> throwError e

src/Rib/Markup.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}

src/Rib/Shake.hs

@@ -91,11 +91,11 @@ readDocMulti pat = do
   fs <- getDirectoryFiles' input [pat]
   forP fs $ \f -> do
     need $ toFilePath <$> [input </> f]
-    result <-
-      liftIO $
-        mkDocumentFrom
-          ! #relpath f
-          ! #path (input </> f)
+    result <- runExceptT $
+      mkDocumentFrom
+        ! #relpath f
+        ! #path (input </> f)
+    -- TODO: Make error reporting nice, without Shake's stack trace ugliness.
     case result of
       Left e ->
         fail $ "Error converting " <> toFilePath f <> " to HTML: " <> show e