{-# 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) 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 #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, nsfw, output}) = do info <- readYAML file printV $ "contents" := info let page = SinglePage.make nsfw info writeOutput output page main2 (GalleryPage {title, files, nsfw, output, dataDir}) = do infos <- mapM (infoYAML dataDir) files printV $ "infos" := infos let page = GalleryPage.make title 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 (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) =<< find always (fileName ==? infoName) dataDir 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 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) 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