hablo 1.0.0.0 → 1.0.1.0

raw patch · 4 files changed

+37/−21 lines, 4 files

Files

• CHANGELOG.md +4/−0
• hablo.cabal +1/−1
• src/Article.hs +20/−15
• src/Blog.hs +12/−5

@@ -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

@@ -3,7 +3,7 @@ -- 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

@@ -18,6 +18,7 @@ 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 @@     , 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 @@     metaSectionSeparator *> many eol *>     (try keyVal) `endBy` (many1 eol)     <* metaSectionSeparator-  )+  ) <?> "metadata section"   where     metaSectionSeparator = count 3 (oneOf "~-") *> eol     spaces = skipMany $ char ' '@@ -60,9 +63,10 @@     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,23 +82,24 @@       let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in       foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes) +makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article)+makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = (+      getKey filePath+    , Article {+          key = getKey filePath+        , title+        , metadata = metaFilter metadata+        , bodyOffset+        , body+      }+  )+ at :: FilePath -> IO (Either ParseError (String, Article)) at filePath = do   tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone   fileDate <- modificationTime <$> getFileStatus filePath-  let build = makeArticle (setDate tzOffset fileDate)+  let build = makeArticle filePath (setDate tzOffset fileDate)   fmap build . parse articleP filePath <$> readFile filePath-  where-    makeArticle metaFilter (title, metadata, bodyOffset, body) = (-          getKey filePath-        , Article {-              key = getKey filePath-            , title-            , metadata = metaFilter metadata-            , bodyOffset-            , body-          }-      )  getKey :: FilePath -> String getKey = dropExtension . takeFileName

@@ -19,11 +19,10 @@ 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, lookup)-import qualified Data.Map as Map (fromList)+import Data.Map (Map, insert, lookup)+import qualified Data.Map as Map (empty, fromList) import Data.Set (Set) import qualified Data.Set as Set (empty, null, singleton, union) import Files (File(..), absolute)@@ -31,6 +30,7 @@ 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 @@ 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"