diff --git a/hablo.cabal b/hablo.cabal index f1ad46c..2655328 100644 --- a/hablo.cabal +++ b/hablo.cabal @@ -41,6 +41,7 @@ executable hablo , HTML , JS , JSON + , Page , Paths_hablo , Pretty -- other-extensions: diff --git a/src/Blog.hs b/src/Blog.hs index d7d0b96..09b57bd 100644 --- a/src/Blog.hs +++ b/src/Blog.hs @@ -27,16 +27,20 @@ import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) import Files (File(..), absolute) import qualified Files (find) +import Page (Page) +import qualified Page (at) import Prelude hiding (lookup) import System.Directory (doesFileExist, withCurrentDirectory) import System.FilePath ((), dropTrailingPathSeparator, takeExtension, takeFileName) import Text.Parsec (ParseError) -type Collection = Map String Article +type Collection = Map String +type Parsed a = Either ParseError (String, a) data Blog = Blog { - articles :: Collection + articles :: Collection Article , name :: String + , pages :: Collection Page , path :: Path , skin :: Skin , tags :: Map String (Set String) @@ -46,25 +50,25 @@ data Blog = Blog { get :: MonadReader Blog m => (Blog -> a) -> m a get = (<$> ask) -keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article) +keepOrWarn :: Collection a -> Parsed a -> IO (Collection a) keepOrWarn accumulator (Left parseErrors) = - forM [show parseErrors, "=> Ignoring this article"] putStrLn + forM [show parseErrors, "=> Ignoring this text"] putStrLn >> return accumulator keepOrWarn accumulator (Right (key, article)) = return $ insert key article accumulator -findArticles :: FilePath -> IO (Map String Article) -findArticles = +find :: (FilePath -> IO (Parsed a)) -> FilePath -> IO (Collection a) +find parser = Files.find >=> filterM isMarkDownFile - >=> mapM Article.at + >=> mapM parser >=> foldM keepOrWarn Map.empty where isMarkDownFile path = do let correctExtension = takeExtension path == ".md" (correctExtension &&) <$> doesFileExist path -tagged :: Collection -> FilePath -> IO (String, Set String) +tagged :: Collection Article -> FilePath -> IO (String, Set String) tagged collection path = do links <- Files.find path keys <- forM links $ \link -> do @@ -75,12 +79,13 @@ tagged collection path = do else Set.empty return (takeFileName path, foldl Set.union Set.empty keys) -discover :: Path -> IO (Collection, Map String (Set String)) +discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String)) discover path = do - articles <- findArticles $ articlesPath path + articles <- find (Article.at) $ articlesPath 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, tags) + return (articles, pages, tags) build :: Arguments -> IO Blog build arguments = do @@ -91,5 +96,5 @@ build arguments = do let name = maybe (takeFileName $ dropTrailingPathSeparator root) id $ Arguments.name arguments skin <- Skin.build name arguments - (articles, tags) <- discover path - return $ Blog {articles, name, path, skin, tags, wording} + (articles, pages, tags) <- discover path + return $ Blog {articles, name, pages, path, skin, tags, wording} diff --git a/src/Page.hs b/src/Page.hs new file mode 100644 index 0000000..6e74c5a --- /dev/null +++ b/src/Page.hs @@ -0,0 +1,13 @@ +module Page ( + Page(..) + , at + ) where + +import Text.ParserCombinators.Parsec (ParseError) + +data Page = Page { + title :: String + } + +at :: FilePath -> IO (Either ParseError (String, Page)) +at = undefined