option to list tags by name
This commit is contained in:
parent
da23a052f0
commit
c1d588f702
3 changed files with 22 additions and 8 deletions
|
@ -1,6 +1,7 @@
|
||||||
module ListTags where
|
module ListTags where
|
||||||
|
|
||||||
import Info
|
import Info
|
||||||
|
import Options (TagSort (..))
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
|
@ -8,7 +9,8 @@ import Data.HashMap.Strict (HashMap)
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
import Data.HashSet (HashSet)
|
import Data.HashSet (HashSet)
|
||||||
import qualified Data.HashSet as 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 Data.Tuple (swap)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
|
||||||
|
@ -41,10 +43,10 @@ stats1 nsfw path (Info {tags, nsfwTags}) =
|
||||||
stats :: Bool -> [(FilePath, Info)] -> Stats
|
stats :: Bool -> [(FilePath, Info)] -> Stats
|
||||||
stats nsfw = foldMap $ uncurry $ stats1 nsfw
|
stats nsfw = foldMap $ uncurry $ stats1 nsfw
|
||||||
|
|
||||||
run :: Bool -> Bool -> [(FilePath, Info)] -> IO ()
|
run :: Bool -> Bool -> TagSort -> [(FilePath, Info)] -> IO ()
|
||||||
run nsfw listUntagged infos = do
|
run nsfw listUntagged ts infos = do
|
||||||
let Stats {tags, untagged} = stats nsfw infos
|
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----"
|
putStrLn "TAGS\n----"
|
||||||
for_ sortedTags \(count, path) ->
|
for_ sortedTags \(count, path) ->
|
||||||
printf "%4d: %s\n" count path
|
printf "%4d: %s\n" count path
|
||||||
|
@ -52,3 +54,7 @@ run nsfw listUntagged infos = do
|
||||||
let sortedUntagged = sort $ HashSet.toList untagged
|
let sortedUntagged = sort $ HashSet.toList untagged
|
||||||
putStrLn "\nUNTAGGED FILES\n--------------"
|
putStrLn "\nUNTAGGED FILES\n--------------"
|
||||||
for_ sortedUntagged $ printf " - %s\n"
|
for_ sortedUntagged $ printf " - %s\n"
|
||||||
|
|
||||||
|
cmp :: TagSort -> (Int, Text) -> (Int, Text) -> Ordering
|
||||||
|
cmp SortFreq = flip $ comparing fst
|
||||||
|
cmp SortName = comparing snd
|
||||||
|
|
|
@ -95,10 +95,10 @@ main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
|
||||||
map dependGallery0 galleries
|
map dependGallery0 galleries
|
||||||
writeOutput output deps
|
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
|
infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
|
||||||
printV $ "info_files" := infos
|
printV $ "info_files" := infos
|
||||||
ListTags.run nsfw listUntagged infos
|
ListTags.run nsfw listUntagged sortBy infos
|
||||||
|
|
||||||
|
|
||||||
infoYAML :: FilePath -- ^ data dir
|
infoYAML :: FilePath -- ^ data dir
|
||||||
|
|
|
@ -60,10 +60,13 @@ data ModeOptions =
|
||||||
dataDir :: FilePath,
|
dataDir :: FilePath,
|
||||||
infoName :: FilePath,
|
infoName :: FilePath,
|
||||||
nsfw :: Bool,
|
nsfw :: Bool,
|
||||||
listUntagged :: Bool
|
listUntagged :: Bool,
|
||||||
|
sortBy :: TagSort
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
|
data TagSort = SortFreq | SortName deriving Show
|
||||||
|
|
||||||
|
|
||||||
optionsParser :: ParserInfo Options
|
optionsParser :: ParserInfo Options
|
||||||
optionsParser = globalOpts `info` mainInfo where
|
optionsParser = globalOpts `info` mainInfo where
|
||||||
|
@ -142,13 +145,18 @@ optionsParser = globalOpts `info` mainInfo where
|
||||||
dgInfo = progDesc "generate makefile dependencies for a gallery"
|
dgInfo = progDesc "generate makefile dependencies for a gallery"
|
||||||
|
|
||||||
listTags = command "list-tags" $ ltOpts `info` ltInfo
|
listTags = command "list-tags" $ ltOpts `info` ltInfo
|
||||||
ltOpts = ListTags <$> dataDir <*> infoName <*> nsfwT <*> listUntagged_
|
ltOpts = ListTags <$> dataDir <*> infoName <*> nsfwT
|
||||||
|
<*> listUntagged_ <*> listSort
|
||||||
nsfwT = switch $
|
nsfwT = switch $
|
||||||
short 'n' <> long "nsfw" <>
|
short 'n' <> long "nsfw" <>
|
||||||
help "include nsfw tags"
|
help "include nsfw tags"
|
||||||
listUntagged_ = switch $
|
listUntagged_ = switch $
|
||||||
short 'U' <> long "untagged" <>
|
short 'U' <> long "untagged" <>
|
||||||
help "list files with no tags"
|
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"
|
ltInfo = progDesc "list all tags used by frequency"
|
||||||
|
|
||||||
mainInfo = progDesc "static gallery site generator" <> fullDesc
|
mainInfo = progDesc "static gallery site generator" <> fullDesc
|
||||||
|
|
Loading…
Reference in a new issue