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 System.IO (hPrint, stderr)
import System.FilePath (makeRelative)
import Text.Printf (printf)
import Control.Monad
import Options
@ -23,17 +22,24 @@ import qualified Text.PrettyPrint as PP
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
let ?verbose = verbose
printV $ "options" :- opts
main2 mode
withVerbose verbose do
printV $ "options" := opts
main2 mode
main2 :: HasVerbose => ModeOptions -> IO ()
main2 (SinglePage {file, nsfw, output}) = do
info <- readYAML file
printV $ "contents" :- info
printV $ "contents" := info
let page = make nsfw info
writeOutput output page
@ -42,15 +48,15 @@ main2 (GalleryPage {}) = do
main2 (DependSingle {file, nsfw, output, prefix, buildDir, dataDir}) = do
info <- readYAML file
printV $ "contents" :- info
printV $ "contents" := info
let path = makeRelative dataDir file
printV $ "path" :- path
printV $ "path" := path
let deps = dependSingle path info prefix buildDir nsfw
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 file = ByteString.readFile file >>= decode1Must file
@ -59,17 +65,18 @@ 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
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
data Tag a = String := a
instance Show a => Show (Tag a) where
show (tag :- a) =
show (tag := a) =
#ifdef PRETTY_VERBOSE
PP.render $ PP.hang (PP.text tag <> ":") 2 (PP.ppDoc a)
#else

View file

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