Erase the asymmetry between articles and pages; make both optional though check that at least one exists

This commit is contained in:
Tissevert 2020-09-30 22:00:30 +02:00
parent 371b9a8098
commit f7ec6d06c1
4 changed files with 39 additions and 30 deletions

View file

@ -16,7 +16,7 @@ import System.FilePath (dropTrailingPathSeparator, isValid)
data Arguments = BlogConfig { data Arguments = BlogConfig {
sourceDir :: FilePath sourceDir :: FilePath
, articlesPath :: FilePath , articlesPath :: Maybe FilePath
, bannerPath :: Maybe FilePath , bannerPath :: Maybe FilePath
, cardImage :: Maybe FilePath , cardImage :: Maybe FilePath
, commentsURL :: Maybe String , commentsURL :: Maybe String
@ -47,13 +47,8 @@ option readM aShort aLong aMetavar aHelpMessage =
blogConfig :: Parser Arguments blogConfig :: Parser Arguments
blogConfig = BlogConfig blogConfig = BlogConfig
<$> argument filePath (value "." <> metavar "INPUT_DIR") <$> argument filePath (value "." <> metavar "INPUT_DIR")
<*> Optparse.option filePath ( <*> option filePath 'a' "articles" "DIRECTORY"
metavar "DIRECTORY" "relative path to the directory containing the articles within INPUT_DIR"
<> value "articles"
<> short 'a'
<> long "articles"
<> help "relative path to the directory containing the articles within INPUT_DIR"
)
<*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner" <*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner"
<*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card" <*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
<*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored" <*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored"
@ -61,8 +56,8 @@ blogConfig = BlogConfig
<*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head" <*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
<*> option str 'n' "name" "BLOG_NAME" "name of the blog" <*> option str 'n' "name" "BLOG_NAME" "name of the blog"
<*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards") <*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
<*> option filePath 'p' "pages" <*> option filePath 'p' "pages" "DIRECTORY"
"DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR" "relative path to the directory containing the pages within INPUT_DIR"
<*> Optparse.option auto ( <*> Optparse.option auto (
metavar "INTEGER" metavar "INTEGER"
<> value 3 <> value 3

View file

@ -96,11 +96,16 @@ tagged collection path = do
discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String)) discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String))
discover path = do discover path = do
articles <- find Article.at $ articlesPath path (articles, tags) <- discoverArticles $ articlesPath path
pages <- maybe (return Map.empty) (find Page.at) $ pagesPath path pages <- maybe (return Map.empty) (find Page.at) $ pagesPath path
tags <- Map.fromList . filter (not . Set.null . snd)
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
return (articles, pages, tags) return (articles, pages, tags)
where
discoverArticles Nothing = return (Map.empty, Map.empty)
discoverArticles (Just somePath) = do
articles <- find Article.at somePath
tags <- Map.fromList . filter (not . Set.null . snd)
<$> (Files.find (somePath </> "tags") >>= mapM (articles `tagged`))
return (articles, tags)
build :: Arguments -> IO Blog build :: Arguments -> IO Blog
build arguments = do build arguments = do

View file

@ -10,12 +10,12 @@ import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..)) import qualified Arguments as Arguments (Arguments(..))
import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Files (File(..), filePath) import Files (File(..), filePath, filePathMaybe)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import System.Directory (doesDirectoryExist) import System.Exit (die)
data Path = Path { data Path = Path {
articlesPath :: FilePath articlesPath :: Maybe FilePath
, pagesPath :: Maybe FilePath , pagesPath :: Maybe FilePath
, remarkableConfig :: Maybe FilePath , remarkableConfig :: Maybe FilePath
, root :: FilePath , root :: FilePath
@ -27,15 +27,18 @@ instance ToJSON Path where
<> "pagesPath" .= pagesPath <> "pagesPath" .= pagesPath
) )
getPagesPath :: Maybe FilePath -> IO (Maybe FilePath) getMarkdownPath :: FilePath -> Maybe FilePath -> IO (Maybe FilePath)
getPagesPath Nothing = do getMarkdownPath defaultPath Nothing = filePathMaybe (Dir defaultPath)
checkPagesPath <- doesDirectoryExist "pages" getMarkdownPath _ (Just path) = Just <$> filePath (Dir path)
return $ if checkPagesPath then Just "pages" else Nothing
getPagesPath (Just p) = Just <$> (filePath $ Dir p)
build :: FilePath -> Arguments -> IO Path build :: FilePath -> Arguments -> IO Path
build root arguments = do build root arguments = do
articlesPath <- filePath . Dir $ Arguments.articlesPath arguments articlesPath <- getMarkdownPath "articles" $ Arguments.articlesPath arguments
pagesPath <- getPagesPath $ Arguments.pagesPath arguments pagesPath <- getMarkdownPath "pages" $ Arguments.pagesPath arguments
checkForContent articlesPath pagesPath
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
return $ Path {articlesPath, pagesPath, remarkableConfig, root} return $ Path {articlesPath, pagesPath, remarkableConfig, root}
where
checkForContent Nothing Nothing =
die "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
checkForContent _ _ = return ()

View file

@ -3,6 +3,7 @@ module Files (
, absolute , absolute
, absoluteLink , absoluteLink
, filePath , filePath
, filePathMaybe
, find , find
) where ) where
@ -19,14 +20,19 @@ absoluteLink :: FilePath -> FilePath
absoluteLink ('.':path) = path absoluteLink ('.':path) = path
absoluteLink path = "/" </> path absoluteLink path = "/" </> path
filePathMaybe :: File -> IO (Maybe FilePath)
filePathMaybe = filePathAux
where
filePathAux (File path) = ifToMaybe path <$> doesFileExist path
filePathAux (Dir path) = ifToMaybe path <$> doesDirectoryExist path
ifToMaybe path bool = if bool then return path else Nothing
filePath :: File -> IO FilePath filePath :: File -> IO FilePath
filePath (File path) = do filePath file = filePathMaybe file >>= maybe (die $ notExist file) return
bool <- doesFileExist path where
if bool then return path else die $ path ++ ": no such file" notExist (File path) = path ++ ": no such file"
filePath (Dir path) = do notExist (Dir path) = path ++ ": no such directory"
bool <- doesDirectoryExist path
if bool then return path else die $ path ++ ": no such directory"
find :: FilePath -> IO [FilePath] find :: FilePath -> IO [FilePath]
find path = find path =
fmap (path </>) <$> listDirectory path filePathMaybe (Dir path) >>= maybe (return []) (fmap ((path </>) <$>) . listDirectory)