Draft a data structure for pages and make it part of the Blog datastructure

hablo.cabal

@@ -41,6 +41,7 @@ executable hablo
                      , HTML
                      , JS
                      , JSON
+                     , Page
                      , Paths_hablo
                      , Pretty
   -- other-extensions:

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}

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