diff --git a/example/Main.hs b/example/Main.hs index 18e3592..8dd000b 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -15,7 +15,7 @@ import Lucid import qualified Rib.App as App import Rib.Pandoc (getPandocMetaHTML, getPandocMetaValue, highlightingCss, pandoc2Html) import qualified Rib.Settings as S -import Rib.Simple (Page (..), Post (..)) +import Rib.Simple (Page (..), Post (..), isDraft) import qualified Rib.Simple as Simple data PostCategory @@ -56,7 +56,9 @@ renderPage page = with html_ [lang_ "en"] $ do postList progPosts with h2_ [class_ "ui header"] "Other notes" postList otherPosts - Page_Post post -> + Page_Post post -> do + when (isDraft post) $ + with div_ [class_ "ui warning message"] "This is a draft" with article_ [class_ "post"] $ toHtmlRaw $ pandoc2Html $ _post_doc post with a_ [class_ "ui green right ribbon label", href_ "https://www.srid.ca"] "Sridhar Ratnakumar" diff --git a/example/content/haskell-nix.md b/example/content/haskell-nix.md index 5216879..993fc48 100644 --- a/example/content/haskell-nix.md +++ b/example/content/haskell-nix.md @@ -1,7 +1,7 @@ --- title: "Nix tutorial for Haskellers" description: How to develop *Haskell* projects using *Nix* -category: Programming +category: 'Programming' --- The goal of this article is to get you comfortable managing simple Haskell diff --git a/example/content/inbox.md b/example/content/inbox.md new file mode 100644 index 0000000..08d6d3d --- /dev/null +++ b/example/content/inbox.md @@ -0,0 +1,27 @@ +--- +title: Random stuff I collect +draft: 'True' +description: This stuff is hidden if not private +--- + +## Article ideas + +- Github CI for OSS haskell projects +- Lens and friends +- mtl +- string types +- personal nix cache + +## Project ideas + +- [ ] Invoice generator + +### Rib + +- [ ] Drafts +- [ ] Tasks +- [ ] Simplify `Settings` (seems gobbled together) + +#### Rib, for journaling + +- [ ] Render Seinfeld diary view of good/bad/etc. diff --git a/src/Rib/Pandoc.hs b/src/Rib/Pandoc.hs index 71c13ee..ca274f4 100644 --- a/src/Rib/Pandoc.hs +++ b/src/Rib/Pandoc.hs @@ -2,7 +2,6 @@ module Rib.Pandoc where -import Control.Monad import Data.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -38,7 +37,9 @@ getPandocMetaRaw k p = -- Like getPandocMetaRaw but expects the value to be of Haskell syntax getPandocMetaValue :: Read a => String -> Pandoc -> Maybe a -getPandocMetaValue k = readMaybe <=< getPandocMetaRaw k +getPandocMetaValue k doc = do + s <- getPandocMetaRaw k doc + pure $ fromMaybe (error $ "Invalid metadata value for key: " <> k) $ readMaybe s -- | Get the YAML metadata, parsing it to Pandoc doc and then to HTML getPandocMetaHTML :: String -> Pandoc -> Maybe Text diff --git a/src/Rib/Settings.hs b/src/Rib/Settings.hs index a30d312..324706d 100644 --- a/src/Rib/Settings.hs +++ b/src/Rib/Settings.hs @@ -8,8 +8,6 @@ import Development.Shake import Lucid (Html) -- | Settings for building a static site. --- --- TODO: When settings change it should invalidate Shake cache. How do we do it? data Settings page = Settings { renderPage :: page -> Html () -- ^ Lucid widget for the page diff --git a/src/Rib/Simple.hs b/src/Rib/Simple.hs index 07410b4..e549a22 100644 --- a/src/Rib/Simple.hs +++ b/src/Rib/Simple.hs @@ -7,12 +7,14 @@ module Rib.Simple ( Page(..) , Post(..) + , isDraft , simpleBuildRules , settings ) where import Control.Monad import Data.Aeson (FromJSON, ToJSON) +import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) @@ -22,7 +24,7 @@ import Development.Shake.FilePath import Lucid import Text.Pandoc (Pandoc) -import Rib.Pandoc (parsePandoc) +import Rib.Pandoc (getPandocMetaValue, parsePandoc) import Rib.Server (getHTMLFileUrl) import qualified Rib.Settings as S @@ -39,6 +41,9 @@ data Post = Post } deriving (Generic, Eq, Ord, Show, FromJSON, ToJSON) +isDraft :: Post -> Bool +isDraft = fromMaybe False . getPandocMetaValue "draft" . _post_doc + -- Build rules for the simplest site possible. -- -- Just posts and static files. @@ -65,9 +70,10 @@ simpleBuildRules staticFilePatterns postFilePatterns S.Settings {..} = do pure post -- Generate the main table of contents - -- TODO: Support `draft` property - liftIO $ renderToFile (destDir "index.html") $ - renderPage $ Page_Index posts + let publicPosts = filter (not . isDraft) posts + indexHtml = destDir "index.html" + liftIO $ renderToFile indexHtml $ + renderPage $ Page_Index publicPosts settings :: S.Settings Page