module Taskell.IO.HTTP.GitHub
    ( GitHubToken
    , GitHubIdentifier
    , getNextLink
    , getLists
    ) where

import ClassyPrelude

import Control.Lens  ((^.))
import Data.Sequence (mapWithIndex, (!?))
import Data.Text     (splitOn, strip)

import Data.Aeson
import Taskell.UI.CLI (prompt)

import Network.HTTP.Client       (requestHeaders)
import Network.HTTP.Simple       (Response, getResponseBody, getResponseHeader,
                                  getResponseStatusCode, httpBS, parseRequest)
import Network.HTTP.Types.Header (HeaderName)

import Taskell.IO.HTTP.Aeson                (parseError)
import Taskell.IO.HTTP.GitHub.AutomatedCard (automatedCardToTask)
import Taskell.IO.HTTP.GitHub.Card          (MaybeCard, content_url, maybeCardToTask)
import Taskell.IO.HTTP.GitHub.Column        (Column, cardsURL, columnToList)
import Taskell.IO.HTTP.GitHub.Project       (Project, columnsURL, name)

import Taskell.Data.List  (List)
import Taskell.Data.Lists (Lists)
import Taskell.Data.Task  (Task)

type GitHubToken = Text

type GitHubIdentifier = Text

type ReaderGitHubToken a = ReaderT GitHubToken IO a

concatEithers :: [Either String [a]] -> Either String [a]
concatEithers :: [Either String [a]] -> Either String [a]
concatEithers [Either String [a]]
vals = Either String [a] -> Either String [a] -> Bool -> Either String [a]
forall a. a -> a -> Bool -> a
bool (String -> Either String [a]
forall a b. a -> Either a b
Left String
errs) ([a] -> Either String [a]
forall a b. b -> Either a b
Right [a]
as) (String -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null String
errs)
  where
    (String
errs, [a]
as) = ([String] -> String)
-> ([[a]] -> [a]) -> ([String], [[a]]) -> (String, [a])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [String] -> String
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines [[a]] -> [a]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat (([String], [[a]]) -> (String, [a]))
-> ([String], [[a]]) -> (String, [a])
forall a b. (a -> b) -> a -> b
$ [Either String [a]] -> ([String], [[a]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String [a]]
vals

root :: Text
root :: Text
root = Text
"https://api.github.com/"

headers :: ReaderGitHubToken [(HeaderName, ByteString)]
headers :: ReaderGitHubToken [(HeaderName, ByteString)]
headers = do
    Text
token <- ReaderT Text IO Text
forall r (m :: * -> *). MonadReader r m => m r
ask
    [(HeaderName, ByteString)]
-> ReaderGitHubToken [(HeaderName, ByteString)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        [ (HeaderName
"User-Agent", ByteString
"smallhadroncollider/taskell")
        , (HeaderName
"Accept", ByteString
"application/vnd.github.inertia-preview+json")
        , (HeaderName
"Authorization", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 (Text
"token " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
token))
        ]

getNextLink :: [ByteString] -> Maybe Text
getNextLink :: [ByteString] -> Maybe Text
getNextLink [ByteString]
bs = do
    [Text]
lnks <- Text -> Text -> [Text]
splitOn Text
"," (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (ByteString -> [Text]) -> Maybe ByteString -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Maybe (Element [ByteString])
forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay [ByteString]
bs
    let rel :: Text
rel = Text
"rel=\"next\""
    Text
next <- (Element [Text] -> Bool) -> [Text] -> Maybe (Element [Text])
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find (Text -> Text -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
isSuffixOf Text
rel) [Text]
lnks
    Text -> Text -> Maybe Text
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripPrefix Text
"<" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Maybe seq
stripSuffix (Text
">; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rel) (Text -> Text
strip Text
next)

fetchURL :: Text -> ReaderGitHubToken (Response ByteString)
fetchURL :: Text -> ReaderGitHubToken (Response ByteString)
fetchURL Text
url = do
    Request
initialRequest <- IO Request -> ReaderT Text IO Request
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Request -> ReaderT Text IO Request)
-> IO Request -> ReaderT Text IO Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (Text -> [Element Text]
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack Text
url)
    [(HeaderName, ByteString)]
rHeaders <- ReaderGitHubToken [(HeaderName, ByteString)]
headers
    IO (Response ByteString) -> ReaderGitHubToken (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Response ByteString)
 -> ReaderGitHubToken (Response ByteString))
-> (Request -> IO (Response ByteString))
-> Request
-> ReaderGitHubToken (Response ByteString)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS (Request -> ReaderGitHubToken (Response ByteString))
-> Request -> ReaderGitHubToken (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request
initialRequest {requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
rHeaders}

fetch' :: [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])
fetch' :: [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])
fetch' [ByteString]
bs Text
url = do
    Response ByteString
response <- Text -> ReaderGitHubToken (Response ByteString)
fetchURL Text
url
    let responses :: [ByteString]
responses = [ByteString]
bs [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
response]
    case [ByteString] -> Maybe Text
getNextLink (HeaderName -> Response ByteString -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Link" Response ByteString
response) of
        Maybe Text
Nothing  -> (Int, [ByteString]) -> ReaderGitHubToken (Int, [ByteString])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
response, [ByteString]
responses)
        Just Text
lnk -> [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])
fetch' [ByteString]
responses Text
lnk

