157 lines
5 KiB
Haskell
157 lines
5 KiB
Haskell
{-# LANGUAGE CPP, ImplicitParams #-}
|
|
module Main (main) where
|
|
|
|
import Control.Monad
|
|
import Data.ByteString.Lazy (ByteString)
|
|
import qualified Data.ByteString.Lazy as ByteString
|
|
import Data.List (intersperse)
|
|
import qualified Data.List as List
|
|
import Data.Text.Lazy (Text)
|
|
import Data.Text.Lazy.Builder (toLazyText)
|
|
import qualified Data.Text as Strict
|
|
import qualified Data.Text.Lazy.IO as Text
|
|
import qualified Data.YAML as YAML
|
|
import System.FilePath (makeRelative, takeDirectory, takeFileName)
|
|
import System.FilePath.Find (always, fileName, (==?))
|
|
import qualified System.FilePath.Find as File
|
|
import System.IO (hPrint, stderr)
|
|
|
|
import Depend
|
|
import Info hiding (Text)
|
|
import Options
|
|
import qualified SinglePage
|
|
import qualified GalleryPage
|
|
import qualified IndexPage
|
|
import qualified RSS
|
|
import qualified ListTags
|
|
import TagTransforms
|
|
|
|
#ifdef PRETTY_VERBOSE
|
|
import qualified Text.PrettyPrint as PP
|
|
import qualified Text.Show.Pretty as PP
|
|
import Data.Function ((&))
|
|
#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 {root, file, prefix, index, dataDir, nsfw, output}) = do
|
|
iinfo <- readYAML index
|
|
info <- transformInfoTags iinfo.tags <$> readYAML file
|
|
printV $ "contents" := info
|
|
let dir = takeDirectory $ makeRelative dataDir file
|
|
page <- SinglePage.make root iinfo prefix nsfw dataDir dir info
|
|
writeOutput output page
|
|
|
|
main2 (GalleryPage {root, files, prefix, index, output, dataDir}) = do
|
|
(iinfo, _, ginfo) <- galleryFromIndex index prefix
|
|
printV $ "gallery_info" := ginfo
|
|
infos <- traverse (infoYAML dataDir) files
|
|
& fmap (fmap $ fmap $ transformInfoTags iinfo.tags)
|
|
printV $ "infos" := infos
|
|
let page = GalleryPage.make root iinfo ginfo infos
|
|
writeOutput output page
|
|
|
|
main2 (IndexPage {root, file, output}) = do
|
|
info <- readYAML file
|
|
printV $ "info" := info
|
|
let page = IndexPage.make root info
|
|
writeOutput output page
|
|
|
|
main2 (RSS {files, root, index, prefix, output, dataDir}) = do
|
|
(_, name, ginfo) <- galleryFromIndex index prefix
|
|
printV $ "gallery_info" := ginfo
|
|
infos <- traverse (infoYAML dataDir) files
|
|
printV $ "infos" := infos
|
|
let output' = takeFileName <$> output
|
|
let rss = RSS.make root name ginfo output' infos
|
|
writeOutput output rss
|
|
|
|
main2 (DependSingle {index, 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 index info prefix buildDir nsfw
|
|
writeOutput output deps
|
|
|
|
main2 (DependGallery {file, output, buildDir, dataDir, tmpDir, infoName}) = do
|
|
IndexInfo {galleries} <- readYAML file
|
|
printV $ "galleries" := galleries
|
|
infos <- findInfos dataDir infoName
|
|
>>= traverse (infoYAML dataDir)
|
|
printV $ "info_files" := infos
|
|
let dependGallery0 g = dependGallery' g file infos buildDir dataDir tmpDir
|
|
let deps = toLazyText $ mconcat $ intersperse "\n\n\n" $
|
|
map dependGallery0 galleries
|
|
writeOutput output deps
|
|
|
|
main2 (ListTags {nsfw, listUntagged, showWarnings, index,
|
|
dataDir, infoName, sortBy}) = do
|
|
printV $ "index" := index
|
|
iinfo <- readYAML index
|
|
infos <- findInfos dataDir infoName >>= traverse (infoYAML dataDir)
|
|
printV $ "info_files" := infos
|
|
ListTags.run iinfo nsfw listUntagged showWarnings sortBy infos
|
|
|
|
|
|
-- | applies tag transformations also
|
|
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)
|
|
|
|
findInfos :: FilePath -> FilePath -> IO [FilePath]
|
|
findInfos dataDir infoName =
|
|
File.findL True always (fileName ==? infoName) dataDir
|
|
|
|
readYAML :: YAML.FromYAML a => FilePath -> IO a
|
|
readYAML file = ByteString.readFile file >>= decode1Must file
|
|
|
|
galleryFromIndex :: FilePath -> FilePath ->
|
|
IO (IndexInfo, Strict.Text, GalleryInfo)
|
|
galleryFromIndex file prefix = do
|
|
iinfo@(IndexInfo {title, galleries}) <- readYAML file
|
|
maybe (fail $ "no gallery with prefix " ++ prefix)
|
|
(pure . (iinfo, title,)) $
|
|
List.find (\g -> g.prefix == prefix) galleries
|
|
|
|
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
|