exa/reploy
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

implement ingesting the extra metadata from files, reorganize a bit

Browse source
This commit is contained in:
Mirek Kratochvil 2023-10-13 22:37:09 +02:00
parent 711ae4d941
commit eeb4696a91
4 changed files with 65 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
AesonUtils.hs Normal file
View file

@ -0,0 +1,25 @@
{-
- Copyright (C) 2023 University of Luxembourg
-
- Licensed under the Apache License, Version 2.0 (the "License"); you may not
- use this file except in compliance with the License. You may obtain a copy
- of the License from the LICENSE file in this repository, or at:
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
- License for the specific language governing permissions and limitations
- under the License.
-}
module AesonUtils where
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
-- | A bit like `lodashMerge` from aeson-extra, but replaces the arrays. Right
-- argument overwrites the left one.
objMerge :: A.Value -> A.Value -> A.Value
objMerge (A.Object a) (A.Object b) = A.Object $ KM.unionWith objMerge a b
objMerge _ b = b

32
Types.hs
View file

@ -29,6 +29,7 @@ import Lens.Micro.TH
import Options.Applicative import Options.Applicative
import qualified Text.Mustache as Mu import qualified Text.Mustache as Mu
import qualified Text.Pandoc.Definition import qualified Text.Pandoc.Definition
import AesonUtils
-- | Information about a single deployed page (with metadata etc). -- | Information about a single deployed page (with metadata etc).
data PageInfo = data PageInfo =
@ -73,8 +74,8 @@ data SiteState =
, _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages , _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages
, _tagTemplate :: FilePath -- ^ Name of the template for category pages , _tagTemplate :: FilePath -- ^ Name of the template for category pages
, _listTemplate :: FilePath -- ^ Name of the template for listing pages , _listTemplate :: FilePath -- ^ Name of the template for listing pages
, _extraMeta :: [(String, Y.Value)] -- ^ Extra metadata added to rendering of all templates , _extraMeta :: Y.Value -- ^ Extra metadata added to rendering of all templates
, _timestampSuffix :: FilePath -- ^ File to search for a timestamp (e.g., if the prefix is ".ts", a timestamp for file "page.md" will be looked for in "page.md.ts"). These are best autogenerated with a script that sources the data from git or so. , _metadataSuffix :: FilePath -- ^ File suffix to search for a extra metadata (e.g., if the suffix is ".extra", the extra metadata for file "page.md" will be looked for in "page.md.extra"). These are best autogenerated with a script that sources the data from git or so.
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links. , _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
, _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs , _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs
, _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes. , _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
@ -140,26 +141,23 @@ siteOptions' = do
long "list-template" <> long "list-template" <>
help "Template for making tag-listing pages" <> help "Template for making tag-listing pages" <>
value "list.html" <> showDefault value "list.html" <> showDefault
_timestampSuffix <- _metadataSuffix <-
strOption $ strOption $
long "timestamp-suffix" <> long "metadata-suffix" <>
help "Timestamp file suffix for markdowns" <> help "Suffix for YAML files with base metadata for each markdown page. Metadata from files override the extra metadata specified on commandline, but are overriden by metadata specified directly in the markdown header." <>
value ".timestamp" <> showDefault value ".metadata.yml" <> showDefault
_extraMeta <- _extraMeta <-
let processKeyVal :: String -> (String, Y.Value) let processKeyVal :: String -> Y.Value
processKeyVal opt = processKeyVal opt =
case break (== ':') opt of case Y.decodeEither' $ Data.ByteString.UTF8.fromString opt of
(k, ':':v) -> Right v -> v
case Y.decodeEither' $ Data.ByteString.UTF8.fromString v of Left err ->
Right v -> (k, v :: Y.Value) error $
Left err -> "cannot parse YAML in --extra-metadata: " ++ Y.prettyPrintParseException err
error $ in fmap (foldl objMerge Y.Null . map processKeyVal) . many . strOption $
"cannot parse key:val in --extra-metadata: " ++ show err
_ -> error "cannot process key:val in --extra-metadata"
in fmap (map processKeyVal) . many . strOption $
long "extra-metadata" <> long "extra-metadata" <>
help help
"Extra metadata to add to pages rendering in format `key:<yaml>'. May be specified multiple times." "Extra metadata to add to pages rendering in YAML format. May be specified multiple times."
_urlBase <- _urlBase <-
strOption $ strOption $
long "url-base" <> long "url-base" <>

2
reploy.cabal
View file

@ -10,7 +10,7 @@ license-file: LICENSE
executable reploy executable reploy
main-is: reploy.hs main-is: reploy.hs
other-modules: Types, Utils, FormatOpts other-modules: Types, AesonUtils, Utils, FormatOpts
build-depends: base == 4.* build-depends: base == 4.*
, aeson ^>= 2.1 , aeson ^>= 2.1
, bytestring , bytestring

48
reploy.hs
View file

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