implement tag aliases, replacements, warnings

warnings are printed by `list-tags`
This commit is contained in:
rhiannon morris 2024-11-05 00:21:35 +01:00
parent cae6400ec9
commit 67f0c3ded7
9 changed files with 319 additions and 118 deletions

View file

@ -24,10 +24,12 @@ import qualified GalleryPage
import qualified IndexPage
import qualified RSS
import qualified ListTags
import TagTransforms
#ifdef PRETTY_VERBOSE
import qualified Text.PrettyPrint as PP
import qualified Text.Show.Pretty as PP
import Data.Function ((&))
#endif
@ -49,19 +51,20 @@ main = do
main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {root, file, prefix, index, dataDir, nsfw, output}) = do
siteName <- (.title) <$> readYAML @IndexInfo index
info <- readYAML file
iinfo <- readYAML index
info <- transformInfoTags iinfo.tags <$> readYAML file
printV $ "contents" := info
let dir = takeDirectory $ makeRelative dataDir file
page <- SinglePage.make root siteName prefix nsfw dataDir dir info
page <- SinglePage.make root iinfo prefix nsfw dataDir dir info
writeOutput output page
main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do
(_, ginfo) <- galleryFromIndex index prefix
(iinfo, _, ginfo) <- galleryFromIndex index prefix
printV $ "gallery_info" := ginfo
infos <- mapM (infoYAML dataDir) files
infos <- traverse (infoYAML dataDir) files
& fmap (fmap $ fmap $ transformInfoTags iinfo.tags)
printV $ "infos" := infos
let page = GalleryPage.make root ginfo infos
let page = GalleryPage.make root iinfo ginfo infos
writeOutput output page
main2 (IndexPage {root, file, output}) = do
@ -71,9 +74,9 @@ main2 (IndexPage {root, file, output}) = do
writeOutput output page
main2 (RSS {files, root, index, prefix, output, dataDir}) = do
(name, ginfo) <- galleryFromIndex index prefix
(_, name, ginfo) <- galleryFromIndex index prefix
printV $ "gallery_info" := ginfo
infos <- mapM (infoYAML dataDir) files
infos <- traverse (infoYAML dataDir) files
printV $ "infos" := infos
let output' = takeFileName <$> output
let rss = RSS.make root name ginfo output' infos
@ -90,19 +93,24 @@ main2 (DependSingle {index, file, nsfw, output, prefix, buildDir, dataDir}) = do
main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
IndexInfo {galleries} <- readYAML file
printV $ "galleries" := galleries
infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
infos <- findInfos dataDir infoName
>>= traverse (infoYAML dataDir)
printV $ "info_files" := infos
let dependGallery0 g = dependGallery' g file infos buildDir dataDir tmpDir
let deps = toLazyText $ mconcat $ intersperse "\n\n\n" $
map dependGallery0 galleries
writeOutput output deps
main2 (ListTags {nsfw, listUntagged, dataDir, infoName, sortBy}) = do
infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
main2 (ListTags {nsfw, listUntagged, showWarnings, index,
dataDir, infoName, sortBy}) = do
printV $ "index" := index
iinfo <- readYAML index
infos <- findInfos dataDir infoName >>= traverse (infoYAML dataDir)
printV $ "info_files" := infos
ListTags.run nsfw listUntagged sortBy infos
ListTags.run iinfo nsfw listUntagged showWarnings sortBy infos
-- | applies tag transformations also
infoYAML :: FilePath -- ^ data dir
-> FilePath -- ^ yaml file
-> IO (FilePath, Info) -- relative filename, contents
@ -118,10 +126,12 @@ findInfos dataDir infoName =
readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = ByteString.readFile file >>= decode1Must file
galleryFromIndex :: FilePath -> FilePath -> IO (Strict.Text, GalleryInfo)
galleryFromIndex :: FilePath -> FilePath ->
IO (IndexInfo, Strict.Text, GalleryInfo)
galleryFromIndex file prefix = do
IndexInfo {title, galleries} <- readYAML file
maybe (fail $ "no gallery with prefix " ++ prefix) (pure . (title,)) $
iinfo@(IndexInfo {title, galleries}) <- readYAML file
maybe (fail $ "no gallery with prefix " ++ prefix)
(pure . (iinfo, title,)) $
List.find (\g -> g.prefix == prefix) galleries
decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a