61 lines
1.7 KiB
Haskell
61 lines
1.7 KiB
Haskell
module ListTags where
|
|
|
|
import Info
|
|
import Options (TagSort (..))
|
|
|
|
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, sortBy)
|
|
import Data.Ord (comparing)
|
|
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 -> TagSort -> [(FilePath, Info)] -> IO ()
|
|
run nsfw listUntagged ts infos = do
|
|
let Stats {tags, untagged} = stats nsfw infos
|
|
let sortedTags = sortBy (cmp ts) $ 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"
|
|
|
|
cmp :: TagSort -> (Int, Text) -> (Int, Text) -> Ordering
|
|
cmp SortFreq = flip $ comparing fst
|
|
cmp SortName = comparing snd
|