gallery/make-pages/Main.hs

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