{-# LANGUAGE CPP, ImplicitParams #-} module Main (main) where import qualified Data.ByteString.Lazy as ByteString import Data.ByteString.Lazy (ByteString) import qualified Data.YAML as YAML import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.IO as Text import System.IO (hPrint, stderr) import System.FilePath (makeRelative) import Text.Printf (printf) import Control.Monad import Options import SinglePage import Depend #ifdef PRETTY_VERBOSE import qualified Text.Show.Pretty as PP import qualified Text.PrettyPrint as PP #endif type HasVerbose = (?verbose :: Bool) main :: IO () main = do opts@(Options {verbose, mode}) <- parseOptions let ?verbose = verbose printV $ "options" :- opts main2 mode main2 :: HasVerbose => ModeOptions -> IO () main2 (SinglePage {file, nsfw, output}) = do info <- readYAML file printV $ "contents" :- info let page = make nsfw info writeOutput output page main2 (GalleryPage {}) = do error "surprise! this doesn't exist yet" main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do info <- readYAML file printV $ "contents" :- info let path = makeRelative dataDir file printV $ "path" :- path let deps = dependSingle path info prefix buildDir nsfw writeOutput output deps printV :: (Show a, HasVerbose) => a -> IO () printV x = when ?verbose $ hPrint stderr x 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 (YAML.Pos {posLine, posColumn}, err) -> fail $ printf "%s:%i:%i: %s" file posLine posColumn 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