fetch :: Text -> ReaderGitHubToken (Int, [ByteString])
fetch :: Text -> ReaderGitHubToken (Int, [ByteString])
fetch = [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])
fetch' []

fetchContent :: MaybeCard -> ReaderGitHubToken (Either Text Task)
fetchContent :: MaybeCard -> ReaderGitHubToken (Either Text Task)
fetchContent MaybeCard
card =
    case MaybeCard -> Maybe Task
maybeCardToTask MaybeCard
card of
        Just Task
tsk -> Either Text Task -> ReaderGitHubToken (Either Text Task)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Task -> ReaderGitHubToken (Either Text Task))
-> Either Text Task -> ReaderGitHubToken (Either Text Task)
forall a b. (a -> b) -> a -> b
$ Task -> Either Text Task
forall a b. b -> Either a b
Right Task
tsk
        Maybe Task
Nothing ->
            case MaybeCard
card MaybeCard
-> Getting (Maybe Text) MaybeCard (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) MaybeCard (Maybe Text)
Lens' MaybeCard (Maybe Text)
content_url of
                Maybe Text
Nothing -> Either Text Task -> ReaderGitHubToken (Either Text Task)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Task -> ReaderGitHubToken (Either Text Task))
-> Either Text Task -> ReaderGitHubToken (Either Text Task)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Task
forall a b. a -> Either a b
Left Text
"Could not parse card"
                Just Text
url -> do
                    ByteString
body <- Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody (Response ByteString -> ByteString)
-> ReaderGitHubToken (Response ByteString)
-> ReaderT Text IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ReaderGitHubToken (Response ByteString)
fetchURL Text
url
                    Either Text Task -> ReaderGitHubToken (Either Text Task)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Task -> ReaderGitHubToken (Either Text Task))
-> (Either String Task -> Either Text Task)
-> Either String Task
-> ReaderGitHubToken (Either Text Task)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> Text) -> Either String Task -> Either Text Task
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
parseError (Either String Task -> ReaderGitHubToken (Either Text Task))
-> Either String Task -> ReaderGitHubToken (Either Text Task)
forall a b. (a -> b) -> a -> b
$ AutomatedCard -> Task
automatedCardToTask (AutomatedCard -> Task)
-> Either String AutomatedCard -> Either String Task
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String AutomatedCard
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
body

getCards :: Text -> ReaderGitHubToken (Either Text [Task])
getCards :: Text -> ReaderGitHubToken (Either Text [Task])
getCards Text
url = do
    (Int
status, [ByteString]
body) <- Text -> ReaderGitHubToken (Int, [ByteString])
fetch Text
url
    case Int
status of
        Int
200 ->
            case [Either String [MaybeCard]] -> Either String [MaybeCard]
forall a. [Either String [a]] -> Either String [a]
concatEithers (ByteString -> Either String [MaybeCard]
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String [MaybeCard])
-> [ByteString] -> [Either String [MaybeCard]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
body) of
                Right [MaybeCard]
cards -> do
                    [Either Text Task]
cds <- [ReaderGitHubToken (Either Text Task)]
-> ReaderT Text IO [Either Text Task]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (MaybeCard -> ReaderGitHubToken (Either Text Task)
fetchContent (MaybeCard -> ReaderGitHubToken (Either Text Task))
-> [MaybeCard] -> [ReaderGitHubToken (Either Text Task)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MaybeCard]
cards)
                    let (Text
ls, [Task]
rs) = ([Text] -> Text) -> ([Text], [Task]) -> (Text, [Task])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Text] -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines (([Text], [Task]) -> (Text, [Task]))
-> ([Text], [Task]) -> (Text, [Task])
forall a b. (a -> b) -> a -> b
$ [Either Text Task] -> ([Text], [Task])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either Text Task]
cds
                    Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [Task] -> ReaderGitHubToken (Either Text [Task]))
-> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall a b. (a -> b) -> a -> b
$ Either Text [Task]
-> Either Text [Task] -> Bool -> Either Text [Task]
forall a. a -> a -> Bool -> a
bool (Text -> Either Text [Task]
forall a b. a -> Either a b
Left Text
ls) ([Task] -> Either Text [Task]
forall a b. b -> Either a b
Right [Task]
rs) (Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null Text
ls)
                Left String
err -> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [Task] -> ReaderGitHubToken (Either Text [Task]))
-> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Task]
forall a b. a -> Either a b
Left (String -> Text
parseError String
err)
        Int
429 -> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [Task] -> ReaderGitHubToken (Either Text [Task]))
-> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Task]
forall a b. a -> Either a b
Left Text
"Too many cards"
        Int
_ -> Either Text [Task] -> ReaderGitHubToken (Either Text [Task])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [Task] -> ReaderGitHubToken (Either Text [Task]))
-> (Text -> Either Text [Task])
-> Text
-> ReaderGitHubToken (Either Text [Task])
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 [Task]
forall a b. a -> Either a b
Left (Text -> ReaderGitHubToken (Either Text [Task]))
-> Text -> ReaderGitHubToken (Either Text [Task])
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url

addCard :: Column -> ReaderGitHubToken (Either Text List)
addCard :: Column -> ReaderGitHubToken (Either Text List)
addCard Column
column = do
    Either Text [Task]
cards <- Text -> ReaderGitHubToken (Either Text [Task])
getCards (Text -> ReaderGitHubToken (Either Text [Task]))
-> Text -> ReaderGitHubToken (Either Text [Task])
forall a b. (a -> b) -> a -> b
$ Column
column Column -> Getting Text Column Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Column Text
Lens' Column Text
cardsURL
    Either Text List -> ReaderGitHubToken (Either Text List)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text List -> ReaderGitHubToken (Either Text List))
-> Either Text List -> ReaderGitHubToken (Either Text List)
forall a b. (a -> b) -> a -> b
$ Column -> [Task] -> List
columnToList Column
column ([Task] -> List) -> Either Text [Task] -> Either Text List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text [Task]
cards

addCards :: [Column] -> ReaderGitHubToken (Either Text Lists)
addCards :: [Column] -> ReaderGitHubToken (Either Text Lists)
addCards [Column]
columns = ([List] -> Lists
forall seq. IsSequence seq => [Element seq] -> seq
fromList ([List] -> Lists) -> Either Text [List] -> Either Text Lists
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either Text [List] -> Either Text Lists)
-> ([Either Text List] -> Either Text [List])
-> [Either Text List]
-> 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
. [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 Lists)
-> ReaderT Text IO [Either Text List]
-> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Column -> ReaderGitHubToken (Either Text List))
-> [Column] -> ReaderT Text IO [Either Text List]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Column -> ReaderGitHubToken (Either Text List)
addCard [Column]
columns

getColumns :: Text -> ReaderGitHubToken (Either Text Lists)
getColumns :: Text -> ReaderGitHubToken (Either Text Lists)
getColumns Text
url = do
    Text -> ReaderT Text IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"Fetching project from GitHub..."
    (Int
status, [ByteString]
body) <- Text -> ReaderGitHubToken (Int, [ByteString])
fetch Text
url
    case Int
status of
        Int
200 ->
            case [Either String [Column]] -> Either String [Column]
forall a. [Either String [a]] -> Either String [a]
concatEithers (ByteString -> Either String [Column]
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String [Column])
-> [ByteString] -> [Either String [Column]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
body) of
                Right [Column]
columns -> [Column] -> ReaderGitHubToken (Either Text Lists)
addCards [Column]
columns
                Left String
err      -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Lists
forall a b. a -> Either a b
Left (String -> Text
parseError String
err)
        Int
404 -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text
"Could not find GitHub project ."
        Int
401 -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text
"You do not have permission to view GitHub project " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
        Int
