{-# 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}