gallery/make-pages/ListTags.hs

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