{-# LANGUAGE TemplateHaskell #-}

module Taskell.IO.HTTP.Trello.Card
    ( Card
    , idChecklists
    , cardToTask
    , setChecklists
    ) where

import ClassyPrelude

import Control.Lens (makeLenses, (&), (.~), (^.))

import Taskell.IO.HTTP.Aeson                (deriveFromJSON)
import Taskell.IO.HTTP.Trello.ChecklistItem (ChecklistItem, checklistItemToSubTask)

import           Taskell.Data.Date (isoToTime)
import qualified Taskell.Data.Task as T (Task, due, new, setDescription, subtasks)

data Card = Card
    { Card -> Text
_name         :: Text
    , Card -> Text
_desc         :: Text
    , Card -> Maybe Text
_due          :: Maybe Text
    , Card -> [Text]
_idChecklists :: [Text]
    , Card -> Maybe [ChecklistItem]
_checklists   :: Maybe [ChecklistItem]
    } deriving (Card -> Card -> Bool
(Card -> Card -> Bool) -> (Card -> Card -> Bool) -> Eq Card
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Card -> Card -> Bool
$c/= :: Card -> Card -> Bool
== :: Card -> Card -> Bool
$c== :: Card -> Card -> Bool
Eq, Int -> Card -> ShowS
[Card] -> ShowS
Card -> String
(Int -> Card -> ShowS)
-> (Card -> String) -> ([Card] -> ShowS) -> Show Card
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Card] -> ShowS
$cshowList :: [Card] -> ShowS
show :: Card -> String
$cshow :: Card -> String
showsPrec :: Int -> Card -> ShowS
$cshowsPrec :: Int -> Card -> ShowS
Show)

-- strip underscores from field labels
$(deriveFromJSON ''Card)

-- create lenses
$(makeLenses ''Card)

-- operations
cardToTask :: Card -> T.Task
cardToTask :: Card -> Task
cardToTask Card
card =
    Task
task Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& (Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task
Lens' Task (Maybe Due)
T.due ((Maybe Due -> Identity (Maybe Due)) -> Task -> Identity Task)
-> Maybe Due -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Maybe Due
isoToTime (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Card
card Card -> Getting (Maybe Text) Card (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Card (Maybe Text)
Lens' Card (Maybe Text)
due)) Task -> (Task -> Task) -> Task
forall a b. a -> (a -> b) -> b
& (Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task
Lens' Task (Seq Subtask)
T.subtasks ((Seq Subtask -> Identity (Seq Subtask)) -> Task -> Identity Task)
-> Seq Subtask -> Task -> Task
forall s t a b. ASetter s t a b -> b -> s -> t
.~
    [Element (Seq Subtask)] -> Seq Subtask
forall seq. IsSequence seq => [Element seq] -> seq
fromList (ChecklistItem -> Subtask
checklistItemToSubTask (ChecklistItem -> Subtask) -> [ChecklistItem] -> [Subtask]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChecklistItem] -> Maybe [ChecklistItem] -> [ChecklistItem]
forall a. a -> Maybe a -> a
fromMaybe [] (Card
card Card
-> Getting (Maybe [ChecklistItem]) Card (Maybe [ChecklistItem])
-> Maybe [ChecklistItem]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [ChecklistItem]) Card (Maybe [ChecklistItem])
Lens' Card (Maybe [ChecklistItem])
checklists))
  where
    task :: Task
task = Text -> Task -> Task
T.setDescription (Card
card Card -> Getting Text Card Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Card Text
Lens' Card Text
desc) (Task -> Task) -> Task -> Task
forall a b. (a -> b) -> a -> b
$ Text -> Task
T.new (Card
card Card -> Getting Text Card Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Card Text
Lens' Card Text
name)

setChecklists :: Card -> [ChecklistItem] -> Card
setChecklists :: Card -> [ChecklistItem] -> Card
setChecklists Card
card [ChecklistItem]
cls = Card
card Card -> (Card -> Card) -> Card
forall a b. a -> (a -> b) -> b
& (Maybe [ChecklistItem] -> Identity (Maybe [ChecklistItem]))
-> Card -> Identity Card
Lens' Card (Maybe [ChecklistItem])
checklists ((Maybe [ChecklistItem] -> Identity (Maybe [ChecklistItem]))
 -> Card -> Identity Card)
-> Maybe [ChecklistItem] -> Card -> Card
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ChecklistItem] -> Maybe [ChecklistItem]
forall a. a -> Maybe a
Just [ChecklistItem]
cls