{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module IO.Markdown.Parser
( parse
) where
import ClassyPrelude
import Data.Attoparsec.Text hiding (parse)
import qualified Data.Taskell.Date as D (Due, textToTime)
import qualified Data.Taskell.List as L (List, create)
import qualified Data.Taskell.Lists as LS (Lists)
import qualified Data.Taskell.Subtask as ST (Subtask, new)
import qualified Data.Taskell.Task as T (Task, create)
import IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput, taskOutput,
titleOutput)
import Utility.Parser (lexeme, line)
type Symbol = (Config -> Text) -> Parser ()
symP :: Config -> Symbol
symP config fn = string (fn config) *> char ' ' $> ()
emptyMay :: (MonoFoldable a) => a -> Maybe a
emptyMay a =
if null a
then Nothing
else Just a
subtaskCompleteP :: Parser Bool
subtaskCompleteP = (== 'x') <$> (char '[' *> (char 'x' <|> char ' ') <* char ']' <* char ' ')
subtaskP :: Symbol -> Parser ST.Subtask
subtaskP sym = flip ST.new <$> (sym subtaskOutput *> subtaskCompleteP) <*> line
taskDescriptionP :: Symbol -> Parser (Maybe Text)
taskDescriptionP sym = emptyMay <$> (intercalate "\n" <$> many' (sym descriptionOutput *> line))
dueP :: Symbol -> Parser (Maybe D.Due)
dueP sym = (D.textToTime =<<) <$> optional (sym dueOutput *> line)
taskNameP :: Symbol -> Parser Text
taskNameP sym = sym taskOutput *> line
taskP :: Symbol -> Parser T.Task
taskP sym =
T.create <$> taskNameP sym <*> dueP sym <*> taskDescriptionP sym <*>
(fromList <$> many' (subtaskP sym))
listTitleP :: Symbol -> Parser Text
listTitleP sym = lexeme $ sym titleOutput *> line
listP :: Symbol -> Parser L.List
listP sym = L.create <$> listTitleP sym <*> (fromList <$> many' (taskP sym))
markdownP :: Symbol -> Parser LS.Lists
markdownP sym = fromList <$> many1 (listP sym) <* endOfInput
parse :: Config -> Text -> Either Text LS.Lists
parse config txt = first (const "Could not parse file.") (parseOnly (markdownP (symP config)) txt)