77 lines
2.3 KiB
Haskell
77 lines
2.3 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Markdown (
|
|
Markdown(..)
|
|
, MarkdownContent(..)
|
|
, Metadata
|
|
, at
|
|
, getKey
|
|
) where
|
|
|
|
import Control.Applicative ((<|>))
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map (fromList)
|
|
import System.FilePath (dropExtension, takeFileName)
|
|
import Text.ParserCombinators.Parsec (
|
|
ParseError, Parser
|
|
, (<?>)
|
|
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
|
|
, oneOf, option, parse, skipMany, sourceLine, sourceName, string, try
|
|
)
|
|
|
|
type Metadata = Map String String
|
|
data Markdown = Markdown {
|
|
key :: String
|
|
, path :: String
|
|
, title :: String
|
|
, metadata :: Metadata
|
|
, bodyOffset :: Int
|
|
, body :: [String]
|
|
}
|
|
|
|
class MarkdownContent a where
|
|
getMarkdown :: a -> Markdown
|
|
|
|
parser :: Parser Markdown
|
|
parser = do
|
|
(title, metadata) <- skipMany eol *> (headerP <|> reverseHeaderP)
|
|
bodyOffset <- skipMany eol *> (pred . sourceLine <$> getPosition)
|
|
body <- lines <$> many anyChar <* eof
|
|
inputFile <- sourceName <$> getPosition
|
|
let (key, path) = (getKey inputFile, dropExtension inputFile)
|
|
return $ Markdown {key, path, title, metadata, bodyOffset, body}
|
|
where
|
|
headerP = (,) <$> titleP <* many eol <*> metadataP
|
|
reverseHeaderP = flip (,) <$> metadataP <* many eol<*> titleP
|
|
|
|
metadataP :: Parser Metadata
|
|
metadataP = Map.fromList <$> option [] (
|
|
metaSectionSeparator *> many eol *>
|
|
(try keyVal) `endBy` (many1 eol)
|
|
<* metaSectionSeparator
|
|
) <?> "metadata section"
|
|
where
|
|
metaSectionSeparator = count 3 (oneOf "~-") *> eol
|
|
spaces = skipMany $ char ' '
|
|
keyVal = (,) <$> (no ": \r\n" <* 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
|
|
<?> "'#' or '=' to underline the title"
|
|
|
|
eol :: Parser String
|
|
eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
|
|
|
|
no :: String -> Parser String
|
|
no = many1 . noneOf
|
|
|
|
getKey :: FilePath -> String
|
|
getKey = dropExtension . takeFileName
|
|
|
|
at :: FilePath -> IO (Either ParseError Markdown)
|
|
at filePath = parse parser filePath <$> readFile filePath
|