{-# 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