add verbose flag

This commit is contained in:
Rhiannon Morris 2020-07-13 05:01:57 +02:00
parent ca672ddefa
commit 41af58c1e4

View file

@ -1,14 +1,24 @@
module Main (main) where
import qualified Data.ByteString.Lazy as ByteString
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 Text.Printf (printf)
import Control.Applicative
import Control.Monad
import SinglePage
data Options =
Options {
verbose :: Bool,
mode :: ModeOptions
}
deriving Show
data ModeOptions =
SinglePage {
file :: FilePath,
includeNsfw :: Bool,
@ -23,9 +33,13 @@ data Options =
deriving Show
optionsParser :: Opt.ParserInfo Options
optionsParser =
(Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo
where
optionsParser = globalOpts `Opt.info` mainInfo where
globalOpts = Options <$> verboseOpt <*> subcommands <**> Opt.helper
verboseOpt = Opt.switch $
Opt.short 'v' <> Opt.long "verbose" <>
Opt.help "print extra stuff to stderr"
subcommands = Opt.hsubparser (single <> gallery)
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt <*> copyOpt
fileArg = Opt.strArgument $
@ -55,24 +69,32 @@ optionsParser =
main :: IO ()
main = main2 =<< Opt.execParser optionsParser
main = do
opts <- Opt.execParser optionsParser
printVerbose opts opts
main2 opts
main2 :: Options -> IO ()
main2 s@(SinglePage {file, includeNsfw, output}) = do
print s
page <- make includeNsfw <$> readYAML file
main2 (Options {mode = SinglePage {file, includeNsfw, output}}) = do
info <- readYAML file
print info
let page = make includeNsfw info
case output of
Nothing -> Text.putStr page
Just out -> Text.writeFile out page
main2 g@(GalleryPage {}) = do
print g
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
readYAML :: YAML.FromYAML a => FilePath -> IO a
readYAML file = do
txt <- ByteString.readFile file
readYAML file = ByteString.readFile file >>= decode1Must file
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) ->