Clean the handling of --version argument, reusing the existing tools from optparse-applicative

This commit is contained in:
Tissevert 2023-08-04 17:05:45 +02:00
parent 6780a18764
commit 9a1184006c
3 changed files with 19 additions and 32 deletions

View file

@ -9,17 +9,17 @@ module Arguments (
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif #endif
import Control.Applicative ((<|>), (<**>), optional) import Control.Applicative ((<|>), (<**>), optional)
import Options.Applicative ( import Options.Applicative
Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc ( Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc
, header, help, helper, info, long, metavar, short, str, switch, value , header, help, helper, info, infoOption, long, metavar, short, str, switch
) , value )
import qualified Options.Applicative as Optparse (option) import qualified Options.Applicative as Optparse (option)
import System.FilePath (dropTrailingPathSeparator, isValid) import System.FilePath (dropTrailingPathSeparator, isValid)
version :: String version :: String
version = "0.3.0.0" version = "0.3.0.0"
data Arguments = BlogConfig { data Arguments = Arguments {
sourceDir :: FilePath sourceDir :: FilePath
, articlesPath :: Maybe FilePath , articlesPath :: Maybe FilePath
, bannerPath :: Maybe FilePath , bannerPath :: Maybe FilePath
@ -37,7 +37,6 @@ data Arguments = BlogConfig {
, siteURL :: Maybe String , siteURL :: Maybe String
, wording :: Maybe FilePath , wording :: Maybe FilePath
} }
| Version
option :: ReadM a -> Char -> String -> String -> String -> Parser (Maybe a) option :: ReadM a -> Char -> String -> String -> String -> Parser (Maybe a)
option readM aShort aLong aMetavar aHelpMessage = option readM aShort aLong aMetavar aHelpMessage =
@ -49,8 +48,8 @@ option readM aShort aLong aMetavar aHelpMessage =
<> help aHelpMessage <> help aHelpMessage
) )
blogConfig :: Parser Arguments arguments :: Parser Arguments
blogConfig = BlogConfig arguments = Arguments
<$> argument filePath (value "." <> metavar "INPUT_DIR") <$> argument filePath (value "." <> metavar "INPUT_DIR")
<*> option filePath 'a' "articles" "DIRECTORY" <*> option filePath 'a' "articles" "DIRECTORY"
"relative path to the directory containing the articles within INPUT_DIR" "relative path to the directory containing the articles within INPUT_DIR"
@ -83,16 +82,6 @@ blogConfig = BlogConfig
<*> option filePath 'u' "site-url" "URL" "URL where the blog is published" <*> option filePath 'u' "site-url" "URL" "URL where the blog is published"
<*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use" <*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use"
versionP :: Parser Arguments
versionP = flag' Version (
long "version"
<> short 'v'
<> help "print the version number"
)
arguments :: Parser Arguments
arguments = blogConfig <|> versionP
filePath :: ReadM FilePath filePath :: ReadM FilePath
filePath = eitherReader $ \path -> filePath = eitherReader $ \path ->
if isValid path if isValid path
@ -100,8 +89,10 @@ filePath = eitherReader $ \path ->
else Left "This string doesn't represent a valid path" else Left "This string doesn't represent a valid path"
get :: IO Arguments get :: IO Arguments
get = do get = execParser
execParser $ (info (arguments <**> showVersion <**> helper)
info (fullDesc <> header ("Hablo v" ++ version)))
(arguments <**> helper) where
(fullDesc <> header ("Hablo v" ++ version)) showVersion = infoOption
version
(long "version" <> short 'v' <> help "print current version")

View file

@ -10,12 +10,7 @@ import qualified RSS (generate)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
main :: IO () main :: IO ()
main = do main = Arguments.get >>= Blog.build >>= runReaderT
arguments <- Arguments.get (do HTML.generate
case arguments of JS.generate
Version -> (putStrLn version) >> exitSuccess RSS.generate)
config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do
HTML.generate
JS.generate
RSS.generate
)

View file

@ -1,4 +1,5 @@
- dans Arguments.hs, vérifier que l'implémentation de option est pas déjà dans la lib optparse-applicative - dans Arguments.hs, vérifier que l'implémentation de option est pas déjà dans la lib optparse-applicative
=> ah non en fait c'est une fonction locale au fichier juste mal nommée, corriger ça
- le Wording, c'était quand même pas l'idée du siècle -> ça pourrait pas tout revenir dans un thème qui serait du HTML ? - le Wording, c'était quand même pas l'idée du siècle -> ça pourrait pas tout revenir dans un thème qui serait du HTML ?
- faque Template aussi - faque Template aussi
- «Pretty» Oo ? mais c'est juste des Utils en fait - «Pretty» Oo ? mais c'est juste des Utils en fait