fiddle with verbose stuff

This commit is contained in:
Rhiannon Morris 2020-07-16 11:47:34 +02:00
parent cc65ebb388
commit 2844df96cd
2 changed files with 21 additions and 13 deletions

View file

@ -8,7 +8,6 @@ import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy.IO as Text import qualified Data.Text.Lazy.IO as Text
import System.IO (hPrint, stderr) import System.IO (hPrint, stderr)
import System.FilePath (makeRelative) import System.FilePath (makeRelative)
import Text.Printf (printf)
import Control.Monad import Control.Monad
import Options import Options
@ -23,17 +22,24 @@ import qualified Text.PrettyPrint as PP
type HasVerbose = (?verbose :: Bool) 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 :: IO ()
main = do main = do
opts@(Options {verbose, mode}) <- parseOptions opts@(Options {verbose, mode}) <- parseOptions
let ?verbose = verbose withVerbose verbose do
printV $ "options" :- opts printV $ "options" := opts
main2 mode main2 mode
main2 :: HasVerbose => ModeOptions -> IO () main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, nsfw, output}) = do main2 (SinglePage {file, nsfw, output}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" :- info printV $ "contents" := info
let page = make nsfw info let page = make nsfw info
writeOutput output page writeOutput output page
@ -42,15 +48,15 @@ main2 (GalleryPage {}) = do
main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" :- info printV $ "contents" := info
let path = makeRelative dataDir file let path = makeRelative dataDir file
printV $ "path" :- path printV $ "path" := path
let deps = dependSingle path info prefix buildDir nsfw let deps = dependSingle path info prefix buildDir nsfw
writeOutput output deps writeOutput output deps
main2 (DependGallery {}) = do
error "surprise! this doesn't exist yet"
printV :: (Show a, HasVerbose) => a -> IO ()
printV x = when ?verbose $ hPrint stderr x
readYAML :: YAML.FromYAML a => FilePath -> IO a readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = ByteString.readFile file >>= decode1Must file readYAML file = ByteString.readFile file >>= decode1Must file
@ -59,17 +65,18 @@ decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a
decode1Must file txt = decode1Must file txt =
case YAML.decode1 txt of case YAML.decode1 txt of
Right val -> pure val Right val -> pure val
Left (YAML.Pos {posLine, posColumn}, err) -> Left (pos, err) ->
fail $ printf "%s:%i:%i: %s" file posLine posColumn err fail $ file ++ ":" ++ YAML.prettyPosWithSource pos txt " error:" ++ err
writeOutput :: Maybe FilePath -> Text -> IO () writeOutput :: Maybe FilePath -> Text -> IO ()
writeOutput (Just f) = Text.writeFile f writeOutput (Just f) = Text.writeFile f
writeOutput Nothing = Text.putStrLn writeOutput Nothing = Text.putStrLn
data Tag a = String :- a
data Tag a = String := a
instance Show a => Show (Tag a) where instance Show a => Show (Tag a) where
show (tag :- a) = show (tag := a) =
#ifdef PRETTY_VERBOSE #ifdef PRETTY_VERBOSE
PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a) PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a)
#else #else

View file

@ -34,6 +34,7 @@ executable make-pages
OverloadedStrings, OverloadedStrings,
PatternSynonyms, PatternSynonyms,
QuasiQuotes, QuasiQuotes,
RankNTypes,
TypeSynonymInstances, TypeSynonymInstances,
ViewPatterns ViewPatterns
build-depends: build-depends: