add verbose flag
This commit is contained in:
parent
ca672ddefa
commit
41af58c1e4
1 changed files with 33 additions and 11 deletions
|
@ -1,14 +1,24 @@
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as ByteString
|
import qualified Data.ByteString.Lazy as ByteString
|
||||||
|
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 Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
import SinglePage
|
import SinglePage
|
||||||
|
|
||||||
data Options =
|
data Options =
|
||||||
|
Options {
|
||||||
|
verbose :: Bool,
|
||||||
|
mode :: ModeOptions
|
||||||
|
}
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
data ModeOptions =
|
||||||
SinglePage {
|
SinglePage {
|
||||||
file :: FilePath,
|
file :: FilePath,
|
||||||
includeNsfw :: Bool,
|
includeNsfw :: Bool,
|
||||||
|
@ -23,9 +33,13 @@ data Options =
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
optionsParser :: Opt.ParserInfo Options
|
optionsParser :: Opt.ParserInfo Options
|
||||||
optionsParser =
|
optionsParser = globalOpts `Opt.info` mainInfo where
|
||||||
(Opt.hsubparser (single <> gallery) <**> Opt.helper) `Opt.info` mainInfo
|
globalOpts = Options <$> verboseOpt <*> subcommands <**> Opt.helper
|
||||||
where
|
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
|
single = Opt.command "single" $ singleOpts `Opt.info` singleInfo
|
||||||
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt <*> copyOpt
|
singleOpts = SinglePage <$> fileArg <*> nsfwSwitchS <*> outputOpt <*> copyOpt
|
||||||
fileArg = Opt.strArgument $
|
fileArg = Opt.strArgument $
|
||||||
|
@ -55,24 +69,32 @@ optionsParser =
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = main2 =<< Opt.execParser optionsParser
|
main = do
|
||||||
|
opts <- Opt.execParser optionsParser
|
||||||
|
printVerbose opts opts
|
||||||
|
main2 opts
|
||||||
|
|
||||||
main2 :: Options -> IO ()
|
main2 :: Options -> IO ()
|
||||||
main2 s@(SinglePage {file, includeNsfw, output}) = do
|
main2 (Options {mode = SinglePage {file, includeNsfw, output}}) = do
|
||||||
print s
|
info <- readYAML file
|
||||||
page <- make includeNsfw <$> readYAML file
|
print info
|
||||||
|
let page = make includeNsfw info
|
||||||
case output of
|
case output of
|
||||||
Nothing -> Text.putStr page
|
Nothing -> Text.putStr page
|
||||||
Just out -> Text.writeFile out page
|
Just out -> Text.writeFile out page
|
||||||
|
|
||||||
main2 g@(GalleryPage {}) = do
|
main2 (Options {mode = GalleryPage {}}) = do
|
||||||
print g
|
|
||||||
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
|
||||||
|
|
||||||
readYAML :: YAML.FromYAML a => FilePath -> IO a
|
readYAML :: YAML.FromYAML a => FilePath -> IO a
|
||||||
readYAML file = do
|
readYAML file = ByteString.readFile file >>= decode1Must file
|
||||||
txt <- ByteString.readFile file
|
|
||||||
|
decode1Must :: YAML.FromYAML a => FilePath -> ByteString -> IO a
|
||||||
|
decode1Must file txt =
|
||||||
case YAML.decode1 txt of
|
case YAML.decode1 txt of
|
||||||
Right val -> pure val
|
Right val -> pure val
|
||||||
Left (YAML.Pos {posLine, posColumn}, err) ->
|
Left (YAML.Pos {posLine, posColumn}, err) ->
|
||||||
|
|
Loading…
Reference in a new issue