option to list tags by name

This commit is contained in:
Rhiannon Morris 2021-03-07 20:51:44 +01:00
parent da23a052f0
commit c1d588f702
3 changed files with 22 additions and 8 deletions

View file

@ -1,6 +1,7 @@
module ListTags where
import Info
import Options (TagSort (..))
import Control.Monad
import Data.Foldable
@ -8,7 +9,8 @@ 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.List (sort, sortBy)
import Data.Ord (comparing)
import Data.Tuple (swap)
import Text.Printf (printf)
@ -41,10 +43,10 @@ stats1 nsfw path (Info {tags, nsfwTags}) =
stats :: Bool -> [(FilePath, Info)] -> Stats
stats nsfw = foldMap $ uncurry $ stats1 nsfw
run :: Bool -> Bool -> [(FilePath, Info)] -> IO ()
run nsfw listUntagged infos = do
run :: Bool -> Bool -> TagSort -> [(FilePath, Info)] -> IO ()
run nsfw listUntagged ts infos = do
let Stats {tags, untagged} = stats nsfw infos
let sortedTags = reverse $ sort $ map swap $ HashMap.toList tags
let sortedTags = sortBy (cmp ts) $ map swap $ HashMap.toList tags
putStrLn "TAGS\n----"
for_ sortedTags \(count, path) ->
printf "%4d: %s\n" count path
@ -52,3 +54,7 @@ run nsfw listUntagged infos = do
let sortedUntagged = sort $ HashSet.toList untagged
putStrLn "\nUNTAGGED FILES\n--------------"
for_ sortedUntagged $ printf " - %s\n"
cmp :: TagSort -> (Int, Text) -> (Int, Text) -> Ordering
cmp SortFreq = flip $ comparing fst
cmp SortName = comparing snd

View file

@ -95,10 +95,10 @@ main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
map dependGallery0 galleries
writeOutput output deps
main2 (ListTags {nsfw, listUntagged, dataDir, infoName}) = do
main2 (ListTags {nsfw, listUntagged, dataDir, infoName, sortBy}) = do
infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
printV $ "info_files" := infos
ListTags.run nsfw listUntagged infos
ListTags.run nsfw listUntagged sortBy infos
infoYAML :: FilePath -- ^ data dir

View file

@ -60,10 +60,13 @@ data ModeOptions =
dataDir :: FilePath,
infoName :: FilePath,
nsfw :: Bool,
listUntagged :: Bool
listUntagged :: Bool,
sortBy :: TagSort
}
deriving Show
data TagSort = SortFreq | SortName deriving Show
optionsParser :: ParserInfo Options
optionsParser = globalOpts `info` mainInfo where
@ -142,13 +145,18 @@ optionsParser = globalOpts `info` mainInfo where
dgInfo = progDesc "generate makefile dependencies for a gallery"
listTags = command "list-tags" $ ltOpts `info` ltInfo
ltOpts = ListTags <$> dataDir <*> infoName <*> nsfwT <*> listUntagged_
ltOpts = ListTags <$> dataDir <*> infoName <*> nsfwT
<*> listUntagged_ <*> listSort
nsfwT = switch $
short 'n' <> long "nsfw" <>
help "include nsfw tags"
listUntagged_ = switch $
short 'U' <> long "untagged" <>
help "list files with no tags"
listSort = fmap toSort $ switch $
short 'a' <> long "alpha" <>
help "sort alphabetically instead of by frequency"
where toSort x = if x then SortName else SortFreq
ltInfo = progDesc "list all tags used by frequency"
mainInfo = progDesc "static gallery site generator" <> fullDesc