From 2f07e7116513458eb9992fa547551c7296f5a4c7 Mon Sep 17 00:00:00 2001 From: Sridhar Ratnakumar Date: Mon, 1 Jul 2019 18:14:01 -0400 Subject: [PATCH] Isolate library and executable (#11) * Split library and executable * Abstract out pandoc stuff from example * Put example content under ./example * Simplify HTML render configuration --- .gitignore | 2 +- README.md | 8 +- {src => example}/CSS.hs | 12 ++- example/HTML.hs | 84 ++++++++++++++++ {src => example}/Main.hs | 4 +- {site => example/content}/calisthenics.md | 0 {site => example/content}/carnivore-diet.md | 0 {site => example/content}/haskell-nix.md | 4 +- {site => example/content}/images/.gitkeep | 0 {site => example/content}/images/beef.jpg | Bin .../content}/images/courtenay.jpg | Bin .../content}/images/lasik-drops.jpg | Bin .../content}/images/lasik-quebec.jpg | Bin {site => example/content}/images/ribeye.jpg | Bin {site => example/content}/images/ribs.svg | 0 .../content}/images/steven-low.jpg | Bin {site => example/content}/lasik.md | 0 {site => example/content}/life.md | 0 {site => example/content}/sous-vide.md | 0 rib.cabal | 31 +++++- src/HTML.hs | 93 ------------------ src/Reflex/Dom/Pandoc/Document.hs | 11 ++- src/Rib/App.hs | 6 +- src/Rib/Settings.hs | 16 +-- src/Rib/Shake.hs | 11 ++- src/Rib/Types.hs | 27 ++++- 26 files changed, 183 insertions(+), 126 deletions(-) rename {src => example}/CSS.hs (78%) create mode 100644 example/HTML.hs rename {src => example}/Main.hs (89%) rename {site => example/content}/calisthenics.md (100%) rename {site => example/content}/carnivore-diet.md (100%) rename {site => example/content}/haskell-nix.md (97%) rename {site => example/content}/images/.gitkeep (100%) rename {site => example/content}/images/beef.jpg (100%) rename {site => example/content}/images/courtenay.jpg (100%) rename {site => example/content}/images/lasik-drops.jpg (100%) rename {site => example/content}/images/lasik-quebec.jpg (100%) rename {site => example/content}/images/ribeye.jpg (100%) rename {site => example/content}/images/ribs.svg (100%) rename {site => example/content}/images/steven-low.jpg (100%) rename {site => example/content}/lasik.md (100%) rename {site => example/content}/life.md (100%) rename {site => example/content}/sous-vide.md (100%) delete mode 100644 src/HTML.hs diff --git a/.gitignore b/.gitignore index 65c5132..81ceb9a 100644 --- a/.gitignore +++ b/.gitignore @@ -2,4 +2,4 @@ dist-newstyle dist result .shake -generated +content.generated diff --git a/README.md b/README.md index f9dd1c9..f98b984 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,9 @@ Credit for this image: https://www.svgrepo.com/svg/24439/ribs Rib is a static site generator written in Haskell using sensible technologies -like `Shake` and `Reflex`. +like `Shake` and `Reflex`. See `./example` to see how the library can be used; +it contains the author's actual website. It is still a work in progress but will +soon be ready for general use. ## Local server when editing only content @@ -18,14 +20,12 @@ nix-build -A ghc.rib ## ... when hacking on Haskell sources ```bash -nix-shell -A shells.ghc --run "ghcid -T Main.dev" +nix-shell -A shells.ghc --run "ghcid -c 'cabal new-repl rib-example' -T 'System.Directory.withCurrentDirectory \"example\" \$ Main.dev'" ``` ## TODO - Use my own jsonCache' and drop dependency on Slick -- Literate haskell - - Include rendered Main.lhs as a post in notes.srid.ca ### Article Ideas diff --git a/src/CSS.hs b/example/CSS.hs similarity index 78% rename from src/CSS.hs rename to example/CSS.hs index aef4791..80e395f 100644 --- a/src/CSS.hs +++ b/example/CSS.hs @@ -4,12 +4,13 @@ module CSS where import Prelude hiding (div, (**)) -import Control.Monad (forM_) +import Control.Monad import Data.Text (Text) import Clay --- All these font names should exist in Google Fonts +googleFonts :: [Text] +googleFonts = [headerFont, contentFont, codeFont] headerFont :: Text headerFont = "Comfortaa" @@ -20,9 +21,12 @@ contentFont = "Open Sans" codeFont :: Text codeFont = "Roboto Mono" -siteStyle :: Css -siteStyle = body ? do +-- | Main style for the site +style :: Css +style = body ? do 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] diff --git a/example/HTML.hs b/example/HTML.hs new file mode 100644 index 0000000..0f45603 --- /dev/null +++ b/example/HTML.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module HTML where + +import Control.Monad +import Data.List (partition) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import qualified Clay +import Reflex.Dom.Core + +import Reflex.Dom.Pandoc.Document (elPandocDoc, elPandocInlines) +import qualified Reflex.Dom.Pandoc.SyntaxHighlighting as SyntaxHighlighting + +import Rib.Types (Page (..), Post (..), PostCategory (..), getPostAttribute, getPostAttributeJson) + +import qualified CSS + +-- | HTML for page type +pageWidget :: DomBuilder t m => Page -> m () +pageWidget page = elAttr "html" ("lang" =: "en") $ do + el "head" $ do + mapM_ (uncurry elMeta) + [ ("charset", "UTF-8") + , ("description", "Sridhar's notes") + , ("author", "Sridhar Ratnakumar") + , ("viewport", "width=device-width, initial-scale=1") + ] + el "title" pageTitle + mapM_ elStyleClay [CSS.style, SyntaxHighlighting.style] + elLinkStylesheet semanticUiCss + + el "body" $ do + elAttr "div" ("class" =: "ui text container" <> "id" =: "thesite") $ do + divClass "ui raised segment" $ do + -- Header + elAttr "a" ("class" =: "ui violet ribbon label" <> "href" =: "/") $ text "Srid's notes" + -- Main content + elClass "h1" "ui huge header" pageTitle + case page of + Page_Index posts -> do + let (progPosts, otherPosts) = + partition ((== Just Programming) . getPostAttributeJson "category") posts + elClass "h2" "ui header" $ text "Haskell & Nix notes" + postList progPosts + elClass "h2" "ui header" $ text "Other notes" + postList otherPosts + Page_Post post -> + elClass "article" "post" $ + elPandocDoc $ _post_doc post + -- Footer + elAttr "a" ("class" =: "ui green right ribbon label" <> "href" =: "https://www.srid.ca") $ + text "Sridhar Ratnakumar" + + -- Load Google fonts at the very end for quicker page load. + mapM_ elLinkGoogleFont CSS.googleFonts + + where + pageTitle = case page of + Page_Index _ -> text "Srid's notes" + Page_Post post -> postTitle post + + -- Render the post title (Markdown supported) + postTitle = maybe (text "Untitled") elPandocInlines . getPostAttribute "title" + + -- Render a list of posts + postList ps = divClass "ui relaxed divided list" $ forM_ ps $ \p -> + divClass "item" $ do + elAttr "a" ("class" =: "header" <> "href" =: _post_url p) $ + postTitle p + el "small" $ maybe blank elPandocInlines $ getPostAttribute "description" p + + semanticUiCss = "https://cdn.jsdelivr.net/npm/semantic-ui@2.4.2/dist/semantic.min.css" + + elMeta k v = + elAttr "meta" ("name" =: k <> "content" =: v) blank + elLinkStylesheet url = + elAttr "link" ("href" =: url <> "rel" =: "stylesheet") blank + elLinkGoogleFont name = elLinkStylesheet $ + "https://fonts.googleapis.com/css?family=" <> T.replace " " "-" name + elStyleClay = + elAttr "style" ("type" =: "text/css") . text . TL.toStrict . Clay.render diff --git a/src/Main.hs b/example/Main.hs similarity index 89% rename from src/Main.hs rename to example/Main.hs index d86871e..733780e 100644 --- a/src/Main.hs +++ b/example/Main.hs @@ -15,9 +15,9 @@ import qualified HTML -- | Configure this site here. -- -- See `S.Settings` for the settings available. -siteSettings :: S.Settings +siteSettings :: S.Settings x siteSettings = def - { S.pageHTML = HTML.pageHTML + { S.pageWidget = HTML.pageWidget -- ^ How to render a page type } diff --git a/site/calisthenics.md b/example/content/calisthenics.md similarity index 100% rename from site/calisthenics.md rename to example/content/calisthenics.md diff --git a/site/carnivore-diet.md b/example/content/carnivore-diet.md similarity index 100% rename from site/carnivore-diet.md rename to example/content/carnivore-diet.md diff --git a/site/haskell-nix.md b/example/content/haskell-nix.md similarity index 97% rename from site/haskell-nix.md rename to example/content/haskell-nix.md index 7479ec1..c70c57f 100644 --- a/site/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 @@ -133,7 +133,7 @@ compiler.developPackage { } ``` -In order you compute the `sha256` hash you can use `nix-prefetch-git`: +In order to compute the `sha256` hash you can use `nix-prefetch-git`: ```bash nix-prefetch-git \ diff --git a/site/images/.gitkeep b/example/content/images/.gitkeep similarity index 100% rename from site/images/.gitkeep rename to example/content/images/.gitkeep diff --git a/site/images/beef.jpg b/example/content/images/beef.jpg similarity index 100% rename from site/images/beef.jpg rename to example/content/images/beef.jpg diff --git a/site/images/courtenay.jpg b/example/content/images/courtenay.jpg similarity index 100% rename from site/images/courtenay.jpg rename to example/content/images/courtenay.jpg diff --git a/site/images/lasik-drops.jpg b/example/content/images/lasik-drops.jpg similarity index 100% rename from site/images/lasik-drops.jpg rename to example/content/images/lasik-drops.jpg diff --git a/site/images/lasik-quebec.jpg b/example/content/images/lasik-quebec.jpg similarity index 100% rename from site/images/lasik-quebec.jpg rename to example/content/images/lasik-quebec.jpg diff --git a/site/images/ribeye.jpg b/example/content/images/ribeye.jpg similarity index 100% rename from site/images/ribeye.jpg rename to example/content/images/ribeye.jpg diff --git a/site/images/ribs.svg b/example/content/images/ribs.svg similarity index 100% rename from site/images/ribs.svg rename to example/content/images/ribs.svg diff --git a/site/images/steven-low.jpg b/example/content/images/steven-low.jpg similarity index 100% rename from site/images/steven-low.jpg rename to example/content/images/steven-low.jpg diff --git a/site/lasik.md b/example/content/lasik.md similarity index 100% rename from site/lasik.md rename to example/content/lasik.md diff --git a/site/life.md b/example/content/life.md similarity index 100% rename from site/life.md rename to example/content/life.md diff --git a/site/sous-vide.md b/example/content/sous-vide.md similarity index 100% rename from site/sous-vide.md rename to example/content/sous-vide.md diff --git a/rib.cabal b/rib.cabal index 3208e53..6574086 100644 --- a/rib.cabal +++ b/rib.cabal @@ -17,11 +17,20 @@ source-repository head type: git location: https://github.com/srid/rib -executable rib - main-is: Main.hs +library + exposed-modules: + Rib.App + , Rib.Settings + , Rib.Types + , Reflex.Dom.Pandoc.Document + , Reflex.Dom.Pandoc.SyntaxHighlighting + other-modules: + Rib.Shake + , Rib.Server + , Reflex.Dom.Pandoc.Util hs-source-dirs: src - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: aeson , async @@ -51,3 +60,19 @@ executable rib , wai-extra , warp default-language: Haskell2010 + +executable rib-example + main-is: Main.hs + other-modules: + CSS + , HTML + hs-source-dirs: example + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + build-depends: + base + , clay + , data-default + , directory + , reflex-dom-core + , rib + , text diff --git a/src/HTML.hs b/src/HTML.hs deleted file mode 100644 index a782749..0000000 --- a/src/HTML.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - -module HTML where - -import Control.Monad (forM_) -import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Char8 as BS8 -import Data.List (partition) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -import qualified Clay -import Reflex.Dom.Core -import Text.Pandoc (Block (Plain), Inline (Str), Pandoc (Pandoc)) -import Text.Pandoc.UTF8 (fromStringLazy) - -import Reflex.Dom.Pandoc.Document (elPandocDoc) -import qualified Reflex.Dom.Pandoc.SyntaxHighlighting as SyntaxHighlighting - -import Rib.Types (Page (..), Post (..), PostCategory (..), getPostAttribute) - -import CSS (codeFont, contentFont, headerFont, siteStyle) - -pageHTML :: Page -> IO String -pageHTML = fmap BS8.unpack . renderHTML . pageWidget - where - -- | Convert a Reflex DOM widget into HTML - renderHTML :: StaticWidget x a -> IO BS8.ByteString - renderHTML = fmap snd . renderStatic - --- | The entire HTML layout is here. -pageWidget :: DomBuilder t m => Page -> m () -pageWidget page = do - let pageTitle = case page of - Page_Index _ -> text "Srid's notes" - Page_Post post -> postTitle post - elAttr "html" ("lang" =: "en") $ el "head" $ do - elMeta "charset" "UTF-8" - elMeta "description" "Sridhar's notes" - elMeta "author" "Sridhar Ratnakumar" - elMeta "viewport" "width=device-width, initial-scale=1" - el "title" pageTitle - elAttr "style" ("type" =: "text/css") $ text $ TL.toStrict $ Clay.render siteStyle - elAttr "style" ("type" =: "text/css") $ text $ TL.toStrict $ Clay.render SyntaxHighlighting.style - elAttr "link" ("rel" =: "stylesheet" <> "href" =: semUiCdn) blank - el "body" $ do - elAttr "div" ("class" =: "ui text container" <> "id" =: "thesite") $ do - el "br" blank - divClass "ui raised segment" $ do - -- Header - elAttr "a" ("class" =: "ui violet ribbon label" <> "href" =: "/") $ text "Srid's notes" - -- Main content - elClass "h1" "ui huge header" pageTitle - case page of - Page_Index posts -> do - let (progPosts, otherPosts) = - partition ((== Just Programming) . postCategory) posts - elClass "h2" "ui header" $ text "Haskell & Nix notes" - postList progPosts - elClass "h2" "ui header" $ text "Other notes" - postList otherPosts - Page_Post post -> - elClass "article" "post" $ - elPandocDoc $ _post_doc post - -- Footer - elAttr "a" ("class" =: "ui green right ribbon label" <> "href" =: "https://www.srid.ca") $ text "Sridhar Ratnakumar" - el "br" blank - el "br" blank - mapM_ elLinkGoogleFont [headerFont, contentFont, codeFont] - where - postList ps = divClass "ui relaxed divided list" $ forM_ ps $ \p -> - divClass "item" $ do - elAttr "a" ("class" =: "header" <> "href" =: _post_url p) $ - postTitle p - el "small" $ maybe blank pandocInlines $ getPostAttribute "description" p - - postTitle = maybe (text "Untitled") pandocInlines . getPostAttribute "title" - postCategory post = getPostAttribute "category" post >>= \case - [Str category] -> do - let categoryJson = "\"" <> category <> "\"" - Aeson.decode $ fromStringLazy categoryJson - _ -> error "Invalid category format" - - -- TODO: Put this in Markdown module, and reuse renderBlocks - pandocInlines xs = elPandocDoc $ Pandoc mempty [Plain xs] - - semUiCdn = "https://cdn.jsdelivr.net/npm/semantic-ui@2.4.2/dist/semantic.min.css" - elLinkGoogleFont name = - elAttr "link" ("href" =: fontUrl <> "rel" =: "stylesheet" <> "type" =: "text/css") blank - where - fontUrl = "https://fonts.googleapis.com/css?family=" <> (T.replace " " "-" name) - elMeta k v = elAttr "meta" ("name" =: k <> "content" =: v) blank diff --git a/src/Reflex/Dom/Pandoc/Document.hs b/src/Reflex/Dom/Pandoc/Document.hs index 385da28..95ba4d7 100644 --- a/src/Reflex/Dom/Pandoc/Document.hs +++ b/src/Reflex/Dom/Pandoc/Document.hs @@ -1,7 +1,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module Reflex.Dom.Pandoc.Document where +module Reflex.Dom.Pandoc.Document + ( elPandocDoc + , elPandocInlines + )where import Control.Monad (forM_) import qualified Data.Text as T @@ -76,3 +79,9 @@ elPandocDoc (Pandoc _meta blocks) = renderBlocks blocks notImplemented x = do el "strong" $ text "NotImplemented: " el "pre" $ el "code" $ text $ T.pack $ show x + +-- | Render list of Pandoc inlines +-- +-- Useful when dealing with metadata values +elPandocInlines :: DomBuilder t m => [Inline] -> m () +elPandocInlines xs = elPandocDoc $ Pandoc mempty [Plain xs] diff --git a/src/Rib/App.hs b/src/Rib/App.hs index 5389ed1..26f702f 100644 --- a/src/Rib/App.hs +++ b/src/Rib/App.hs @@ -36,16 +36,16 @@ cli = modes , Generate { force = False &= help "Force generation of all files" } &= help "Generate the site" - &= auto -- | Generate is the default command. + &= auto -- Generate is the default command. ] -- | CLI entry point for running the Rib app -run :: S.Settings -> IO () +run :: S.Settings x -> IO () run cfg = runWith cfg =<< cmdArgs cli -- | Like `run` but uses the given `App` mode instead of reading it from CLI -- arguments. -runWith :: S.Settings -> App -> IO () +runWith :: S.Settings x -> App -> IO () runWith cfg = \case Watch -> withManager $ \mgr -> do -- Begin with a *full* generation as the HTML layout may have been changed. diff --git a/src/Rib/Settings.hs b/src/Rib/Settings.hs index 8565abe..bf25d1c 100644 --- a/src/Rib/Settings.hs +++ b/src/Rib/Settings.hs @@ -1,19 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} module Rib.Settings where import Data.Default (Default (def)) import Data.Text (Text) +import qualified Data.Text as T import Development.Shake.FilePath (FilePath) +import Reflex.Dom.Core import Text.Pandoc (Extension (..), Pandoc, ReaderOptions, extensionsFromList, githubMarkdownExtensions, readMarkdown, readerExtensions, runPure) import Rib.Types (Page) -data Settings = Settings - { pageHTML :: Page -> IO String +data Settings x = Settings + { pageWidget :: Page -> StaticWidget x () -- ^ Reflex widget for the page , parsePage :: Text -> Pandoc -- ^ Parse a text document like Markdown into Pandoc structure @@ -32,12 +36,12 @@ data Settings = Settings -- changed in our Haskell source. } -instance Default Settings where +instance Default (Settings x) where def = Settings - { pageHTML = pure . show + { pageWidget = el "tt" . text . T.pack . show , parsePage = either (error . show) id . runPure . readMarkdown markdownOptions - , contentDir = "site" - , destDir = "generated" + , contentDir = "content" + , destDir = "content.generated" , staticFilePatterns = ["images//*"] , postFilePatterns = ["*.md"] , rebuildPatterns = ["**/*.html", "**/*.md"] diff --git a/src/Rib/Shake.hs b/src/Rib/Shake.hs index 88c4ffd..19b213a 100644 --- a/src/Rib/Shake.hs +++ b/src/Rib/Shake.hs @@ -16,6 +16,7 @@ import Development.Shake (Action, Rebuild (..), Verbosity (Chatty), copyFileChan readFile', shakeArgs, shakeOptions, shakeRebuild, shakeVerbosity, want, writeFile', (%>), (|%>), (~>)) import Development.Shake.FilePath (dropDirectory1, dropExtension, (-<.>), ()) +import Reflex.Dom.Core (renderStatic) import Slick (jsonCache') @@ -26,11 +27,11 @@ import Rib.Types ribShake :: Bool -- ^ Force generate of requested targes - -> S.Settings + -> S.Settings x -- ^ Site settings -> IO () ribShake forceGen cfg = withArgs [] $ do - -- ^ The withArgs above is to ensure that our own app arguments is not + -- The withArgs above is to ensure that our own app arguments is not -- confusing Shake. let opts = shakeOptions { shakeVerbosity = Chatty @@ -64,13 +65,13 @@ ribShake forceGen cfg = withArgs [] $ do (S.destDir cfg "index.html") %> \out -> do files <- getDirectoryFiles (S.contentDir cfg) $ S.postFilePatterns cfg posts <- traverse (getPostCached . PostFilePath . (S.contentDir cfg )) files - html <- liftIO $ S.pageHTML cfg $ Page_Index posts + html <- liftIO $ renderPost $ Page_Index posts writeFile' out html -- rule for actually building posts (S.destDir cfg "*.html") %> \out -> do post <- getPostCached $ PostFilePath $ destToSrc out -<.> "md" - html <- liftIO $ S.pageHTML cfg $ Page_Post post + html <- liftIO $ renderPost $ Page_Post post writeFile' out html where @@ -83,6 +84,8 @@ ribShake forceGen cfg = withArgs [] $ do postURL = T.pack $ ("/" ++) . dropDirectory1 . dropExtension $ postPath pure $ Post doc postURL + renderPost = fmap (BS8.unpack . snd) . renderStatic . S.pageWidget cfg + -- | Convert 'build' filepaths into source file filepaths destToSrc :: FilePath -> FilePath destToSrc = (S.contentDir cfg ) . dropDirectory1 diff --git a/src/Rib/Types.hs b/src/Rib/Types.hs index 48f1a0e..e7a9dd5 100644 --- a/src/Rib/Types.hs +++ b/src/Rib/Types.hs @@ -1,16 +1,25 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module Rib.Types where +module Rib.Types + ( Page(..) + , Post(..) + , PostCategory(..) + , PostFilePath(..) + , getPostAttribute + , getPostAttributeJson + ) where -import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson (FromJSON, ToJSON, decode) import qualified Data.Map as Map import Data.Text (Text) import GHC.Generics (Generic) import Development.Shake.Classes (Binary, Hashable, NFData) -import Text.Pandoc (Inline, Meta (unMeta), MetaValue (MetaInlines), Pandoc (Pandoc)) +import Text.Pandoc (Inline (Str), Meta (unMeta), MetaValue (MetaInlines), Pandoc (Pandoc)) +import Text.Pandoc.UTF8 (fromStringLazy) -- | Represents a HTML page that will be generated data Page @@ -46,3 +55,15 @@ getPostAttribute k (Post (Pandoc meta _) _) = -- comment above. Just (MetaInlines inlines) -> Just inlines _ -> Nothing + +-- Like getPostAttribute but expects the value to be JSON encoding of a type. +getPostAttributeJson :: FromJSON a => String -> Post -> Maybe a +getPostAttributeJson k p = do + v <- getPostAttributeRaw k p + decode $ fromStringLazy v + +getPostAttributeRaw :: String -> Post -> Maybe String +getPostAttributeRaw k p = do + getPostAttribute k p >>= \case + [Str v] -> Just v + _ -> Nothing