{-# LANGUAGE NamedFieldPuns #-}
module Main (main) where

import qualified Data.ByteString.Lazy as LazyBS
import Data.Foldable
import Data.Function ((&))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Misc
import qualified System.FilePath.Find as Find
import YAML ((##=), (.!=), (.:))
import qualified YAML
import System.Environment
import qualified Data.Text.IO as Text
import qualified Data.Text as Text
import Data.Char


main :: IO ()
main = do
  Opts {dir, yaml, make} <- getOptions
  files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
  tags  <- traverse getTags files
  LazyBS.writeFile yaml $ makeYAML tags
  Text.writeFile make $ makeMake tags

getTags :: FilePath -> IO (Set Text)
getTags file = do
  yaml <- YAML.readHeader file
  list <- unwrap file $ YAML.parseEither $
    yaml & YAML.withMap "yaml header" \m -> m .: "tags" .!= []
  pure $ Set.fromList list

makeYAML :: [Set Text] -> LazyBS.ByteString
makeYAML tags = "---\n" <> yaml <> "\n...\n" where
  yaml = YAML.encode1 $ YAML.obj
    [("title" ##= YAML.str "all tags"),
     ("tags"  ##= collate tags)]

makeMake :: [Set Text] -> Text
makeMake tags' = Text.unlines $ build : allPosts : map makeRule tags where
  build = Text.unwords $
    "build:" : ["$(BUILDDIR)/" <> t <> ".html" |
                  t <- ["all-tags", "all-posts"] <> map slug' tags]
  makeRule' opt title file =
    "$(TMPDIR)/" <> file <> ".md : $(POSTS) $(POST_LISTS)\n\
    \\t@echo \"[post-lists] $<\"\n\
    \\t$(POST_LISTS) " <> opt <> " --out $@ \\\n\
    \\t  $(POSTSDIR) \"" <> title <> "\""
  allPosts = makeRule' "" "all posts" "all-posts"
  makeRule t =
    makeRule' ("--tag \"" <> name t <> "\"")
              ("posts tagged ‘" <> name t <> "’")
              (slug' t)
  slug' (Tag {slug}) = "tag-" <> slug
  tags = collate tags'

data Tag =
  Tag {
    name :: !Text,
    slug :: !Text,
    count :: !Int
  }
  deriving Show

instance YAML.ToYAML Tag where
  toYAML (Tag {name, slug, count}) = YAML.obj $
    [("name" ##= name), ("slug" ##= slug), ("count" ##= count)]

collate :: [Set Text] -> [Tag]
collate tags₀ =
  toList $ fst $ foldl' add1 (mempty, mempty) $ foldMap toList tags₀
 where
  add1 (tags, slugs) name
    | Map.member name tags =
        (Map.adjust incrCount name tags, slugs)
    | otherwise            =
        let tag = makeTag slugs name in
        (Map.insert name tag tags,
         Set.insert (slug tag) slugs)
  makeTag slugs name =
    Tag {name, slug = makeSlug slugs name, count = 1}
  makeSlug slugs name = head $ filter (`notElem` slugs) candidates where
    slug₀ = Text.map toSlugChar name
    toSlugChar c
      | isAlphaNum c && isAscii c || c == '-' = toLower c
      | otherwise                             = '_'
    candidates = slug₀ : [slug₀ <> Text.pack (show i) | i <- [(0 :: Int) ..]]
  incrCount t@(Tag {count}) = t {count = succ count}

data Options =
  Opts {
    dir :: !FilePath,
    yaml :: !FilePath,
    make :: !FilePath
  }

getOptions :: IO Options
getOptions = do
    args <- getArgs
    prog <- getProgName
    case args of
      [dir, yaml, make] -> pure $ Opts {dir, yaml, make}
      _ -> fail $
        "usage: " <> prog <> " DIR YAML MAKE ---\n\
        \  get all tags from posts in DIR and put the results in the given files"