diff --git a/hablo.cabal b/hablo.cabal index 5019304..c5d491e 100644 --- a/hablo.cabal +++ b/hablo.cabal @@ -24,6 +24,7 @@ executable hablo , Article , ArticlesList , Blog + , Blog.Path , Blog.Skin , Dom , Files diff --git a/src/Arguments.hs b/src/Arguments.hs index 4b2003c..b83b14c 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -11,15 +11,17 @@ 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.Posix (dropTrailingPathSeparator, isValid) +import System.FilePath ((), dropTrailingPathSeparator, isValid) data Arguments = BlogConfig { sourceDir :: FilePath + , articlesPath :: FilePath , bannerPath :: Maybe FilePath , cardImage :: Maybe FilePath , favicon :: Maybe FilePath , headPath :: Maybe FilePath , name :: Maybe String + , pagesPath :: Maybe FilePath , previewArticlesCount :: Int , previewLinesCount :: Int } @@ -37,23 +39,32 @@ option readM aShort aLong aMetavar aHelpMessage = blogConfig :: Parser Arguments blogConfig = BlogConfig - <$> argument filePath (metavar "INPUT_DIR") + <$> 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 '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' + <> 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' + <> short 'L' <> long "preview-lines" <> help "number of lines to display in articles preview" ) @@ -85,6 +96,8 @@ 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 diff --git a/src/Blog.hs b/src/Blog.hs index e3c4832..9a0d986 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -2,15 +2,18 @@ {-# LANGUAGE FlexibleContexts #-} module Blog ( Blog(..) + , Path(..) , Skin(..) , build , get ) where -import Arguments (Arguments(sourceDir)) +import Arguments (Arguments) import qualified Arguments (name) import Article (Article) import qualified Article (at, key) +import Blog.Path (Path(..)) +import qualified Blog.Path as Path (build) import Blog.Skin (Skin(..)) import qualified Blog.Skin as Skin (build) import Control.Monad ((>=>), filterM, forM) @@ -22,14 +25,14 @@ import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) import qualified Files (find) import System.Directory (doesFileExist, withCurrentDirectory) -import System.FilePath ((), dropTrailingPathSeparator, splitFileName, takeExtension, takeFileName) +import System.FilePath ((), dropTrailingPathSeparator, takeExtension, takeFileName) type Collection = Map String Article data Blog = Blog { articles :: Collection , name :: String - , root :: FilePath + , path :: Path , skin :: Skin , tags :: Map String (Set String) } @@ -60,18 +63,13 @@ tagged collection path = do return (takeFileName path, foldl Set.union Set.empty keys) build :: Arguments -> IO Blog -build arguments = withCurrentDirectory root $ do - let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ Arguments.name arguments +build arguments = withCurrentDirectory (root path) $ do skin <- Skin.build name arguments - articles <- findArticles articlesPath + articles <- findArticles $ articlesPath path tags <- Map.fromList . filter (not . Set.null . snd) - <$> (Files.find (articlesPath "tags") >>= mapM (articles `tagged`)) - return $ Blog { - articles - , name - , root - , skin - , tags - } + <$> (Files.find (articlesPath path "tags") >>= mapM (articles `tagged`)) + return $ Blog {articles, name, path, skin, tags} where - (root, articlesPath) = splitFileName $ sourceDir arguments + path = Path.build arguments + name = maybe (takeFileName . dropTrailingPathSeparator $ root path) id + $ Arguments.name arguments diff --git a/src/Blog/Path.hs b/src/Blog/Path.hs new file mode 100644 index 0000000..d643c80 --- /dev/null +++ b/src/Blog/Path.hs @@ -0,0 +1,20 @@ +module Blog.Path ( + Path(..) + , build + ) where + +import Arguments (Arguments) +import qualified Arguments as Arguments (Arguments(..)) + +data Path = Path { + articlesPath :: FilePath + , pagesPath :: Maybe FilePath + , root :: FilePath + } + +build :: Arguments -> Path +build arguments = Path { + articlesPath = Arguments.articlesPath arguments + , pagesPath = Arguments.pagesPath arguments + , root = Arguments.sourceDir arguments + } diff --git a/src/HTML.hs b/src/HTML.hs index 9b8f1ee..4fa789d 100644 --- a/src/HTML.hs +++ b/src/HTML.hs @@ -6,7 +6,7 @@ module HTML ( import Article(Article(..)) import ArticlesList (ArticlesList(..)) -import Blog (Blog(..), Skin(..)) +import Blog (Blog(..), Path(..), Skin(..)) import qualified Blog (get) import Control.Monad (forM) import Control.Monad.IO.Class (MonadIO(..)) @@ -31,7 +31,7 @@ data Collection = Collection { collection :: Monad m => [Article] -> Maybe String -> ReaderT Blog m Collection collection articlesFeatured tag = do - root <- Blog.get root + root <- Blog.get $path.$root return $ Collection { articlesFeatured = sortByDate articlesFeatured , basePath = maybe root (root ) tag @@ -58,7 +58,7 @@ articlesLists (Collection {articlesFeatured, basePath, tag}) = do generateArticles :: [Article] -> ReaderT Blog IO () generateArticles = mapM_ $ \article -> do - filePath <- ( urlPath article <.> "html") <$> (Blog.get root) + filePath <- ( urlPath article <.> "html") <$> (Blog.get $path.$root) (renderTextT $ page article) >>= liftIO . TextIO.writeFile filePath diff --git a/src/JS.hs b/src/JS.hs index 8ab5cdf..1fa7336 100644 --- a/src/JS.hs +++ b/src/JS.hs @@ -3,7 +3,7 @@ module JS ( generate ) where -import Blog (Blog(..)) +import Blog (Blog(..), Path(..)) import qualified Blog (get) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader (ReaderT) @@ -11,6 +11,7 @@ import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile) import qualified Files (find) import JSON (exportBlog) import Paths_hablo (getDataDir) +import Pretty ((.$)) import System.Directory (createDirectoryIfMissing) import System.FilePath (()) import Prelude hiding (concat, readFile, writeFile) @@ -23,7 +24,7 @@ compile sources = concat (header:sources ++ [footer]) generate :: ReaderT Blog IO () generate = do - destinationDir <- ( "js") <$> Blog.get root + destinationDir <- ( "js") <$> (Blog.get $path.$root) blogJSON <- exportBlog liftIO $ do jsFiles <- ( "js") <$> getDataDir >>= Files.find diff --git a/src/JSON.hs b/src/JSON.hs index 9332474..9b188d8 100644 --- a/src/JSON.hs +++ b/src/JSON.hs @@ -7,7 +7,7 @@ module JSON ( import Article (Article) import qualified Article (Article(..)) import Blog (Blog) -import qualified Blog (Blog(..), Skin(..)) +import qualified Blog (Blog(..), Path(..), Skin(..)) import Control.Monad.Reader (ReaderT, ask) import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode) import Data.ByteString.Lazy (ByteString) @@ -28,6 +28,14 @@ data ArticleExport = ArticleExport { instance ToJSON ArticleExport where toEncoding = genericToEncoding defaultOptions +data PathExport = PathExport { + articlesPath :: FilePath + , pagesPath :: Maybe FilePath + } deriving (Generic) + +instance ToJSON PathExport where + toEncoding = genericToEncoding defaultOptions + data SkinExport = SkinExport { previewArticlesCount :: Int , previewLinesCount :: Int @@ -38,8 +46,9 @@ instance ToJSON SkinExport where data BlogDB = BlogDB { articles :: Map String ArticleExport - , tags :: Map String [String] + , path :: PathExport , skin :: SkinExport + , tags :: Map String [String] } deriving (Generic) instance ToJSON BlogDB where @@ -59,9 +68,13 @@ exportBlog = do blog <- ask return . encode $ BlogDB { articles = mapWithKey (export blog) $ Blog.articles blog - , tags = Set.elems <$> Blog.tags blog + , path = PathExport { + articlesPath = Blog.articlesPath $ Blog.path blog + , pagesPath = Blog.pagesPath $ Blog.path blog + } , skin = SkinExport { - previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog - , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog - } + previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog + , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog + } + , tags = Set.elems <$> Blog.tags blog }