module Taskell.IO.Markdown.Serializer
    ( serialize
    , MarkdownInfo(MarkdownInfo)
    ) where

import ClassyPrelude

import Control.Lens ((^.))

import qualified Data.Text as T (splitOn)

import Data.Time.Zones (TZ)

import           Taskell.Data.Date    (Due, timeToOutput, timeToOutputLocal)
import           Taskell.Data.List    (List, tasks, title)
import           Taskell.Data.Lists   (Lists)
import qualified Taskell.Data.Subtask as ST (Subtask, complete, name)
import qualified Taskell.Data.Task    as T (Task, description, due, name, subtasks)

import Taskell.IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes, subtaskOutput,
                                   taskOutput, titleOutput)

data MarkdownInfo = MarkdownInfo
    { MarkdownInfo -> TZ
mdTZ     :: TZ
    , MarkdownInfo -> Config
mdConfig :: Config
    }

type ReaderMarkdown = Reader MarkdownInfo

-- utility functions
askConf :: (Config -> a) -> ReaderMarkdown a
askConf :: (Config -> a) -> ReaderMarkdown a
askConf Config -> a
fn = Config -> a
fn (Config -> a)
-> ReaderT MarkdownInfo Identity Config -> ReaderMarkdown a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MarkdownInfo -> Config) -> ReaderT MarkdownInfo Identity Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MarkdownInfo -> Config
mdConfig

strMay :: (Applicative m) => (a -> m Text) -> Maybe a -> m Text
strMay :: (a -> m Text) -> Maybe a -> m Text
strMay a -> m Text
_ Maybe a
Nothing   = Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
strMay a -> m Text
fn (Just a
a) = a -> m Text
fn a
a

space :: Text -> Text -> Text
space :: Text -> Text -> Text
space Text
symbol Text
txt = Text
symbol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt

timeFn :: ReaderMarkdown (Due -> Text)
timeFn :: ReaderMarkdown (Due -> Text)
timeFn = (Due -> Text) -> (Due -> Text) -> Bool -> Due -> Text
forall a. a -> a -> Bool -> a
bool Due -> Text
timeToOutput ((Due -> Text) -> Bool -> Due -> Text)
-> ReaderMarkdown (Due -> Text)
-> ReaderT MarkdownInfo Identity (Bool -> Due -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TZ -> Due -> Text
timeToOutputLocal (TZ -> Due -> Text)
-> ReaderT MarkdownInfo Identity TZ -> ReaderMarkdown (Due -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MarkdownInfo -> TZ) -> ReaderT MarkdownInfo Identity TZ
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MarkdownInfo -> TZ
mdTZ) ReaderT MarkdownInfo Identity (Bool -> Due -> Text)
-> ReaderT MarkdownInfo Identity Bool
-> ReaderMarkdown (Due -> Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Config -> Bool) -> ReaderT MarkdownInfo Identity Bool
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Bool
localTimes

-- serializers
subtaskCompleteS :: Bool -> Text
subtaskCompleteS :: Bool -> Text
subtaskCompleteS Bool
True  = Text
"[x]"
subtaskCompleteS Bool
False = Text
"[ ]"

subtaskS :: ST.Subtask -> ReaderMarkdown Text
subtaskS :: Subtask -> ReaderMarkdown Text
subtaskS Subtask
st = do
    Text
symbol <- (Config -> Text) -> ReaderMarkdown Text
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Text
subtaskOutput
    Text -> ReaderMarkdown Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderMarkdown Text) -> Text -> ReaderMarkdown Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unwords [Text
symbol, Bool -> Text
subtaskCompleteS (Subtask
st Subtask -> Getting Bool Subtask Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Subtask Bool
Lens' Subtask Bool
ST.complete), Subtask
st Subtask -> Getting Text Subtask Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Subtask Text
Lens' Subtask Text
ST.name]

subtasksS :: Seq ST.Subtask -> ReaderMarkdown Text
subtasksS :: Seq Subtask -> ReaderMarkdown Text
subtasksS Seq Subtask
sts = Element (Seq Text) -> Seq Text -> Element (Seq Text)
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element (Seq Text)
"\n" (Seq Text -> Text)
-> ReaderT MarkdownInfo Identity (Seq Text) -> ReaderMarkdown Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (ReaderMarkdown Text)
-> ReaderT MarkdownInfo Identity (Seq Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Subtask -> ReaderMarkdown Text
subtaskS (Subtask -> ReaderMarkdown Text)
-> Seq Subtask -> Seq (ReaderMarkdown Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Subtask
sts)

descriptionS :: Text -> ReaderMarkdown Text
descriptionS :: Text -> ReaderMarkdown Text
descriptionS Text
desc = do
    Text
symbol <- (Config -> Text) -> ReaderMarkdown Text
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Text
descriptionOutput
    Text -> ReaderMarkdown Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderMarkdown Text)
