{-# LANGUAGE NamedFieldPuns #-} module Article ( Article(..) , at , preview ) where import Control.Applicative ((<|>)) import qualified Data.Map as Map (alter) import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) import Foreign.C.Types (CTime) import Markdown (Markdown(..), MarkdownContent(..), Metadata) import qualified Markdown (at) import System.Posix.Files (getFileStatus, modificationTime) import Text.ParserCombinators.Parsec (ParseError) newtype Article = Article Markdown instance MarkdownContent Article where getMarkdown (Article markdown) = markdown setDate :: String -> CTime -> Metadata -> Metadata setDate tzOffset defaultDate = Map.alter timeStamp "date" where formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"] epoch = show . (truncate :: POSIXTime -> Integer) . utcTimeToPOSIXSeconds 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) makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article) makeArticle metaFilter markdown@(Markdown {key, metadata}) = (key, Article $ markdown {metadata = metaFilter metadata}) at :: FilePath -> IO (Either ParseError (String, Article)) at filePath = do tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone fileDate <- modificationTime <$> getFileStatus filePath fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath preview :: Int -> Article -> Markdown preview linesCount (Article markdown@(Markdown {body})) = markdown {body = take linesCount $ body}