Print warnings about malformed Markdown articles instead of ignoring them silently

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for hablo
 
+## 1.0.1.0 -- 2019-04-28
+
+* Print warnings about malformed Markdown articles instead of ignoring them silently
+
 ## 1.0.0.0 -- 2019-04-19
 
 * First version. Finally released by an unexpecting developer

hablo.cabal

@@ -3,7 +3,7 @@ cabal-version:       >= 1.10
 -- For further documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hablo
-version:             1.0.0.0
+version:             1.0.1.0
 synopsis:            A minimalist static blog generator
 description:
   Hablo is a fediverse-oriented static blog generator for articles written

src/Article.hs

@@ -18,6 +18,7 @@ import System.Posix.Files (getFileStatus, modificationTime)
 import Text.ParserCombinators.Parsec (
       ParseError
     , Parser
+    , (<?>)
     , anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
     , oneOf, option, parse, skipMany, sourceLine, string, try
   )
@@ -32,7 +33,9 @@ data Article = Article {
     , body :: [String]
   }
 
-articleP :: Parser (String, Metadata, Int, [String])
+type ProtoArticle = (String, Metadata, Int, [String])
+
+articleP :: Parser ProtoArticle
 articleP =
   skipMany eol *> headerP <* skipMany eol <*> lineOffset <*> bodyP
   where
@@ -47,7 +50,7 @@ metadataP = Map.fromList <$> option [] (
     metaSectionSeparator *> many eol *>
     (try keyVal) `endBy` (many1 eol)
     <* metaSectionSeparator
-  )
+  ) <?> "metadata section"
   where
     metaSectionSeparator = count 3 (oneOf "~-") *> eol
     spaces = skipMany $ char ' '
@@ -60,9 +63,10 @@ titleP = try (singleLine <|> underlined)
     underlined =
       no "\r\n" <* eol
       >>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
+      <?> "'#' or '=' to underline the title"
 
 eol :: Parser String
-eol = try (string "\r\n") <|> string "\r" <|> string "\n"
+eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
 
 no :: String -> Parser String
 no = many1 . noneOf
@@ -78,14 +82,8 @@ setDate tzOffset defaultDate = Map.alter timeStamp "date"
       let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
       foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
 
-at :: FilePath -> IO (Either ParseError (String, Article))
+makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article)
-at filePath = do
+makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = (
-  tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
-  fileDate <- modificationTime <$> getFileStatus filePath
-  let build = makeArticle (setDate tzOffset fileDate)
-  fmap build . parse articleP filePath <$> readFile filePath
-  where
-    makeArticle metaFilter (title, metadata, bodyOffset, body) = (
       getKey filePath
     , Article {
           key = getKey filePath
@@ -96,6 +94,13 @@ at filePath = do
       }
   )
 
+at :: FilePath -> IO (Either ParseError (String, Article))
+at filePath = do
+  tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
+  fileDate <- modificationTime <$> getFileStatus filePath
+  let build = makeArticle filePath (setDate tzOffset fileDate)
+  fmap build . parse articleP filePath <$> readFile filePath
+
 getKey :: FilePath -> String
 getKey = dropExtension . takeFileName
 

src/Blog.hs

@@ -19,11 +19,10 @@ import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
 import Blog.Wording (Wording(..))
 import qualified Blog.Wording as Wording (build)
-import Control.Monad ((>=>), filterM, forM)
+import Control.Monad ((>=>), filterM, foldM, forM)
 import Control.Monad.Reader (MonadReader, ask)
-import Data.Either (rights)
+import Data.Map (Map, insert, lookup)
-import Data.Map (Map, lookup)
+import qualified Data.Map as Map (empty, fromList)
-import qualified Data.Map as Map (fromList)
 import Data.Set (Set)
 import qualified Data.Set as Set (empty, null, singleton, union)
 import Files (File(..), absolute)
@@ -31,6 +30,7 @@ import qualified Files (find)
 import Prelude hiding (lookup)
 import System.Directory (doesFileExist, withCurrentDirectory)
 import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
+import Text.Parsec (ParseError)
 
 type Collection = Map String Article
 
@@ -46,12 +46,19 @@ 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 accumulator (Left parseErrors) =
+  forM [show parseErrors, "=> Ignoring this article"] putStrLn
+  >> return accumulator
+keepOrWarn accumulator (Right (key, article)) =
+  return $ insert key article accumulator
+
 findArticles :: FilePath -> IO (Map String Article)
 findArticles =
   Files.find
   >=> filterM isMarkDownFile
   >=> mapM Article.at
-  >=> return . Map.fromList . rights
+  >=> foldM keepOrWarn Map.empty
   where
     isMarkDownFile path = do
       let correctExtension = takeExtension path == ".md"