Use articles file names as hash keys and set date as a metadata

hablo.cabal

@@ -44,6 +44,7 @@ executable hablo
                      , optparse-applicative
                      , parsec
                      , text
+                     , time
                      , unix
   ghc-options:         -Wall
   hs-source-dirs:      src

src/Article.hs

@@ -3,39 +3,48 @@
 module Article (
       Article(..)
     , at
+    , key
     , preview
     , titleP
   ) where
 
+import Control.Applicative ((<|>))
 import Data.Map (Map)
-import qualified Data.Map as Map (fromList)
+import qualified Data.Map as Map (fromList, alter)
-import System.FilePath (dropExtension)
+import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
-import System.Posix.Types (FileID)
+import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
-import System.Posix.Files (FileStatus, getFileStatus, fileID)
+import Foreign.C.Types (CTime)
+import System.FilePath (dropExtension, takeFileName)
+import System.Posix.Files (getFileStatus, modificationTime)
 import Text.ParserCombinators.Parsec (
       ParseError
     , Parser
-    , (<|>)
+--    , (<|>)
-    , anyChar, char, count, endBy, eof, many, many1, noneOf, oneOf, option, parse, skipMany, spaces, string, try
+    , anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
+    , oneOf, option, parse, skipMany, sourceLine, spaces, string, try
   )
 
+type Metadata = Map String String
+
 data Article = Article {
-      urlPath :: String
+      urlPath :: FilePath
-    , fileStatus :: FileStatus
     , title :: String
-    , metadata :: Map String String
+    , metadata :: Metadata
+    , bodyOffset :: Int
     , body :: [String]
   }
 
-articleP :: Parser (String, Map String String, [String])
+articleP :: Parser (String, Metadata, Int, [String])
 articleP =
-  skipMany eol *> headerP <* skipMany eol <*> (lines <$> many anyChar <* eof)
+  skipMany eol *> headerP <* skipMany eol <*> lineOffset <*> bodyP
   where
     headerP =
-        try ((,,) <$> titleP <* many eol <*> metadataP)
+        try ((,,,) <$> titleP <* many eol <*> metadataP)
-      <|> flip (,,) <$> metadataP  <* many eol<*> titleP
+      <|> flip (,,,) <$> metadataP  <* many eol<*> titleP
+    lineOffset = sourceLine <$> getPosition
+    bodyP = lines <$> many anyChar <* eof
 
-metadataP :: Parser (Map String String)
+metadataP :: Parser Metadata
 metadataP = Map.fromList <$> option [] (
     metaSectionSeparator *> many eol *>
     (try keyVal) `endBy` (many1 eol)
@@ -59,15 +68,37 @@ eol = try (string "\r\n") <|> string "\r" <|> string "\n"
 no :: String -> Parser String
 no = many1 . noneOf
 
-at :: FilePath -> IO (Either ParseError (FileID, Article))
+setDate :: String -> CTime -> Metadata -> Metadata
-at filePath = do
+setDate tzOffset defaultDate = Map.alter timeStamp "date"
-  fileStatus <- getFileStatus filePath
-  fmap (makeArticle fileStatus) . parse articleP filePath <$> readFile filePath
   where
-    makeArticle fileStatus (title, metadata, body) = (
+    formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"]
-          fileID fileStatus
+    epoch = show . (truncate :: POSIXTime -> Integer) . utcTimeToPOSIXSeconds
-        , Article {urlPath = dropExtension filePath, fileStatus, title, body, metadata}
+    timeStamp Nothing = Just $ show defaultDate
+    timeStamp (Just date) =
+      let dates = [date, date ++ " " ++ tzOffset] in
+      let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
+      foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
+
+at :: FilePath -> IO (Either ParseError (String, Article))
+at filePath = do
+  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) = (
+          key filePath
+        , Article {
+              urlPath = dropExtension filePath
+            , title
+            , metadata = metaFilter metadata
+            , bodyOffset
+            , body
+          }
       )
 
+key :: FilePath -> String
+key = dropExtension . takeFileName
+
 preview :: Int -> Article -> Article
 preview linesCount article = article {body = take linesCount $ body article}

src/Blog.hs

@@ -10,7 +10,7 @@ module Blog (
 import Arguments (Arguments(sourceDir))
 import qualified Arguments (name)
 import Article (Article)
-import qualified Article (at)
+import qualified Article (at, key)
 import Blog.Skin (Skin(..))
 import qualified Blog.Skin as Skin (build)
 import Control.Monad ((>=>), filterM, forM)
@@ -23,23 +23,21 @@ 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.Posix.Types (FileID)
-import System.Posix.Files (getFileStatus, fileID)
 
-type Collection = Map FileID Article
+type Collection = Map String Article
 
 data Blog = Blog {
       articles :: Collection
     , name :: String
     , root :: FilePath
     , skin :: Skin
-    , tags :: Map String (Set FileID)
+    , tags :: Map String (Set String)
   }
 
 get :: MonadReader Blog m => (Blog -> a) -> m a
 get = (<$> ask)
 
-findArticles :: FilePath -> IO (Map FileID Article)
+findArticles :: FilePath -> IO (Map String Article)
 findArticles =
   Files.find
   >=> filterM isMarkDownFile
@@ -50,17 +48,16 @@ findArticles =
       let correctExtension = takeExtension path == ".md"
       (correctExtension &&) <$> doesFileExist path
 
-tagged :: Collection -> FilePath -> IO (String, Set FileID)
+tagged :: Collection -> FilePath -> IO (String, Set String)
 tagged collection path = do
   links <- Files.find path
-  fileIDs <- forM links $ \link -> do
+  keys <- forM links $ \link -> do
     fileExists <- doesFileExist link
-    if fileExists
+    return $ if fileExists
-      then do
+      then let articleKey = Article.key link in
-        inode <- fileID <$> getFileStatus link
+        if Map.member articleKey collection then Set.singleton articleKey else Set.empty
-        return $ if Map.member inode collection then Set.singleton inode else Set.empty
+      else Set.empty
-      else return Set.empty
+  return (takeFileName path, foldl Set.union Set.empty keys)
-  return (takeFileName path, foldl Set.union Set.empty fileIDs)
 
 build :: Arguments -> IO Blog
 build arguments = withCurrentDirectory root $ do

src/HTML.hs

@@ -12,6 +12,7 @@ import Control.Monad (forM)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (MonadReader(..), ReaderT)
 import Data.List (sortOn)
+import Data.Map ((!))
 import qualified Data.Map as Map (elems, filterWithKey, toList)
 import Data.Ord (Down(..))
 import qualified Data.Set as Set (member)
@@ -21,7 +22,6 @@ import Lucid
 import Pretty ((.$))
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath.Posix ((</>), (<.>))
-import System.Posix.Files (modificationTime)
 
 data Collection = Collection {
       articlesFeatured :: [Article]
@@ -38,7 +38,7 @@ collection articlesFeatured tag = do
       , tag
     }
   where
-    sortByDate = sortOn (Down . modificationTime . fileStatus)
+    sortByDate = sortOn (Down . (! "date") . metadata)
 
 articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)]
 articlesLists (Collection {articlesFeatured, basePath, tag}) = do

