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 )