hablo/src/Arguments.hs

73 lines
2.0 KiB
Haskell

{-# LANGUAGE NamedFieldPuns #-}
module Arguments (
Arguments(..)
, Configuration
, getConfiguration
) where
import Options.Applicative
import System.FilePath.Posix (dropTrailingPathSeparator, isValid, takeDirectory, takeFileName)
--import System.Directory (doesDirectoryExist)
data Arguments a b = Arguments {
sourceDir :: FilePath
, outputDir :: a
, blogName :: b
, previewCount :: Int
}
type InputArguments = Arguments (Maybe FilePath) (Maybe String)
type Configuration = Arguments FilePath String
arguments :: Parser InputArguments
arguments = Arguments
<$> argument directory (metavar "INPUT_DIR")
<*> option (optional directory) (
metavar "OUTPUT_DIR"
<> value Nothing
<> short 'o'
<> long "output"
<> help "directory in which to generate the blog"
)
<*> option (optional str) (
metavar "BLOG_NAME"
<> value Nothing
<> short 'n'
<> long "name"
<> help "name of the blog"
)
<*> option auto (
metavar "PREVIEW_COUNT"
<> value 3
<> short 'p'
<> long "preview-count"
<> help "number of articles listed on the page of each category"
)
{-
existingDirectory :: ReadM FilePath
existingDirectory = eitherReader $ \path ->
if doesDirectoryExist path
then Right path
else Left "The input directory must be an existing path"
-}
directory :: ReadM FilePath
directory = eitherReader $ \path ->
if isValid path
then Right $ dropTrailingPathSeparator path
else Left "This string doesn't represent a valid path"
getConfiguration :: IO Configuration
getConfiguration = do
invocation <- execParser $
info (arguments <**> helper)
( fullDesc
)
let outputDirOrDefault = maybe (takeDirectory $ sourceDir invocation) id (outputDir invocation)
let blogNameOrDefault = maybe (takeFileName outputDirOrDefault) id (blogName invocation)
return $ invocation {
outputDir = outputDirOrDefault
, blogName = blogNameOrDefault
}