85 lines
2.1 KiB
Haskell
85 lines
2.1 KiB
Haskell
{-# 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 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)
|
|
|
|
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 = 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
|
|
|
|
main2 (DependGallery {}) = do
|
|
error "surprise! this doesn't exist yet"
|
|
|
|
|
|
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
|