diff options
Diffstat (limited to 'reploy.hs')
| -rw-r--r-- | reploy.hs | 48 |
1 files changed, 24 insertions, 24 deletions
@@ -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) = |