module Taskell.IO.HTTP.Trello
    ( TrelloToken
    , TrelloBoardID
    , getLists
    ) where

import ClassyPrelude

import Control.Lens ((^.))

import Data.Aeson
import Network.HTTP.Simple (getResponseBody, getResponseStatusCode, httpBS, parseRequest)

import Taskell.IO.HTTP.Aeson                (parseError)
import Taskell.IO.HTTP.Trello.Card          (Card, idChecklists, setChecklists)
import Taskell.IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems)
import Taskell.IO.HTTP.Trello.List          (List, cards, listToList, setCards)

import Taskell.Data.Lists (Lists)

type ReaderTrelloToken a = ReaderT TrelloToken IO a

type TrelloToken = Text

type TrelloBoardID = Text

type TrelloChecklistID = Text

key :: Text
key :: Text
key = Text
"80dbcf6f88f62cc5639774e13342c20b"

root :: Text
root :: Text
root = Text
"https://api.trello.com/1/"

fullURL :: Text -> ReaderTrelloToken String
fullURL :: Text -> ReaderTrelloToken String
fullURL Text
uri = do
    Text
token <- ReaderT Text IO Text
forall r (m :: * -> *). MonadReader r m => m r
ask
    String -> ReaderTrelloToken String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ReaderTrelloToken String)
-> (Text -> String) -> Text -> ReaderTrelloToken String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> String
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> ReaderTrelloToken String)
-> Text -> ReaderTrelloToken String
forall a b. (a -> b) -> a -> b
$ [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
root, Text
uri, Text
"&key=", Text
key, Text
"&token=", Text
token]

boardURL :: TrelloBoardID -> ReaderTrelloToken String
boardURL :: Text -> ReaderTrelloToken String
boardURL Text
board =
    Text -> ReaderTrelloToken String
fullURL (Text -> ReaderTrelloToken String)
-> Text -> ReaderTrelloToken String
forall a b. (a -> b) -> a -> b
$
    [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat
        [ Text
"boards/"
        , Text
board
        , Text
"/lists"
        , Text
"?cards=open"
        , Text
"&card_fields=name,due,desc,idChecklists"
        , Text
"&fields=name,cards"
        ]

checklistURL :: TrelloChecklistID -> ReaderTrelloToken String
checklistURL :: Text -> ReaderTrelloToken String
checklistURL Text
checklist =
    Text -> ReaderTrelloToken String
fullURL (Text -> ReaderTrelloToken String)
-> Text -> ReaderTrelloToken String
forall a b. (a -> b) -> a -> b
$ [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
"checklists/", Text
checklist, Text
"?fields=id", Text
"&checkItem_fields=name,state"]

trelloListsToLists :: [List] -> Lists
trelloListsToLists :: [List] -> Lists
trelloListsToLists [List]
ls = [Element Lists] -> Lists
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([Element Lists] -> Lists) -> [Element Lists] -> Lists
forall a b. (a -> b) -> a -> b
$ List -> List
listToList (List -> List) -> [List] -> [List]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [List]
ls

fetch :: String -> IO (Int, ByteString)
fetch :: String -> IO (Int, ByteString)
fetch String
url = do
    Request
request <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
    Response ByteString
response <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS Request
request
    (Int, ByteString) -> IO (Int, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
response, Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
response)

getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem])
getChecklist :: Text -> ReaderTrelloToken (Either Text [ChecklistItem])
getChecklist Text
checklist = do
    String
url <- Text -> ReaderTrelloToken String
checklistURL Text
checklist
    (Int
status, ByteString
body) <- IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString))
-> IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO (Int, ByteString)
fetch String
url
    Either Text [ChecklistItem]
-> ReaderTrelloToken (Either Text [ChecklistItem])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [ChecklistItem]
 -> ReaderTrelloToken (Either Text [ChecklistItem]))
-> Either Text [ChecklistItem]
-> ReaderTrelloToken (Either Text [ChecklistItem])
forall a b. (a -> b) -> a -> b
$
        case Int
status of
            Int
200 ->
                case (ChecklistWrapper
-> Getting [ChecklistItem] ChecklistWrapper [ChecklistItem]
-> [ChecklistItem]
forall s a. s -> Getting a s a -> a
^. Getting [ChecklistItem] ChecklistWrapper [ChecklistItem]
Iso' ChecklistWrapper [ChecklistItem]
checkItems) (ChecklistWrapper -> [ChecklistItem])
-> Either String ChecklistWrapper -> Either String [ChecklistItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ChecklistWrapper
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
body of
                    Right [ChecklistItem]
ls -> [ChecklistItem] -> Either Text [ChecklistItem]
forall a b. b -> Either a b
Right [ChecklistItem]
ls
                    Left String
err -> Text -> Either Text [ChecklistItem]
forall a b. a -> Either a b
Left (Text -> Either Text [ChecklistItem])
-> Text -> Either Text [ChecklistItem]
forall a b. (a -> b) -> a -> b
$ String -> Text
parseError String
err
            Int
429 -> Text -> Either Text [ChecklistItem]
forall a b. a -> Either a b
Left Text
"Too many checklists"
            Int
_ -> Text -> Either Text [ChecklistItem]
forall a b. a -> Either a b
Left (Text -> Either Text [ChecklistItem])
-> Text -> Either Text [ChecklistItem]
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
status Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" error while fetching checklist " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
checklist

updateCard :: Card -> ReaderTrelloToken (Either Text Card)
updateCard :: Card -> ReaderTrelloToken (Either Text Card)
updateCard Card
card = (Card -> [ChecklistItem] -> Card
setChecklists Card
card ([ChecklistItem] -> Card)
-> ([[ChecklistItem]] -> [ChecklistItem])
-> [[ChecklistItem]]
-> Card
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[ChecklistItem]] -> [ChecklistItem]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat ([[ChecklistItem]] -> Card)
-> Either Text [[ChecklistItem]] -> Either Text Card
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either Text [[ChecklistItem]] -> Either Text Card)
-> ([Either Text [ChecklistItem]] -> Either Text [[ChecklistItem]])
-> [Either Text [ChecklistItem]]
-> Either Text Card
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Either Text [ChecklistItem]] -> Either Text [[ChecklistItem]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Text [ChecklistItem]] -> Either Text Card)
-> ReaderT Text IO [Either Text [ChecklistItem]]
-> ReaderTrelloToken (Either Text Card)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Text IO [Either Text [ChecklistItem]]
checklists
  where
    checklists :: ReaderT Text IO [Either Text [ChecklistItem]]