src/JSON.hs

@@ -11,19 +11,16 @@ import qualified Blog (Blog(..), Skin(..))
 import Control.Monad.Reader (ReaderT, ask)
 import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
 import Data.ByteString.Lazy (ByteString)
-import Data.Map (Map, (!), foldlWithKey, mapKeys, mapWithKey)
+import Data.Map (Map, mapWithKey)
-import qualified Data.Map as Map (empty, filter, insert, keys)
+import qualified Data.Map as Map (filter, keys)
 import qualified Data.Set as Set (elems, member)
 import System.FilePath.Posix ((</>), (<.>))
-import System.Posix.Files (modificationTime)
-import System.Posix.Types (EpochTime, FileID)
 import GHC.Generics
 
-type ArticleID = Int
-
 data ArticleExport = ArticleExport {
       source :: String
     , title :: String
+    , bodyOffset :: Int
     , metadata :: Map String String
     , tagged :: [String]
   } deriving (Generic)
@@ -40,33 +37,29 @@ instance ToJSON SkinExport where
   toEncoding = genericToEncoding defaultOptions
 
 data BlogDB = BlogDB {
-      articles :: Map ArticleID ArticleExport
+      articles :: Map String ArticleExport
-    , tags :: Map String [ArticleID]
+    , tags :: Map String [String]
     , skin :: SkinExport
   } deriving (Generic)
 
 instance ToJSON BlogDB where
   toEncoding = genericToEncoding defaultOptions
 
-remap :: (Ord k1, Enum k2, Ord k2) => Map k1 a -> Map k1 k2
+export :: Blog -> String -> Article -> ArticleExport
-remap =
+export blog key article = ArticleExport {
-  snd . foldlWithKey (\(i, tempMap) key _ -> (succ i, Map.insert key i tempMap)) (toEnum 0, Map.empty)
-
-export :: Blog -> FileID -> Article -> ArticleExport
-export blog fileID article = ArticleExport {
       source = "/" </> Article.urlPath article <.> "md"
     , title = Article.title article
+    , bodyOffset = Article.bodyOffset article
     , metadata = Article.metadata article
-    , tagged = Map.keys . Map.filter (Set.member fileID) $ Blog.tags blog
+    , tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
   }
 
 exportBlog :: ReaderT Blog IO ByteString
 exportBlog = do
   blog <- ask
-  let reindex = remap $ Blog.articles blog
   return . encode $ BlogDB {
-        articles = mapKeys (reindex !) $ mapWithKey (export blog) (Blog.articles blog)
+        articles = mapWithKey (export blog) $ Blog.articles blog
-      , tags = fmap (reindex !) . Set.elems <$> Blog.tags blog
+      , tags = Set.elems <$> Blog.tags blog
       , skin = SkinExport {
           previewArticlesCount = Blog.previewArticlesCount $ Blog.skin blog
         , previewLinesCount = Blog.previewLinesCount $ Blog.skin blog