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
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.Text.Lazy.IO as Text
import qualified Options.Applicative as Opt
import System.IO (hPrint, stderr)
import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)
import Control.Applicative
import Control.Monad
import SinglePage
#ifdef PRETTY_VERBOSE
import Text.Show.Pretty (ppShow)
#endif
data Options =
Options {
verbose :: Bool,
@ -67,13 +72,13 @@ optionsParser = globalOpts `Opt.info` mainInfo where
main :: IO ()
main = do
opts <- Opt.execParser optionsParser
printVerbose opts opts
printV opts $ "options" :- opts
main2 opts
main2 :: Options -> IO ()
main2 opts@(Options {mode = SinglePage {file, nsfw, output}}) = do
info <- readYAML file
printVerbose opts info
printV opts $ "contents" :- info
let page = make nsfw info
case output of
Nothing -> Text.putStr page
@ -83,8 +88,15 @@ main2 (Options {mode = GalleryPage {}}) = do
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 file = ByteString.readFile file >>= decode1Must file
@ -95,3 +107,9 @@ decode1Must file txt =
Right val -> pure val
Left (YAML.Pos {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>
maintainer: Rhiannon Morris <rhi@rhiannon.website>
flag pretty-verbose
description: pretty-print the verbose output
default: True
executable make-pages
hs-source-dirs: .
main-is: Main.hs
@ -28,12 +32,17 @@ executable make-pages
ViewPatterns
build-depends:
base >= 4.12.0.0 && < 4.15,
containers ^>= 0.6.0.1,
time >= 1.8.0.2 && < 1.10,
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,
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:
-Wall -threaded -rtsopts -with-rtsopts=-N
if flag(pretty-verbose)
build-depends:
pretty-show ^>= 1.10
cpp-options: -DPRETTY_VERBOSE