module Taskell.IO.Markdown.Parser
    ( parse
    ) where

import ClassyPrelude

import Data.Attoparsec.Text hiding (parse)

import qualified Taskell.Data.Date    as D (Due, textToTime)
import qualified Taskell.Data.List    as L (List, create)
import qualified Taskell.Data.Lists   as LS (Lists)
import qualified Taskell.Data.Subtask as ST (Subtask, new)
import qualified Taskell.Data.Task    as T (Task, create)

import Taskell.IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput, taskOutput,
                                   titleOutput)
import Taskell.Utility.Parser     (lexeme, line)

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

symP :: Config -> Symbol
symP :: Config -> Symbol
symP Config
config Config -> Text
fn = Text -> Parser Text
string (Config -> Text
fn Config
config) Parser Text -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
char Char
' ' Parser Text Char -> () -> Parser Text ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

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

-- parsers
subtaskCompleteP :: Parser Bool
subtaskCompleteP :: Parser Bool
subtaskCompleteP = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x') (Char -> Bool) -> Parser Text Char -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Text Char
char Char
'[' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser Text Char
char Char
'x' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser Text Char
char Char
' ') Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
']' Parser Text Char -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
' ')

subtaskP :: Symbol -> Parser ST.Subtask
subtaskP :: Symbol -> Parser Subtask
subtaskP Symbol
sym = (Text -> Bool -> Subtask) -> Bool -> Text -> Subtask
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Bool -> Subtask
ST.new (Bool -> Text -> Subtask)
-> Parser Bool -> Parser Text (Text -> Subtask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Symbol
sym Config -> Text
subtaskOutput Parser Text () -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Bool
subtaskCompleteP) Parser Text (Text -> Subtask) -> Parser Text -> Parser Subtask
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
line

taskDescriptionP :: Symbol -> Parser (Maybe Text)
taskDescriptionP :: Symbol -> Parser (Maybe Text)
taskDescriptionP Symbol
sym = Text -> Maybe Text
forall a. MonoFoldable a => a -> Maybe a
emptyMay (Text -> Maybe Text) -> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
"\n" ([Text] -> Text) -> Parser Text [Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser Text [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Symbol
sym Config -> Text
descriptionOutput Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
line))

dueP :: Symbol -> Parser (Maybe D.Due)
dueP :: Symbol -> Parser (Maybe Due)
dueP Symbol
sym = (Text -> Maybe Due
D.textToTime (Text -> Maybe Due) -> Maybe Text -> Maybe Due
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe Text -> Maybe Due)
-> Parser (Maybe Text) -> Parser (Maybe Due)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Symbol
sym Config -> Text
dueOutput Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
line)

taskNameP :: Symbol -> Parser Text
taskNameP :: Symbol -> Parser Text
taskNameP Symbol
sym = Symbol
sym Config -> Text
taskOutput Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
line

taskP :: Symbol -> Parser T.Task
taskP :: Symbol -> Parser Task
taskP Symbol
sym =
    Text -> Maybe Due -> Maybe Text -> Seq Subtask -> Task
T.create (Text -> Maybe Due -> Maybe Text -> Seq Subtask -> Task)
-> Parser Text
-> Parser Text (Maybe Due -> Maybe Text -> Seq Subtask -> Task)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> Parser Text
taskNameP Symbol
sym Parser Text (Maybe Due -> Maybe Text -> Seq Subtask -> Task)
-> Parser (Maybe Due)
-> Parser Text (Maybe Text -> Seq Subtask -> Task)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Symbol -> Parser (Maybe Due)
dueP Symbol
sym Parser Text (Maybe Text -> Seq Subtask -> Task)
-> Parser (Maybe Text) -> Parser Text (Seq Subtask -> Task)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Symbol -> Parser (Maybe Text)
taskDescriptionP Symbol
sym Parser Text (Seq Subtask -> Task)
-> Parser Text (Seq Subtask) -> Parser Task
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    ([Subtask] -> Seq Subtask
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Subtask] -> Seq Subtask)
-> Parser Text [Subtask] -> Parser Text (Seq Subtask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Subtask -> Parser Text [Subtask]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Symbol -> Parser Subtask
subtaskP Symbol
sym))

listTitleP :: Symbol -> Parser Text
listTitleP :: Symbol -> Parser Text
listTitleP Symbol
sym = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Symbol
sym Config -> Text
titleOutput Parser Text () -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
line

listP :: Symbol -> Parser L.List
listP :: Symbol -> Parser List
listP Symbol
sym = Text -> Seq Task -> List
L.create (Text -> Seq Task -> List)
-> Parser Text -> Parser Text (Seq Task -> List)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> Parser Text
listTitleP Symbol
sym Parser Text (Seq Task -> List)
-> Parser Text (Seq Task) -> Parser List
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Task] -> Seq Task
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Task] -> Seq Task)
-> Parser Text [Task] -> Parser Text (Seq Task)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Task -> Parser Text [Task]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Symbol -> Parser Task
taskP Symbol
sym))

markdownP :: Symbol -> Parser LS.Lists
markdownP :: Symbol -> Parser Lists
markdownP Symbol
sym = [List] -> Lists
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([List] -> Lists) -> Parser Text [List] -> Parser Lists
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser List -> Parser Text [List]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Symbol -> Parser List
listP Symbol
sym) Parser Lists -> Parser Text () -> Parser Lists
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
skipSpace Parser Lists -> Parser Text () -> Parser Lists
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput

-- parse
parse :: Config -> Text -> Either Text LS.Lists
parse :: Config -> Text -> Either Text Lists
parse Config
config Text
txt = (String -> Text) -> Either String Lists -> Either Text Lists
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> String -> Text
forall a b. a -> b -> a
const Text
"Could not parse file.") (Parser Lists -> Text -> Either String Lists
forall a. Parser a -> Text -> Either String a
parseOnly (Symbol -> Parser Lists
markdownP (Config -> Symbol
symP Config
config)) Text
txt)