From a8fd44e7ac94c5b5de40decf3c4bd1ae0df1540d Mon Sep 17 00:00:00 2001 From: Tissevert Date: Tue, 29 Jan 2019 23:08:38 +0100 Subject: [PATCH] Remove the option to generate into a directory other than the parent directory of the one containing the articles to get rid of the hassle of copying the markdown sources and simplify working with relative URLs during the generation process --- src/Arguments.hs | 45 +++++++++------------------------------------ src/Blog.hs | 21 +++++++++++---------- src/Dom.hs | 29 ++++++++++++++--------------- src/JSON.hs | 7 +++---- src/Main.hs | 10 +++++----- 5 files changed, 42 insertions(+), 70 deletions(-) diff --git a/src/Arguments.hs b/src/Arguments.hs index 93923c2..1e1ab79 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -1,34 +1,21 @@ {-# LANGUAGE NamedFieldPuns #-} module Arguments ( Arguments(..) - , Configuration - , getConfiguration + , configuration ) where import Options.Applicative -import System.FilePath.Posix (dropTrailingPathSeparator, isValid, takeDirectory, takeFileName) ---import System.Directory (doesDirectoryExist) +import System.FilePath.Posix (dropTrailingPathSeparator, isValid) -data Arguments a b = Arguments { +data Arguments = Arguments { sourceDir :: FilePath - , outputDir :: a - , blogName :: b - , previewCount :: Int + , blogName :: Maybe String + , previewCountArg :: Int } -type InputArguments = Arguments (Maybe FilePath) (Maybe String) -type Configuration = Arguments FilePath String - -arguments :: Parser InputArguments +arguments :: Parser Arguments 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 @@ -44,29 +31,15 @@ arguments = Arguments <> 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 $ +configuration :: IO Arguments +configuration = + 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 - } diff --git a/src/Blog.hs b/src/Blog.hs index 2dfa79b..0f4adff 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -5,16 +5,15 @@ module Blog ( , get ) where -import Arguments (Arguments(..), Configuration) +import Arguments (Arguments(..)) import Control.Monad ((>=>), filterM, forM) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Reader (MonadReader(..), ReaderT) import Data.Map (Map) import qualified Data.Map as Map (fromList, member) import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) import System.Directory (doesFileExist, listDirectory) -import System.FilePath.Posix ((), takeExtension, takeFileName) +import System.FilePath.Posix ((), takeExtension, takeDirectory, takeFileName) import System.Posix.Types (FileID) import System.Posix.Files (FileStatus, getFileStatus, fileID) @@ -28,6 +27,8 @@ type Collection = Map FileID Article data Blog = Blog { articles :: Collection , name :: String + , previewCount :: Int + , root :: FilePath , tags :: Map String (Set FileID) } @@ -62,11 +63,11 @@ tagged collection path = do else return Set.empty return (takeFileName path, foldl Set.union Set.empty fileIDs) -get :: ReaderT Configuration IO Blog -get = do - path <- sourceDir <$> ask - articles <- findArticles path - name <- blogName <$> ask +get :: Arguments -> IO Blog +get (Arguments {sourceDir, blogName, previewCountArg}) = do + let root = takeDirectory sourceDir + let name = maybe (takeFileName root) id $ blogName + articles <- findArticles sourceDir tags <- Map.fromList . filter (not . Set.null . snd) - <$> (find (path "tags") >>= mapM (articles `tagged`)) - return $ Blog { articles , name, tags } + <$> (find (sourceDir "tags") >>= mapM (articles `tagged`)) + return $ Blog { articles , name, previewCount = previewCountArg, root, tags } diff --git a/src/Dom.hs b/src/Dom.hs index 3ef32ce..1e543b2 100644 --- a/src/Dom.hs +++ b/src/Dom.hs @@ -4,7 +4,6 @@ module Dom ( generate ) where -import Arguments (Arguments(..), Configuration) import Blog (Article(..), Blog(..)) import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO(..)) @@ -61,15 +60,15 @@ render (Page {category, full, articlesFeatured}) blog = pageTitle = if full then "All" else "Latest" ++ " articles" ++ maybe "" (" tagged " ++) category -generateCollection :: (Maybe String, FilePath, [Article]) -> Blog -> ReaderT Configuration IO () -generateCollection (_, _, []) _ = return () -generateCollection (category, path, articlesFeatured) blog = do - n <- previewCount <$> ask +generateCollection :: (Maybe String, FilePath, [Article]) -> ReaderT Blog IO () +generateCollection (_, _, []) = return () +generateCollection (category, path, articlesFeatured) = do + blog <- ask liftIO $ createDirectoryIfMissing False path - forM_ (pages n) $ \page -> + forM_ (pages $ previewCount blog) $ \page -> liftIO $ renderToFile (urlPath page) (render page blog) where - pages n = [ + pages articlesCount = [ Page { category , full = True @@ -80,16 +79,16 @@ generateCollection (category, path, articlesFeatured) blog = do category , full = False , urlPath = path "index.html" - , articlesFeatured = take n articlesFeatured + , articlesFeatured = take articlesCount articlesFeatured } ] -generate :: Blog -> ReaderT Configuration IO () -generate blog@(Blog {articles, tags}) = do - path <- outputDir <$> ask - generateCollection (Nothing, path, sortByDate $ Map.elems articles) blog - forM_ (Map.toList tags) $ \(tag, tagged) -> - generateCollection (Just tag, path tag, sortByDate $ getArticles tagged) blog +generate :: ReaderT Blog IO () +generate = do + Blog {root, articles, tags} <- ask + generateCollection (Nothing, root, sortByDate $ Map.elems articles) + forM_ (Map.toList $ tags) $ \(tag, tagged) -> + generateCollection (Just tag, root tag, sortByDate $ getArticles tagged articles) where - getArticles tagged = Map.elems $ Map.filterWithKey (\k _ -> Set.member k tagged) articles + getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged) sortByDate = sortOn (Down . modificationTime . fileStatus) diff --git a/src/JSON.hs b/src/JSON.hs index 6aaf7b3..f98d3cf 100644 --- a/src/JSON.hs +++ b/src/JSON.hs @@ -2,7 +2,6 @@ module JSON ( generate ) where -import Arguments (Arguments(..), Configuration) import Blog (Blog(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (MonadReader(..), ReaderT) @@ -11,7 +10,7 @@ import Data.ByteString.Lazy (writeFile) import System.FilePath.Posix (()) import Prelude hiding (writeFile) -generate :: Blog -> ReaderT Configuration IO () -generate _ = do - path <- outputDir <$> ask +generate :: ReaderT Blog IO () +generate = do + path <- root <$> ask liftIO $ writeFile (path "articles.json") (encode $ object []) diff --git a/src/Main.hs b/src/Main.hs index 0ef8693..927a95f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ {- LANGUAGE NamedFieldPuns #-} module Main where -import Arguments (getConfiguration) +import Arguments (configuration) import qualified Blog (get) import qualified Dom (generate) import qualified JSON (generate) @@ -9,9 +9,9 @@ import Control.Monad.Reader (runReaderT) main :: IO () main = do - getConfiguration + configuration + >>= Blog.get >>= runReaderT (do - blog <- Blog.get - Dom.generate blog - JSON.generate blog + Dom.generate + JSON.generate )