46 lines
1.8 KiB
Haskell
46 lines
1.8 KiB
Haskell
{-# 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}
|