gallery/make-pages/Main.hs
2021-04-16 23:48:53 +02:00

115 lines
3.3 KiB
Haskell

{-# 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 (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, output, dataDir}) = do
infos <- mapM (infoYAML dataDir) files
printV $ "infos" := infos
let page = GalleryPage.make title infos
writeOutput output page
main2 (IndexPage {file, output}) = do
ginfos <- readYAML file
printV $ "galleries" := ginfos
let page = IndexPage.make ginfos
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
ginfos <- readYAML @[_] file
printV $ "galleries" := ginfos
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 ginfos
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