checklists = (Text -> ReaderTrelloToken (Either Text [ChecklistItem]))
-> [Text] -> ReaderT Text IO [Either Text [ChecklistItem]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> ReaderTrelloToken (Either Text [ChecklistItem])
getChecklist (Card
card Card -> Getting [Text] Card [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. Getting [Text] Card [Text]
Lens' Card [Text]
idChecklists)

updateList :: List -> ReaderTrelloToken (Either Text List)
updateList :: List -> ReaderTrelloToken (Either Text List)
updateList List
l = (List -> [Card] -> List
setCards List
l ([Card] -> List) -> Either Text [Card] -> Either Text List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either Text [Card] -> Either Text List)
-> ([Either Text Card] -> Either Text [Card])
-> [Either Text Card]
-> Either Text List
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Either Text Card] -> Either Text [Card]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Text Card] -> Either Text List)
-> ReaderT Text IO [Either Text Card]
-> ReaderTrelloToken (Either Text List)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Card -> ReaderTrelloToken (Either Text Card))
-> [Card] -> ReaderT Text IO [Either Text Card]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Card -> ReaderTrelloToken (Either Text Card)
updateCard (List
l List -> Getting [Card] List [Card] -> [Card]
forall s a. s -> Getting a s a -> a
^. Getting [Card] List [Card]
Lens' List [Card]
cards)

getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])
getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])
getChecklists [List]
ls = [Either Text List] -> Either Text [List]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Text List] -> Either Text [List])
-> ReaderT Text IO [Either Text List]
-> ReaderTrelloToken (Either Text [List])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (List -> ReaderTrelloToken (Either Text List))
-> [List] -> ReaderT Text IO [Either Text List]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse List -> ReaderTrelloToken (Either Text List)
updateList [List]
ls

getLists :: TrelloBoardID -> ReaderTrelloToken (Either Text Lists)
getLists :: Text -> ReaderTrelloToken (Either Text Lists)
getLists Text
board = do
    Text -> ReaderT Text IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"Fetching from Trello..."
    String
url <- Text -> ReaderTrelloToken String
boardURL Text
board
    (Int
status, ByteString
body) <- IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString))
-> IO (Int, ByteString) -> ReaderT Text IO (Int, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO (Int, ByteString)
fetch String
url
    case Int
status of
        Int
200 ->
            case ByteString -> Either String [List]
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
body of
                Right [List]
raw -> ([List] -> Lists) -> Either Text [List] -> Either Text Lists
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [List] -> Lists
trelloListsToLists (Either Text [List] -> Either Text Lists)
-> ReaderTrelloToken (Either Text [List])
-> ReaderTrelloToken (Either Text Lists)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [List] -> ReaderTrelloToken (Either Text [List])
getChecklists [List]
raw
                Left String
err  -> Either Text Lists -> ReaderTrelloToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderTrelloToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderTrelloToken (Either Text Lists)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text Lists
forall a b. a -> Either a b
Left (Text -> ReaderTrelloToken (Either Text Lists))
-> Text -> ReaderTrelloToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ String -> Text
parseError String
err
        Int
404 ->
            Either Text Lists -> ReaderTrelloToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderTrelloToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderTrelloToken (Either Text Lists)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text Lists
forall a b. a -> Either a b
Left (Text -> ReaderTrelloToken (Either Text Lists))
-> Text -> ReaderTrelloToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text
"Could not find Trello board " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
board Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Make sure the ID is correct"
        Int
401 -> Either Text Lists -> ReaderTrelloToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderTrelloToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderTrelloToken (Either Text Lists)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text Lists
forall a b. a -> Either a b
Left (Text -> ReaderTrelloToken (Either Text Lists))
-> Text -> ReaderTrelloToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text
"You do not have permission to view Trello board " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
board
        Int
_ -> Either Text Lists -> ReaderTrelloToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderTrelloToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderTrelloToken (Either Text Lists)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either Text Lists
forall a b. a -> Either a b
Left (Text -> ReaderTrelloToken (Either Text Lists))
-> Text -> ReaderTrelloToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
status Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" error. Cannot fetch from Trello."