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

-- config symbol parsing
type Symbol = (Config -> Text) -> Parser ()

symP :: Config -> Symbol
symP config fn = string (fn config) *> char ' ' $> ()

-- utility functions
emptyMay :: (MonoFoldable a) => a -> Maybe a
emptyMay a =
    if null a
        then Nothing
        else Just a

-- parsers
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
parse :: Config -> Text -> Either Text LS.Lists
parse config txt = first (const "Could not parse file.") (parseOnly (markdownP (symP config)) txt)