_ -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (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 columns from GitHub."

printProjects :: Seq Project -> Text
printProjects :: Seq Project -> Text
printProjects Seq Project
projects = [Text] -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Seq Text -> [Element (Seq Text)]
forall mono. MonoFoldable mono => mono -> [Element mono]
toList Seq Text
display
  where
    names :: Seq Text
names = (Project -> Getting Text Project Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Project Text
Lens' Project Text
name) (Project -> Text) -> Seq Project -> Seq Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Project
projects
    line :: a -> Text -> Element [Text]
line a
i Text
nm = [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
"[", a -> Text
forall a. Show a => a -> Text
tshow (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1), Text
"] ", Text
nm]
    display :: Seq Text
display = Int -> Text -> Text
forall a. (Show a, Num a) => a -> Text -> Text
line (Int -> Text -> Text) -> Seq Text -> Seq Text
forall a b. (Int -> a -> b) -> Seq a -> Seq b
`mapWithIndex` Seq Text
names

chooseProject :: [Project] -> ReaderGitHubToken (Either Text Lists)
chooseProject :: [Project] -> ReaderGitHubToken (Either Text Lists)
chooseProject [Project]
projects = do
    let projects' :: Seq Project
projects' = [Element (Seq Project)] -> Seq Project
forall seq. IsSequence seq => [Element seq] -> seq
fromList [Element (Seq Project)]
[Project]
projects
    Text -> ReaderT Text IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> ReaderT Text IO ()) -> Text -> ReaderT Text IO ()
forall a b. (a -> b) -> a -> b
$ Seq Project -> Text
printProjects Seq Project
projects'
    Text
chosen <- IO Text -> ReaderT Text IO Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> ReaderT Text IO Text)
-> IO Text -> ReaderT Text IO Text
forall a b. (a -> b) -> a -> b
$ Text -> IO Text
prompt Text
"Import project"
    let project :: Maybe Project
project = (Seq Project
projects' Seq Project -> Int -> Maybe Project
forall a. Seq a -> Int -> Maybe a
!?) (Int -> Maybe Project) -> Maybe Int -> Maybe Project
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (-) Int
1 (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int
forall c a.
(Element c ~ Char, MonoFoldable c, Read a) =>
c -> Maybe a
readMay Text
chosen
    case Maybe Project
project of
        Maybe Project
Nothing   -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Lists
forall a b. a -> Either a b
Left Text
"Invalid project selected"
        Just Project
proj -> Text -> ReaderGitHubToken (Either Text Lists)
getColumns (Project
proj Project -> Getting Text Project Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Project Text
Lens' Project Text
columnsURL)

getLists :: GitHubIdentifier -> ReaderGitHubToken (Either Text Lists)
getLists :: Text -> ReaderGitHubToken (Either Text Lists)
getLists Text
identifier = do
    Text -> ReaderT Text IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"Fetching project list from GitHub...\n"
    let url :: Element [Text]
url = [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
root, Text
identifier, Text
"/projects"]
    (Int
status, [ByteString]
body) <- Text -> ReaderGitHubToken (Int, [ByteString])
fetch Text
url
    case Int
status of
        Int
200 ->
            case [Either String [Project]] -> Either String [Project]
forall a. [Either String [a]] -> Either String [a]
concatEithers (ByteString -> Either String [Project]
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (ByteString -> Either String [Project])
-> [ByteString] -> [Either String [Project]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
body) of
                Right [Project]
projects ->
                    if [Project] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null [Project]
projects
                        then Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ [Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat [Text
"\nNo projects found for ", Text
identifier, Text
"\n"]
                        else [Project] -> ReaderGitHubToken (Either Text Lists)
chooseProject [Project]
projects
                Left String
err -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Lists
forall a b. a -> Either a b
Left (String -> Text
parseError String
err)
        Int
404 ->
            Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$
            Text
"Could not find GitHub org/repo. For organisation make sure you use 'orgs/<org-name>' and for repos use 'repos/<username>/<repo-name>'"
        Int
401 ->
            Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (Either Text Lists)
forall a b. (a -> b) -> a -> b
$
            Text
"You do not have permission to view the GitHub projects for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
identifier
        Int
_ -> Either Text Lists -> ReaderGitHubToken (Either Text Lists)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Lists -> ReaderGitHubToken (Either Text Lists))
-> (Text -> Either Text Lists)
-> Text
-> ReaderGitHubToken (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 -> ReaderGitHubToken (Either Text Lists))
-> Text -> ReaderGitHubToken (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 projects from GitHub."