add readable verbose output
This commit is contained in:
parent
40ffd4f22c
commit
3586a5b447
2 changed files with 36 additions and 9 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue