add readable verbose output

This commit is contained in:
Rhiannon Morris 2020-07-15 11:43:57 +02:00
parent 40ffd4f22c
commit 3586a5b447
2 changed files with 36 additions and 9 deletions

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
module Main (main) where module Main (main) where
import qualified Data.ByteString.Lazy as ByteString import qualified Data.ByteString.Lazy as ByteString
@ -5,12 +6,16 @@ import Data.ByteString.Lazy (ByteString)
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import qualified Data.Text.Lazy.IO as Text import qualified Data.Text.Lazy.IO as Text
import qualified Options.Applicative as Opt import qualified Options.Applicative as Opt
import System.IO (hPrint, stderr) import System.IO (hPutStrLn, stderr)
import Text.Printf (printf) import Text.Printf (printf)
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import SinglePage import SinglePage
#ifdef PRETTY_VERBOSE
import Text.Show.Pretty (ppShow)
#endif
data Options = data Options =
Options { Options {
verbose :: Bool, verbose :: Bool,
@ -67,13 +72,13 @@ optionsParser = globalOpts `Opt.info` mainInfo where
main :: IO () main :: IO ()
main = do main = do
opts <- Opt.execParser optionsParser opts <- Opt.execParser optionsParser
printVerbose opts opts printV opts $ "options" :- opts
main2 opts main2 opts
main2 :: Options -> IO () main2 :: Options -> IO ()
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
info <- readYAML file info <- readYAML file
printVerbose opts info printV opts $ "contents" :- info
let page = make nsfw info let page = make nsfw info
case output of case output of
Nothing -> Text.putStr page Nothing -> Text.putStr page
@ -83,8 +88,15 @@ main2 (Options {mode = GalleryPage {}}) = do
error "surprise! this doesn't exist yet" error "surprise! this doesn't exist yet"
printVerbose :: Show a => Options -> a -> IO ()
printVerbose (Options {verbose}) x = when verbose $ hPrint stderr x printV :: Show a => Options -> a -> IO ()
printV (Options {verbose}) x =
when verbose $ hPutStrLn stderr $
#ifdef PRETTY_VERBOSE
ppShow x
#else
show x
#endif
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
@ -95,3 +107,9 @@ decode1Must file txt =
Right val -> pure val Right val -> pure val
Left (YAML.Pos {posLine, posColumn}, err) -> Left (YAML.Pos {posLine, posColumn}, err) ->
fail $ printf "%s:%i:%i: %s" file posLine posColumn err fail $ printf "%s:%i:%i: %s" file posLine posColumn err
writeOutput :: Maybe FilePath -> Text -> IO ()
writeOutput (Just f) = Text.writeFile f
writeOutput Nothing = Text.putStrLn
data Tag a = String :- a deriving Show

View File

@ -6,6 +6,10 @@ license: AGPL-3.0-or-later
author: Rhiannon Morris <rhi@rhiannon.website> author: Rhiannon Morris <rhi@rhiannon.website>
maintainer: Rhiannon Morris <rhi@rhiannon.website> maintainer: Rhiannon Morris <rhi@rhiannon.website>
flag pretty-verbose
description: pretty-print the verbose output
default: True
executable make-pages executable make-pages
hs-source-dirs: . hs-source-dirs: .
main-is: Main.hs main-is: Main.hs
@ -28,12 +32,17 @@ executable make-pages
ViewPatterns ViewPatterns
build-depends: build-depends:
base >= 4.12.0.0 && < 4.15, base >= 4.12.0.0 && < 4.15,
containers ^>= 0.6.0.1,
time >= 1.8.0.2 && < 1.10,
bytestring ^>= 0.10.8.2, bytestring ^>= 0.10.8.2,
text ^>= 1.2.3.1, containers ^>= 0.6.0.1,
directory ^>= 1.3.6.0,
HsYAML ^>= 0.2.1.0, HsYAML ^>= 0.2.1.0,
optparse-applicative ^>= 0.15.1.0, optparse-applicative ^>= 0.15.1.0,
template-haskell ^>= 2.16.0.0 template-haskell ^>= 2.16.0.0,
text ^>= 1.2.3.1,
time >= 1.8.0.2 && < 1.10
ghc-options: ghc-options:
-Wall -threaded -rtsopts -with-rtsopts=-N -Wall -threaded -rtsopts -with-rtsopts=-N
if flag(pretty-verbose)
build-depends:
pretty-show ^>= 1.10
cpp-options: -DPRETTY_VERBOSE