{-# LANGUAGE CPP, ImplicitParams, TypeApplications #-}
module Main (main) where

import Control.Monad
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as ByteString
import Data.List (intersperse)
import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Text.Lazy.IO as Text
import qualified Data.YAML as YAML
import System.FilePath (makeRelative, takeDirectory, takeFileName)
import System.FilePath.Find (find, always, fileName, (==?))
import System.IO (hPrint, stderr)

import Depend
import Info (IndexInfo (..), Info)
import Options
import qualified SinglePage
import qualified GalleryPage
import qualified IndexPage
import qualified RSS
import qualified ListTags

#ifdef PRETTY_VERBOSE
import qualified Text.PrettyPrint as PP
import qualified Text.Show.Pretty as PP
#endif


type HasVerbose = (?verbose :: Bool)

withVerbose :: Bool -> (HasVerbose => a) -> a
withVerbose v x = let ?verbose = v in x

printV :: (Show a, HasVerbose) => a -> IO ()
printV x = when ?verbose $ hPrint stderr x


main :: IO ()
main = do
  opts@(Options {verbose, mode}) <- parseOptions
  withVerbose verbose do
    printV $ "options" := opts
    main2 mode

main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, dataDir, nsfw, output}) = do
  info <- readYAML file
  printV $ "contents" := info
  let dir = takeDirectory $ makeRelative dataDir file
  let page = SinglePage.make nsfw dir info
  writeOutput output page

main2 (GalleryPage {title, prefix, files, nsfw, output, dataDir}) = do
  infos <- mapM (infoYAML dataDir) files
  printV $ "infos" := infos
  let page = GalleryPage.make title prefix nsfw infos
  writeOutput output page

main2 (IndexPage {file, output}) = do
  info <- readYAML file
  printV $ "info" := info
  let page = IndexPage.make info
  writeOutput output page

main2 (RSS {files, title, desc, root, prefix, output, dataDir}) = do
  infos <- mapM (infoYAML dataDir) files
  printV $ "infos" := infos
  let output' = takeFileName <$> output
  let rss = RSS.make root title desc prefix output' infos
  writeOutput output rss

main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
  info <- readYAML file
  printV $ "contents" := info
  let dir = takeDirectory $ makeRelative dataDir file
  printV $ "dir" := dir
  let deps = dependSingle dir info prefix buildDir nsfw
  writeOutput output deps

main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
  IndexInfo {galleries} <- readYAML file
  printV $ "galleries" := galleries
  infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
  printV $ "info files" := infos
  let dependGallery0 g = dependGallery' g infos buildDir dataDir tmpDir
  let deps = toLazyText $ mconcat $ intersperse "\n\n\n" $
        map dependGallery0 galleries
  writeOutput output deps

main2 (ListTags {nsfw, listUntagged, dataDir, infoName}) = do
  infos <- mapM (infoYAML dataDir) =<< findInfos dataDir infoName
  printV $ "info files" := infos
  ListTags.run nsfw listUntagged infos


infoYAML :: FilePath -- ^ data dir
         -> FilePath -- ^ yaml file
         -> IO (FilePath, Info) -- relative filename, contents
infoYAML dataDir f = do
  let f' = makeRelative dataDir f
  info <- readYAML f
  pure (f', info)

findInfos :: FilePath -> FilePath -> IO [FilePath]
findInfos dataDir infoName = find always (fileName ==? infoName) dataDir

readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = ByteString.readFile file >>= decode1Must file

decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a
decode1Must file txt =
  case YAML.decode1 txt of
    Right val -> pure val
    Left (pos, err) ->
      fail $ file ++ ":" ++ YAML.prettyPosWithSource pos txt " error:" ++ err

writeOutput :: Maybe FilePath -> Text -> IO ()
writeOutput (Just f) = Text.writeFile f
writeOutput Nothing  = Text.putStrLn


data Tag a = String := a

instance Show a => Show (Tag a) where
  show (tag := a) =
#ifdef PRETTY_VERBOSE
    PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a)
#else
    tag ++ ": " ++ show a
#endif