diff --git a/Shakefile.hs b/Shakefile.hs index 595c1ea..3d887e5 100644 --- a/Shakefile.hs +++ b/Shakefile.hs @@ -7,6 +7,9 @@ import Development.Shake import Development.Shake.Command import Development.Shake.FilePath +import Data.Time.Format.ISO8601 (iso8601Show) +import qualified Data.Time.Clock as Clock + import Control.Monad.Fail import Data.Aeson -- import qualified Text.Megaparsec as Megaparsec @@ -18,10 +21,12 @@ import qualified Text.Pandoc.Class as Pandoc import Text.Pandoc.Definition ( Pandoc(..) , Block(..) , Inline(..) + , MetaValue(..) , nullMeta , docTitle , docDate , docAuthors + , lookupMeta ) import Text.Pandoc.Options ( ReaderOptions(..) , WriterOptions(..) @@ -59,6 +64,8 @@ data BlogPost = , postDate :: T.Text , postAuthors :: [T.Text] , postUrl :: FilePath + , postTags :: [T.Text] + , postDescr :: T.Text , postToc :: Bool , postBody :: Pandoc } @@ -74,7 +81,10 @@ getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do title <- fmap (T.dropEnd 1) $ inlineToText $ docTitle meta date <- fmap (T.dropAround dateEnvelope) $ inlineToText $ docDate meta authors <- mapM inlineToText $ docAuthors meta - return $ BlogPost title date authors path toc pandoc + let tags = tagsToList $ lookupMeta "keywords" meta + description = descr $ lookupMeta "description" meta + liftIO $ print (lookupMeta "keywords" meta) + return $ BlogPost title date authors path tags description toc pandoc case eitherBlogpost of Left _ -> fail "BAD" Right bp -> return bp @@ -85,6 +95,16 @@ getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do dateEnvelope '[' = True dateEnvelope ']' = True dateEnvelope _ = False + tagsToList (Just (MetaList ms)) = map toStr ms + tagsToList _ = [] + descr (Just (MetaString t)) = t + descr _ = "" + toStr (MetaString t) = t + toStr (MetaInlines inlines) = T.intercalate " " $ map inlineToTxt inlines + toStr _ = "" + inlineToTxt (Str t) = t + inlineToTxt _ = "" + sortByPostDate :: [BlogPost] -> [BlogPost] @@ -152,6 +172,8 @@ buildArchive getPosts getTemplate out = do $ object [ "title" .= postTitle bp , "authors" .= postAuthors bp , "date" .= postDate bp + , "tags" .= postTags bp + , "description" .= postDescr bp , "body" .= innerHtml ] writeFile' out (toS htmlContent) @@ -174,6 +196,33 @@ replaceLinks = walk replaceOrgLink else lnk replaceOrgLink x = x +orgContentToText org = do + eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) org + pandoc <- case eitherResult of + Left _ -> fail "BAD" + Right p -> return p + eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String (def {writerEmailObfuscation = ReferenceObfuscation}) pandoc + case eitherHtml of + Left _ -> fail "BAD" + Right innerHtml -> return innerHtml + +postamble now bp = + orgContentToText $ unlines $ + ["@@html:@@" + ] + genHtml :: (MonadIO m, MonadFail m) => BlogPost -> m Text genHtml bp = do let htmlBody = replaceLinks (postBody bp) @@ -184,9 +233,12 @@ genHtml bp = do , writerEmailObfuscation = ReferenceObfuscation }) htmlBody - case eitherHtml of + body <- case eitherHtml of Left _ -> fail "BAD" Right innerHtml -> return innerHtml + now <- liftIO Clock.getCurrentTime + footer <- postamble (toS (iso8601Show now)) bp + return (body <> footer) genHtmlAction :: (FilePath -> Action BlogPost) @@ -204,6 +256,8 @@ genHtmlAction getPost getTemplate out = do $ object [ "title" .= postTitle bp , "authors" .= postAuthors bp , "date" .= postDate bp + , "tags" .= postTags bp + , "description" .= postDescr bp , "body" .= innerHtml ] writeFile' out (toS htmlContent) @@ -230,7 +284,7 @@ genAsciiAction getPost out = do allHtmlAction :: Action () allHtmlAction = do - allOrgFiles <- getDirectoryFiles srcDir ["**.org"] + allOrgFiles <- getDirectoryFiles srcDir ["//*.org"] let allHtmlFiles = map (-<.> "html") allOrgFiles need (map build allHtmlFiles) diff --git a/src/posts/0010-Haskell-Now/index.org b/src/posts/0010-Haskell-Now/index.org index 86da14f..4bc5b4f 100644 --- a/src/posts/0010-Haskell-Now/index.org +++ b/src/posts/0010-Haskell-Now/index.org @@ -4,13 +4,7 @@ #+author: Yann Esposito #+EMAIL: yann@esposito.host #+keywords: Haskell, programming, functional, tutorial -#+DESCRIPTION: A short and intense introduction to Haskell. -#+DESCRIPTION: This is an update of my old (2012) article. -#+DESCRIPTION: A lot of things have changed since then. -#+DESCRIPTION: Mostly I changed my approach about the easiest way to install -#+DESCRIPTION: a Haskell playground. -#+DESCRIPTION: I removed the not as important part, and added a short -#+DESCRIPTION: introduction about starting a new project. +#+DESCRIPTION: A short and intense introduction to Haskell. This is an update of my old (2012) article. A lot of things have changed since then. Mostly I changed my approach about the easiest way to install a Haskell playground. I removed the not as important part, and added a short introduction about starting a new project. #+OPTIONS: auto-id:t toc:t #+STARTUP: overview diff --git a/templates/main.mustache b/templates/main.mustache index a94c624..ee03523 100644 --- a/templates/main.mustache +++ b/templates/main.mustache @@ -6,7 +6,7 @@ {{title}} - + @@ -34,13 +34,24 @@
+
{{description}}
+ {{{ body }}}
-
+