74 lines
2.2 KiB
Haskell
74 lines
2.2 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module Article (
|
|
Article(..)
|
|
, at
|
|
, preview
|
|
, titleP
|
|
) where
|
|
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map (fromList)
|
|
import System.FilePath (dropExtension)
|
|
import System.Posix.Types (FileID)
|
|
import System.Posix.Files (FileStatus, getFileStatus, fileID)
|
|
import Text.ParserCombinators.Parsec (
|
|
ParseError
|
|
, Parser
|
|
, (<|>)
|
|
, anyChar, char, count, endBy, eof, many, many1, noneOf, oneOf, option, parse, skipMany, spaces, string, try
|
|
)
|
|
|
|
data Article = Article {
|
|
urlPath :: String
|
|
, fileStatus :: FileStatus
|
|
, title :: String
|
|
, metadata :: Map String String
|
|
, body :: [String]
|
|
}
|
|
|
|
articleP :: Parser (String, Map String String, [String])
|
|
articleP =
|
|
skipMany eol *> headerP <* skipMany eol <*> (lines <$> many anyChar <* eof)
|
|
where
|
|
headerP =
|
|
try ((,,) <$> titleP <* many eol <*> metadataP)
|
|
<|> flip (,,) <$> metadataP <* many eol<*> titleP
|
|
|
|
metadataP :: Parser (Map String String)
|
|
metadataP = Map.fromList <$> option [] (
|
|
metaSectionSeparator *> many eol *>
|
|
(try keyVal) `endBy` (many1 eol)
|
|
<* metaSectionSeparator
|
|
)
|
|
where
|
|
metaSectionSeparator = count 3 (oneOf "~-") *> eol
|
|
keyVal = (,) <$> (no ": " <* spaces <* char ':' <* spaces) <*> no "\r\n"
|
|
|
|
titleP :: Parser String
|
|
titleP = try (singleLine <|> underlined)
|
|
where
|
|
singleLine = char '#' *> char ' ' *> no "\r\n" <* eol
|
|
underlined =
|
|
no "\r\n" <* eol
|
|
>>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
|
|
|
|
eol :: Parser String
|
|
eol = try (string "\r\n") <|> string "\r" <|> string "\n"
|
|
|
|
no :: String -> Parser String
|
|
no = many1 . noneOf
|
|
|
|
at :: FilePath -> IO (Either ParseError (FileID, Article))
|
|
at filePath = do
|
|
fileStatus <- getFileStatus filePath
|
|
fmap (makeArticle fileStatus) . parse articleP filePath <$> readFile filePath
|
|
where
|
|
makeArticle fileStatus (title, metadata, body) = (
|
|
fileID fileStatus
|
|
, Article {urlPath = dropExtension filePath, fileStatus, title, body, metadata}
|
|
)
|
|
|
|
preview :: Int -> Article -> Article
|
|
preview linesCount article = article {body = take linesCount $ body article}
|