From eeb4696a91788a560d6097472099a658ad9918d4 Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <exa.exa@gmail.com>
Date: Fri, 13 Oct 2023 22:37:09 +0200
Subject: implement ingesting the extra metadata from files, reorganize a bit

---
 reploy.hs | 48 ++++++++++++++++++++++++------------------------
 1 file changed, 24 insertions(+), 24 deletions(-)

(limited to 'reploy.hs')

diff --git a/reploy.hs b/reploy.hs
index 3a7e6a8..caf51d9 100644
--- a/reploy.hs
+++ b/reploy.hs
@@ -19,7 +19,7 @@
 module Main where
 
 import Control.Monad (filterM, join, unless, when)
-import Control.Monad.Extra (ifM, whenM)
+import Control.Monad.Extra (whenM)
 import Control.Monad.Trans.State.Lazy
 import qualified Data.Aeson as AE
 import qualified Data.Aeson.Key as K
@@ -66,6 +66,7 @@ import qualified Text.Parsec.Error
 import FormatOpts
 import Types
 import Utils
+import AesonUtils
 
 -- | Check if a given path should be sourced or not
 isSourceablePath :: FilePath -> Site Bool
@@ -202,37 +203,36 @@ addGlobalMeta :: Y.Value -> Site MT.Value
 addGlobalMeta (Y.Object m) = do
   r <- use urlBase
   i <- use appendUrlIndex
-  em <- use extraMeta
   let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
-  pure . Mu.object $ l ++ map (\(k, v) -> (T.pack k, Mu.toMustache v)) em ++
+  pure . Mu.object $ l ++
     [ ("root", Mu.toMustache $ T.pack r)
     , ("rawRootUrl", Mu.overText $ T.pack . rootUrl' r . T.unpack)
     , ("pageLink", Mu.overText $ T.pack . rootPageUrl' r i . T.unpack)
     ]
 
 -- | Get the expected timestamp file for a given filepath
-timestampFile :: FilePath -> Site FilePath
-timestampFile fp = do
-  sfx <- use timestampSuffix
+metadataFile :: FilePath -> Site FilePath
+metadataFile fp = do
+  sfx <- use metadataSuffix
   pure . uncurry (</>) . fmap (++ sfx) . splitFileName $ fp
 
--- | If a timestamp file for the page exists, add the timestamp metadata.
-addTimeMeta :: PageInfo -> Y.Value -> Site Y.Value
-addTimeMeta pi m'@(Y.Object m)
-  | "timestamp" `KM.member` m = pure m' -- do not overwrite the timestamp if present
-  | otherwise = do
-    tspath <- timestampFile $ pi ^. pagePath
-    io $
-      ifM
-        (doesFileExist tspath)
-        (do putStrLn $ "timestamp <- " ++ tspath
-            ts <- Y.String <$> TIO.readFile tspath
-            pure . Y.Object $ KM.insert "timestamp" ts m)
-        (pure m')
+-- | If an extra-metadata file exists, patch it over the current metadata.
+addExtraMeta :: PageInfo -> Y.Value -> Site Y.Value
+addExtraMeta pi m = do
+  metaPath <- metadataFile $ pi ^. pagePath
+  metaExists <- io $ doesFileExist metaPath
+  gem <- use extraMeta
+  objMerge gem <$> if metaExists
+    then do
+      em' <- io $ Y.decodeFileEither metaPath
+      case em' of
+        Left pe -> error $ "decoding " ++ metaPath ++ " failed: " ++ Y.prettyPrintParseException pe
+        Right em -> pure $ objMerge em m
+    else pure m
 
 -- | Add page-specific information to the metadata. In this instance, this just
--- expands the tags for rendering. Eventually would be nice to have the timestamps
--- and possibly other info sourced right here.
+-- expands the tags for rendering and continues by adding extra metadata via
+-- `addExtraMeta`.
 addPageMeta :: PageInfo -> Y.Value -> Site Y.Value
 addPageMeta pi (Y.Object m) = do
   htagMeta <-
@@ -241,7 +241,7 @@ addPageMeta pi (Y.Object m) = do
     _String .
     to T.unpack .
     to splitDirectories
-  addTimeMeta pi . Y.Object $ KM.insert "htags" (Y.array htagMeta) m
+  addExtraMeta pi . Y.Object $ KM.insert "htags" (Y.array htagMeta) m
 
 -- | If viable for a page (by config), add the TOC field
 addTOC :: PageInfo -> Text.Pandoc.Definition.Pandoc -> Y.Value -> Site Y.Value
@@ -351,7 +351,7 @@ installAssetDir ad =
 
 -- | Copy all files from the asset directories.
 installAssets :: Site ()
-installAssets = use assetdirs >>= traverse installAssetDir
+installAssets = use assetDirs >>= traverse_ installAssetDir
 
 -- | Load tag names from a directory and add them to `tagNames`.
 sourceTagnames :: FilePath -> Site ()
@@ -370,7 +370,7 @@ sourceTagnameFile fp = do
       Y.decodeFileEither fp
   case yml' of
     Left err ->
-      error $ "Failed to load tagnames from " ++ fp ++ ": " ++ show err
+      error $ "Failed to load tagnames from " ++ fp ++ ": " ++ Y.prettyPrintParseException err
     Right yml -> traverse_ add $ KM.toList (yml :: KM.KeyMap String)
       where add :: (KM.Key, String) -> Site ()
             add (k, v) =
-- 
cgit v1.2.3