From 1b63a30f490dc8548b0c9793fc30818b1c844ccb Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Sat, 25 Jul 2020 15:05:38 +0200 Subject: [PATCH] add list-tags command --- Makefile | 7 +++++ make-pages/BuilderQQ.hs | 2 +- make-pages/ListTags.hs | 54 +++++++++++++++++++++++++++++++++++++ make-pages/Main.hs | 11 ++++++-- make-pages/Options.hs | 19 ++++++++++++- make-pages/make-pages.cabal | 4 ++- 6 files changed, 92 insertions(+), 5 deletions(-) create mode 100644 make-pages/ListTags.hs diff --git a/Makefile b/Makefile index 02b6282..eec5d72 100644 --- a/Makefile +++ b/Makefile @@ -68,9 +68,11 @@ $(TMPDIR)/index.mk: $(DATADIR)/index.yaml $(YAMLS) $(MAKEPAGES) ifneq ($(MAKECMDGOALS),clean) ifneq ($(MAKECMDGOALS),distclean) +ifneq ($(MAKECMDGOALS),list-tags) -include $(TMPDIR)/index.mk endif endif +endif .PHONY: clean distclean @@ -82,6 +84,11 @@ distclean: clean rm -rf dist-newstyle +.PHONY: list-tags +list-tags: $(MAKEPAGES) + $(MAKEPAGES) list-tags -Un + + HOST ?= gallery.niss.website REMOTE_USER ?= www-data IDFILE ?= ~/.ssh/xyz diff --git a/make-pages/BuilderQQ.hs b/make-pages/BuilderQQ.hs index 97019ea..a73308c 100644 --- a/make-pages/BuilderQQ.hs +++ b/make-pages/BuilderQQ.hs @@ -114,7 +114,7 @@ chunks = reverse . go "" [] . trimEnd where = (var, s') splitVar _ = error "invalid variable name" - isIdChar c = isAlphaNum c || c `elem` ['_', '\''] + isIdChar c = isAlphaNum c || c `elem` ("_'" :: String) lit s = (Lit, toStrictText s) diff --git a/make-pages/ListTags.hs b/make-pages/ListTags.hs new file mode 100644 index 0000000..76ff723 --- /dev/null +++ b/make-pages/ListTags.hs @@ -0,0 +1,54 @@ +module ListTags where + +import Info + +import Control.Monad +import Data.Foldable +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.HashSet (HashSet) +import qualified Data.HashSet as HashSet +import Data.List (sort) +import Data.Tuple (swap) +import Text.Printf (printf) + + +type TagStats = HashMap Text Int +type PathSet = HashSet FilePath + +data Stats = + Stats { + tags :: TagStats, + untagged :: PathSet + } + +instance Semigroup Stats where + Stats {tags = t1, untagged = u1} <> Stats {tags = t2, untagged = u2} = + Stats {tags = HashMap.unionWith (+) t1 t2, untagged = u1 <> u2} + +instance Monoid Stats where + mempty = Stats {tags = [], untagged = []} + + +stats1 :: Bool -> FilePath -> Info -> Stats +stats1 nsfw path (Info {tags, nsfwTags}) = + let tags' = if nsfw then tags <> nsfwTags else tags in + if null tags' then + Stats {tags = [], untagged = [path]} + else + Stats {tags = HashMap.fromList $ map (, 1) tags', untagged = []} + +stats :: Bool -> [(FilePath, Info)] -> Stats +stats nsfw = foldMap $ uncurry $ stats1 nsfw + +run :: Bool -> Bool -> [(FilePath, Info)] -> IO () +run nsfw listUntagged infos = do + let Stats {tags, untagged} = stats nsfw infos + let sortedTags = reverse $ sort $ map swap $ HashMap.toList tags + putStrLn "TAGS\n----" + for_ sortedTags \(count, path) -> + printf "%4d: %s\n" count path + when (listUntagged && not (null untagged)) $ do + let sortedUntagged = sort $ HashSet.toList untagged + putStrLn "\nUNTAGGED FILES\n--------------" + for_ sortedUntagged $ printf " - %s\n" diff --git a/make-pages/Main.hs b/make-pages/Main.hs index 841fe4b..ae797b6 100644 --- a/make-pages/Main.hs +++ b/make-pages/Main.hs @@ -20,6 +20,7 @@ import qualified SinglePage import qualified GalleryPage import qualified IndexPage import qualified RSS +import qualified ListTags #ifdef PRETTY_VERBOSE import qualified Text.PrettyPrint as PP @@ -81,14 +82,18 @@ main2 (DependSingle {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) =<< - find always (fileName ==? infoName) dataDir + infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName printV $ "info files" := infos let dependGallery0 g = dependGallery' g infos buildDir dataDir tmpDir let deps = toLazyText $ mconcat $ intersperse "\n\n\n" $ map dependGallery0 galleries writeOutput output deps +main2 (ListTags {nsfw, listUntagged, dataDir, infoName}) = do + infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName + ListTags.run nsfw listUntagged infos + + infoYAML :: FilePath -- ^ data dir -> FilePath -- ^ yaml file -> IO (FilePath, Info) -- relative filename, contents @@ -97,6 +102,8 @@ infoYAML dataDir f = do info <- readYAML f pure (f', info) +findInfos :: FilePath -> FilePath -> IO [FilePath] +findInfos dataDir infoName = find always (fileName ==? infoName) dataDir readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML file = ByteString.readFile file >>= decode1Must file diff --git a/make-pages/Options.hs b/make-pages/Options.hs index 0398130..ad30cea 100644 --- a/make-pages/Options.hs +++ b/make-pages/Options.hs @@ -54,6 +54,12 @@ data ModeOptions = tmpDir :: FilePath, infoName :: FilePath } + | ListTags { + dataDir :: FilePath, + infoName :: FilePath, + nsfw :: Bool, + listUntagged :: Bool + } deriving Show @@ -64,7 +70,8 @@ optionsParser = globalOpts `info` mainInfo where short 'v' <> long "verbose" <> help "print extra stuff to stderr" subcommands = hsubparser $ - single <> gallery <> index <> rss <> dependSingle <> dependGallery + single <> gallery <> index <> rss <> dependSingle <> dependGallery <> + listTags single = command "single" $ singleOpts `info` singleInfo singleOpts = SinglePage <$> file <*> dataDir <*> nsfwS <*> output @@ -136,6 +143,16 @@ optionsParser = globalOpts `info` mainInfo where help "temporary directory (default: _tmp)" dgInfo = progDesc "generate makefile dependencies for a gallery" + listTags = command "list-tags" $ ltOpts `info` ltInfo + ltOpts = ListTags <$> dataDir <*> infoName <*> nsfwT <*> listUntagged_ + nsfwT = switch $ + short 'n' <> long "nsfw" <> + help "include nsfw tags" + listUntagged_ = switch $ + short 'U' <> long "untagged" <> + help "list files with no tags" + ltInfo = progDesc "list all tags used by frequency" + mainInfo = progDesc "static gallery site generator" <> fullDesc diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 5b0cc94..40312b9 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -19,7 +19,8 @@ executable make-pages GalleryPage, Info, IndexPage, - Options + ListTags, + Options, Records, SinglePage, RSS @@ -35,6 +36,7 @@ executable make-pages LambdaCase, NamedFieldPuns, OverloadedLabels, + OverloadedLists, OverloadedStrings, PatternSynonyms, QuasiQuotes,