-> ([Text] -> Text) -> [Text] -> ReaderMarkdown Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element [Text] -> [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element [Text]
"\n" ([Text] -> ReaderMarkdown Text) -> [Text] -> ReaderMarkdown Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
space Text
symbol (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [Text]
T.splitOn Text
"\n" Text
desc

dueS :: Due -> ReaderMarkdown Text
dueS :: Due -> ReaderMarkdown Text
dueS Due
due = do
    Text
symbol <- (Config -> Text) -> ReaderMarkdown Text
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Text
dueOutput
    Due -> Text
fn <- ReaderMarkdown (Due -> Text)
timeFn
    Text -> ReaderMarkdown Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderMarkdown Text) -> Text -> ReaderMarkdown Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
space Text
symbol (Due -> Text
fn Due
due)

nameS :: Text -> ReaderMarkdown Text
nameS :: Text -> ReaderMarkdown Text
nameS Text
desc = Text -> Text -> Text
space (Text -> Text -> Text)
-> ReaderMarkdown Text
-> ReaderT MarkdownInfo Identity (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Config -> Text) -> ReaderMarkdown Text
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Text
taskOutput ReaderT MarkdownInfo Identity (Text -> Text)
-> ReaderMarkdown Text -> ReaderMarkdown Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ReaderMarkdown Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
desc

taskS :: T.Task -> ReaderMarkdown Text
taskS :: Task -> ReaderMarkdown Text
taskS Task
t =
    [Text] -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [Text] -> Bool) -> [Text] -> [Text]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> Text)
-> ReaderT MarkdownInfo Identity [Text] -> ReaderMarkdown Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    [ReaderMarkdown Text] -> ReaderT MarkdownInfo Identity [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ Text -> ReaderMarkdown Text
nameS (Task
t Task -> Getting Text Task Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Task Text
Lens' Task Text
T.name)
        , (Due -> ReaderMarkdown Text) -> Maybe Due -> ReaderMarkdown Text
forall (m :: * -> *) a.
Applicative m =>
(a -> m Text) -> Maybe a -> m Text
strMay Due -> ReaderMarkdown Text
dueS (Task
t Task -> Getting (Maybe Due) Task (Maybe Due) -> Maybe Due
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Due) Task (Maybe Due)
Lens' Task (Maybe Due)
T.due)
        , (Text -> ReaderMarkdown Text) -> Maybe Text -> ReaderMarkdown Text
forall (m :: * -> *) a.
Applicative m =>
(a -> m Text) -> Maybe a -> m Text
strMay Text -> ReaderMarkdown Text
descriptionS (Task
t Task -> Getting (Maybe Text) Task (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Task (Maybe Text)
Lens' Task (Maybe Text)
T.description)
        , Seq Subtask -> ReaderMarkdown Text
subtasksS (Task
t Task -> Getting (Seq Subtask) Task (Seq Subtask) -> Seq Subtask
forall s a. s -> Getting a s a -> a
^. Getting (Seq Subtask) Task (Seq Subtask)
Lens' Task (Seq Subtask)
T.subtasks)
        ]

listS :: List -> ReaderMarkdown Text
listS :: List -> ReaderMarkdown Text
listS List
list = do
    Text
symbol <- (Config -> Text) -> ReaderMarkdown Text
forall a. (Config -> a) -> ReaderMarkdown a
askConf Config -> Text
titleOutput
    Text
taskString <- Seq Text -> Text
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat (Seq Text -> Text)
-> ReaderT MarkdownInfo Identity (Seq Text) -> ReaderMarkdown Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (ReaderMarkdown Text)
-> ReaderT MarkdownInfo Identity (Seq Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Task -> ReaderMarkdown Text
taskS (Task -> ReaderMarkdown Text)
-> Seq Task -> Seq (ReaderMarkdown Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List
list List -> Getting (Seq Task) List (Seq Task) -> Seq Task
forall s a. s -> Getting a s a -> a
^. Getting (Seq Task) List (Seq Task)
Lens' List (Seq Task)
tasks)
    Text -> ReaderMarkdown Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ReaderMarkdown Text)
-> (Text -> Text) -> Text -> ReaderMarkdown Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> Text
space Text
symbol (Text -> ReaderMarkdown Text) -> Text -> ReaderMarkdown Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [List
list List -> Getting Text List Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text List Text
Lens' List Text
title, Text
"\n\n", Text
taskString]

-- serialize
serialize :: Lists -> ReaderMarkdown Text
serialize :: Lists -> ReaderMarkdown Text
serialize Lists
ls = Element (Seq Text) -> Seq Text -> Element (Seq Text)
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
intercalate Element (Seq Text)
"\n" (Seq Text -> Text)
-> ReaderT MarkdownInfo Identity (Seq Text) -> ReaderMarkdown Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (ReaderMarkdown Text)
-> ReaderT MarkdownInfo Identity (Seq Text)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (List -> ReaderMarkdown Text
listS (List -> ReaderMarkdown Text) -> Lists -> Seq (ReaderMarkdown Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lists
ls)