gallery/make-pages/Main.hs

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

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

import Depend
import Info hiding (Text)
import Options
import qualified SinglePage
import qualified GalleryPage
import qualified IndexPage
import qualified RSS
import qualified ListTags
import TagTransforms

#ifdef PRETTY_VERBOSE
import qualified Text.PrettyPrint as PP
import qualified Text.Show.Pretty as PP
import Data.Function ((&))
#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 {root, file, prefix, index, dataDir, nsfw, output}) = do
  iinfo <- readYAML index
  info <- transformInfoTags iinfo.tags <$> readYAML file
  printV $ "contents" := info
  let dir = takeDirectory $ makeRelative dataDir file
  page <- SinglePage.make root iinfo prefix nsfw dataDir dir info
  writeOutput output page

main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do
  (iinfo, _, ginfo) <- galleryFromIndex index prefix
  printV $ "gallery_info" := ginfo
  infos <- traverse (infoYAML dataDir) files
           & fmap (fmap $ fmap $ transformInfoTags iinfo.tags)
  printV $ "infos" := infos
  let page = GalleryPage.make root iinfo ginfo infos
  writeOutput output page

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

main2 (RSS {files, root, index, prefix, output, dataDir}) = do
  (_, name, ginfo) <- galleryFromIndex index prefix
  printV $ "gallery_info" := ginfo
  infos <- traverse (infoYAML dataDir) files
  printV $ "infos" := infos
  let output' = takeFileName <$> output
  let rss = RSS.make root name ginfo output' infos
  writeOutput output rss

main2 (DependSingle {index, 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 index info prefix buildDir nsfw
  writeOutput output deps

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

main2 (ListTags {nsfw, listUntagged, showWarnings, index,
                 dataDir, infoName, sortBy}) = do
  printV $ "index" := index
  iinfo <- readYAML index
  infos <- findInfos dataDir infoName >>= traverse (infoYAML dataDir)
  printV $ "info_files" := infos
  ListTags.run iinfo nsfw listUntagged showWarnings sortBy infos


-- | applies tag transformations also
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 =
  File.findL True always (fileName ==? infoName) dataDir

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

galleryFromIndex :: FilePath -> FilePath ->
                    IO (IndexInfo, Strict.Text, GalleryInfo)
galleryFromIndex file prefix = do
  iinfo@(IndexInfo {title, galleries}) <- readYAML file
  maybe (fail $ "no gallery with prefix " ++ prefix)
        (pure . (iinfo, title,)) $
    List.find (\g -> g.prefix == prefix) galleries

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