128 lines
4.5 KiB
Haskell
128 lines
4.5 KiB
Haskell
module Arguments (
|
|
Arguments(..)
|
|
, get
|
|
) where
|
|
|
|
import Data.Monoid ((<>))
|
|
import Data.Version (showVersion)
|
|
import Control.Applicative ((<|>), (<**>), optional)
|
|
import Options.Applicative (Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc, header, help, helper, info, long, metavar, short, str, value)
|
|
import qualified Options.Applicative as Optparse (option)
|
|
import qualified Paths_hablo as Hablo (version)
|
|
import System.Directory (doesDirectoryExist, doesFileExist, makeAbsolute)
|
|
import System.Exit (die, exitSuccess)
|
|
import System.FilePath ((</>), dropTrailingPathSeparator, isValid)
|
|
|
|
data Arguments = BlogConfig {
|
|
sourceDir :: FilePath
|
|
, articlesPath :: FilePath
|
|
, bannerPath :: Maybe FilePath
|
|
, cardImage :: Maybe FilePath
|
|
, commentsAt :: Maybe String
|
|
, favicon :: Maybe FilePath
|
|
, headPath :: Maybe FilePath
|
|
, name :: Maybe String
|
|
, pagesPath :: Maybe FilePath
|
|
, previewArticlesCount :: Int
|
|
, previewLinesCount :: Int
|
|
, wording :: Maybe FilePath
|
|
}
|
|
| Version
|
|
|
|
option :: ReadM a -> Char -> String -> String -> String -> Parser (Maybe a)
|
|
option readM aShort aLong aMetavar aHelpMessage =
|
|
Optparse.option (optional readM) (
|
|
metavar aMetavar
|
|
<> value Nothing
|
|
<> short aShort
|
|
<> long aLong
|
|
<> help aHelpMessage
|
|
)
|
|
|
|
blogConfig :: Parser Arguments
|
|
blogConfig = BlogConfig
|
|
<$> argument filePath (value "." <> metavar "INPUT_DIR")
|
|
<*> Optparse.option filePath (
|
|
metavar "ARTICLES_PATH"
|
|
<> value "articles"
|
|
<> short 'a'
|
|
<> long "articles"
|
|
<> help "name of the directory containing the articles within INPUT_DIR"
|
|
)
|
|
<*> option filePath 'b' "banner" "BANNER_PATH" "path to the file to use for the blog's banner"
|
|
<*> option filePath 'c' "card-image" "CARD_IMAGE" "path to the image to use for the blog's card"
|
|
<*> option filePath 'C' "comments-at" "INSTANCE_URL" "url of the instance where comments are stored"
|
|
<*> option filePath 'f' "favicon" "FAVICON" "path to the image to use for the blog's favicon"
|
|
<*> option filePath 'H' "head" "HEAD_PATH" "path to the file to add in the blog's head"
|
|
<*> option str 'n' "name" "BLOG_NAME" "name of the blog"
|
|
<*> option filePath 'p' "pages"
|
|
"PAGES_PATH" "name of the directory containing the pages within INPUT_DIR"
|
|
<*> Optparse.option auto (
|
|
metavar "PREVIEW_ARTICLES_COUNT"
|
|
<> value 3
|
|
<> short 'A'
|
|
<> long "preview-articles"
|
|
<> help "number of articles listed on the page of each category"
|
|
)
|
|
<*> Optparse.option auto (
|
|
metavar "PREVIEW_LINES_COUNT"
|
|
<> value 10
|
|
<> short 'L'
|
|
<> long "preview-lines"
|
|
<> help "number of lines to display in articles preview"
|
|
)
|
|
<*> option filePath 'w' "wording" "WORDING" "path to the file containing the wording to use"
|
|
|
|
version :: Parser Arguments
|
|
version = flag' Version (
|
|
long "version"
|
|
<> short 'v'
|
|
<> help "print the version number"
|
|
)
|
|
|
|
arguments :: Parser Arguments
|
|
arguments = blogConfig <|> version
|
|
|
|
filePath :: ReadM FilePath
|
|
filePath = eitherReader $ \path ->
|
|
if isValid path
|
|
then Right $ dropTrailingPathSeparator path
|
|
else Left "This string doesn't represent a valid path"
|
|
|
|
ifNotDie :: (a -> IO Bool) -> (a -> String) -> a -> IO ()
|
|
ifNotDie check messageBuilder input = do
|
|
bool <- check input
|
|
if bool
|
|
then return ()
|
|
else die $ messageBuilder input
|
|
|
|
checkAndMakeAbsolute :: Arguments -> IO Arguments
|
|
checkAndMakeAbsolute Version = return Version
|
|
checkAndMakeAbsolute aBlogConfig = do
|
|
doesDirectoryExist `ifNotDie` noSuchDirectory $ sourceDir aBlogConfig
|
|
doesDirectoryExist `ifNotDie` noSuchDirectory $
|
|
sourceDir aBlogConfig </> articlesPath aBlogConfig
|
|
absoluteSourceDir <- makeAbsolute $ sourceDir aBlogConfig
|
|
mapM_ (doesFileExist `ifNotDie` noSuchFile) $ bannerPath aBlogConfig
|
|
absoluteBannerPath <- mapM makeAbsolute $ bannerPath aBlogConfig
|
|
mapM_ (doesFileExist `ifNotDie` noSuchFile) $ headPath aBlogConfig
|
|
absoluteHeadPath <- mapM makeAbsolute $ headPath aBlogConfig
|
|
return $ aBlogConfig {
|
|
sourceDir = absoluteSourceDir
|
|
, bannerPath = absoluteBannerPath
|
|
, headPath = absoluteHeadPath
|
|
}
|
|
where
|
|
noSuchDirectory = (++ ": no such directory")
|
|
noSuchFile = (++ ": no such file")
|
|
|
|
get :: IO Arguments
|
|
get = do
|
|
args <- execParser $
|
|
info
|
|
(arguments <**> helper)
|
|
(fullDesc <> header ("Hablo v" ++ showVersion Hablo.version))
|
|
case args of
|
|
Version -> (putStrLn $ showVersion Hablo.version) >> exitSuccess
|
|
BlogConfig {} -> checkAndMakeAbsolute args
|