{-# LANGUAGE TemplateHaskell #-}

module Taskell.IO.HTTP.GitHub.AutomatedCard
    ( AutomatedCard(AutomatedCard)
    , automatedCardToTask
    ) where

import ClassyPrelude

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

import qualified Taskell.Data.Task              as T (Task, new, setDescription)
import           Taskell.IO.HTTP.Aeson          (deriveFromJSON)
import           Taskell.IO.HTTP.GitHub.Utility (cleanUp)

data AutomatedCard = AutomatedCard
    { AutomatedCard -> Text
_title :: Text
    , AutomatedCard -> Text
_body  :: Text
    } deriving (AutomatedCard -> AutomatedCard -> Bool
(AutomatedCard -> AutomatedCard -> Bool)
-> (AutomatedCard -> AutomatedCard -> Bool) -> Eq AutomatedCard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutomatedCard -> AutomatedCard -> Bool
$c/= :: AutomatedCard -> AutomatedCard -> Bool
== :: AutomatedCard -> AutomatedCard -> Bool
$c== :: AutomatedCard -> AutomatedCard -> Bool
Eq, Int -> AutomatedCard -> ShowS
[AutomatedCard] -> ShowS
AutomatedCard -> String
(Int -> AutomatedCard -> ShowS)
-> (AutomatedCard -> String)
-> ([AutomatedCard] -> ShowS)
-> Show AutomatedCard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutomatedCard] -> ShowS
$cshowList :: [AutomatedCard] -> ShowS
show :: AutomatedCard -> String
$cshow :: AutomatedCard -> String
showsPrec :: Int -> AutomatedCard -> ShowS
$cshowsPrec :: Int -> AutomatedCard -> ShowS
Show)

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

-- create lenses
$(makeLenses ''AutomatedCard)

-- operations
automatedCardToTask :: AutomatedCard -> T.Task
automatedCardToTask :: AutomatedCard -> Task
automatedCardToTask AutomatedCard
automatedCard = Text -> Update
T.setDescription (Text -> Text
cleanUp (AutomatedCard
automatedCard AutomatedCard -> Getting Text AutomatedCard Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text AutomatedCard Text
Lens' AutomatedCard Text
body)) Task
task
  where
    task :: Task
task = Text -> Task
T.new (Text -> Task) -> Text -> Task
forall a b. (a -> b) -> a -> b
$ Text -> Text
cleanUp (AutomatedCard
automatedCard AutomatedCard -> Getting Text AutomatedCard Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text AutomatedCard Text
Lens' AutomatedCard Text
title)