{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Krank.Checkers.IssueTracker
  ( GitIssueRef (..),
    GitServer (..),
    Localized (..),
    checkText,
    extractIssues,
    gitRepoRe,
    serverDomain,
    extractIssuesOnALine,
  )
where

import Control.Exception.Safe (catch)
import Data.Aeson (Value, (.:))
import qualified Data.Aeson.Types as AesonT
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.Map as Map
import Data.Text (Text, pack)
import qualified Data.Text.Encoding as Text.Encoding
import Krank.Types
import qualified Network.HTTP.Req as Req
import PyF (fmt)
import qualified Text.Regex.PCRE.Heavy as RE
import Utils.Github (showGithubException)
import Utils.Gitlab (showGitlabException)

data GitServer = Github | Gitlab GitlabHost
  deriving (GitServer -> GitServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitServer -> GitServer -> Bool
$c/= :: GitServer -> GitServer -> Bool
== :: GitServer -> GitServer -> Bool
$c== :: GitServer -> GitServer -> Bool
Eq, Int -> GitServer -> ShowS
[GitServer] -> ShowS
GitServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitServer] -> ShowS
$cshowList :: [GitServer] -> ShowS
show :: GitServer -> String
$cshow :: GitServer -> String
showsPrec :: Int -> GitServer -> ShowS
$cshowsPrec :: Int -> GitServer -> ShowS
Show)

data IssueStatus = Open | Closed deriving (IssueStatus -> IssueStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueStatus -> IssueStatus -> Bool
$c/= :: IssueStatus -> IssueStatus -> Bool
== :: IssueStatus -> IssueStatus -> Bool
$c== :: IssueStatus -> IssueStatus -> Bool
Eq, Int -> IssueStatus -> ShowS
[IssueStatus] -> ShowS
IssueStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueStatus] -> ShowS
$cshowList :: [IssueStatus] -> ShowS
show :: IssueStatus -> String
$cshow :: IssueStatus -> String
showsPrec :: Int -> IssueStatus -> ShowS
$cshowsPrec :: Int -> IssueStatus -> ShowS
Show)

data GitIssueRef = GitIssueRef
  { GitIssueRef -> GitServer
server :: GitServer,
    GitIssueRef -> Text
owner :: Text,
    GitIssueRef -> Text
repo :: Text,
    GitIssueRef -> Int
issueNum :: Int
  }
  deriving (GitIssueRef -> GitIssueRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitIssueRef -> GitIssueRef -> Bool
$c/= :: GitIssueRef -> GitIssueRef -> Bool
== :: GitIssueRef -> GitIssueRef -> Bool
$c== :: GitIssueRef -> GitIssueRef -> Bool
Eq, Int -> GitIssueRef -> ShowS
[GitIssueRef] -> ShowS
GitIssueRef -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitIssueRef] -> ShowS
$cshowList :: [GitIssueRef] -> ShowS
show :: GitIssueRef -> String
$cshow :: GitIssueRef -> String
showsPrec :: Int -> GitIssueRef -> ShowS
$cshowsPrec :: Int -> GitIssueRef -> ShowS
Show)

data GitIssueData = GitIssueData
  { GitIssueData -> Localized GitIssueRef
gitIssue :: Localized GitIssueRef,
    GitIssueData -> IssueStatus
issueStatus :: IssueStatus,
    GitIssueData -> Text
issueTitle :: Text
  }
  deriving (GitIssueData -> GitIssueData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitIssueData -> GitIssueData -> Bool
$c/= :: GitIssueData -> GitIssueData -> Bool
== :: GitIssueData -> GitIssueData -> Bool
$c== :: GitIssueData -> GitIssueData -> Bool
Eq, Int -> GitIssueData -> ShowS
[GitIssueData] -> ShowS
GitIssueData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitIssueData] -> ShowS
$cshowList :: [GitIssueData] -> ShowS
show :: GitIssueData -> String
$cshow :: GitIssueData -> String
showsPrec :: Int -> GitIssueData -> ShowS
$cshowsPrec :: Int -> GitIssueData -> ShowS
Show)

serverDomain ::
  GitServer ->
  Text
serverDomain :: GitServer -> Text
serverDomain GitServer
Github = Text
"github.com"
serverDomain (Gitlab (GitlabHost Text
h)) = Text
h

-- | This regex represents a github/gitlab issue URL
gitRepoRe :: RE.Regex
-- NOTE: \b at the beginning is really import for performances
-- because it dramatically reduces the number of backtracks
gitRepoRe :: Regex
gitRepoRe = [RE.re|\b(?>https?://)?(?>www\.)?([^/ ]+)/([^ ]+)/([^- ][^/ ]*)(?>/-)?/issues/([0-9]+)|]

-- | Extract all issues on one line and returns a list of the raw text associated with an issue
extractIssuesOnALine :: ByteString -> [(Int, GitIssueRef)]
extractIssuesOnALine :: ByteString -> [(Int, GitIssueRef)]
extractIssuesOnALine ByteString
lineContent = forall a b. (a -> b) -> [a] -> [b]
map (ByteString, [ByteString]) -> (Int, GitIssueRef)
f (forall a.
(ConvertibleStrings ByteString a,
 ConvertibleStrings a ByteString) =>
Regex -> a -> [(a, [a])]
RE.scan Regex
gitRepoRe ByteString
lineContent)
  where
    f :: (ByteString, [ByteString]) -> (Int, GitIssueRef)
f (ByteString
match, [ByteString
domain, ByteString
owner, ByteString
repo, ByteString -> Maybe (Int, ByteString)
ByteString.readInt -> Just (Int
issueNo, ByteString
_)]) = (Int
colNo, GitServer -> Text -> Text -> Int -> GitIssueRef
GitIssueRef GitServer
provider (ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
owner) (ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
repo) Int
issueNo)
      where
        colNo :: Int
colNo = Int
1 forall a. Num a => a -> a -> a
+ ByteString -> Int
ByteString.length (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
ByteString.breakSubstring ByteString
match ByteString
lineContent)
        provider :: GitServer
provider
          | ByteString
domain forall a. Eq a => a -> a -> Bool
== ByteString
"github.com" = GitServer
Github
          -- TODO: We suppose that all other cases are gitlab
          -- The only thing we risk here is a query with the wrong
          -- API to an irrelevant host.
          | Bool
otherwise = GitlabHost -> GitServer
Gitlab (Text -> GitlabHost
GitlabHost forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.Encoding.decodeUtf8 ByteString
domain)
    -- This case seems impossible, the reasons for pattern match issues are:
    --  A number of items different than 4 in the list: there is only 4 matching groups in the regex
    --  An invalid `decimal` conversion. That's impossible either
    --  because the pattern for the issue number is `[0-9]+`
    f (ByteString, [ByteString])
res = forall a. HasCallStack => String -> a
error (String
"Error: impossible match" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ByteString, [ByteString])
res)

-- | Extract all issues correctly localized
-- Note: we use 'ByteString' internally. This way we do not have to
-- care about the possible encoding of the input files.
-- In programming world, we mostly use ascii variants. This gives a
-- few performance improvement compared to initially converting
-- everything to 'Text' and search on it.
extractIssues ::
  -- | Path of the file
  FilePath ->
  -- | Content of the file
  ByteString ->
  [Localized GitIssueRef]
extractIssues :: String -> ByteString -> [Localized GitIssueRef]
extractIssues String
filePath ByteString
toCheck = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ByteString -> [Localized GitIssueRef]
extract [Int
1 ..] (ByteString -> [ByteString]
ByteString.lines ByteString
toCheck))
  where
    extract :: Int -> ByteString -> [Localized GitIssueRef]
extract Int
lineNo ByteString
lineContent = forall a b. (a -> b) -> [a] -> [b]
map forall {t}. (Int, t) -> Localized t
f (ByteString -> [(Int, GitIssueRef)]
extractIssuesOnALine ByteString
lineContent)
      where
        f :: (Int, t) -> Localized t
f (Int
colNo, t
gitIssue) = forall t. SourcePos -> t -> Localized t
Localized (String -> Int -> Int -> SourcePos
SourcePos String
filePath Int
lineNo Int
colNo) t
gitIssue

-- Supports only github for the moment
issueUrl ::
  GitIssueRef ->
  Req.Url 'Req.Https
issueUrl :: GitIssueRef -> Url 'Https
issueUrl GitIssueRef
issue = case GitIssueRef -> GitServer
server GitIssueRef
issue of
  GitServer
Github -> Text -> Url 'Https
Req.https Text
"api.github.com" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"repos" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: GitIssueRef -> Text
owner GitIssueRef
issue forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: GitIssueRef -> Text
repo GitIssueRef
issue forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"issues" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
Req./~ GitIssueRef -> Int
issueNum GitIssueRef
issue
  Gitlab (GitlabHost Text
host) -> Text -> Url 'Https
Req.https Text
host forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"api" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"v4" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"projects" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: [fmt|{owner issue}/{repo issue}|] forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
Req./: Text
"issues" forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
Req./~ GitIssueRef -> Int
issueNum GitIssueRef
issue

-- try Issue can fail, on non-2xx HTTP response
tryRestIssue ::
  MonadKrank m =>
  Localized GitIssueRef ->
  m Value
tryRestIssue :: forall (m :: * -> *).
MonadKrank m =>
Localized GitIssueRef -> m Value
tryRestIssue Localized GitIssueRef
locIssue = do
  let issue :: GitIssueRef
issue = forall t. Localized t -> t
unLocalized Localized GitIssueRef
locIssue
  let url :: Url 'Https
url = GitIssueRef -> Url 'Https
issueUrl GitIssueRef
issue
  Option 'Https
headers <- forall (m :: * -> *).
MonadKrank m =>
GitIssueRef -> m (Option 'Https)
headersFor GitIssueRef
issue
  forall (m :: * -> *) t.
(MonadKrank m, FromJSON t) =>
Url 'Https -> Option 'Https -> m t
krankRunRESTRequest Url 'Https
url Option 'Https
headers

headersFor ::
  MonadKrank m =>
  GitIssueRef ->
  m (Req.Option 'Req.Https)
headersFor :: forall (m :: * -> *).
MonadKrank m =>
GitIssueRef -> m (Option 'Https)
headersFor GitIssueRef
issue = do
  Maybe GithubKey
mGithubKey <- forall (m :: * -> *) b. MonadKrank m => (KrankConfig -> b) -> m b
krankAsks KrankConfig -> Maybe GithubKey
githubKey
  Map GitlabHost GitlabKey
mGitlabKeys <- forall (m :: * -> *) b. MonadKrank m => (KrankConfig -> b) -> m b
krankAsks KrankConfig -> Map GitlabHost GitlabKey
gitlabKeys
  case GitIssueRef -> GitServer
server GitIssueRef
issue of
    GitServer
Github -> case Maybe GithubKey
mGithubKey of
      Just (GithubKey Text
token) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Option 'Https
Req.oAuth2Token (Text -> ByteString
Text.Encoding.encodeUtf8 Text
token)
      Maybe GithubKey
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    Gitlab GitlabHost
host -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GitlabHost
host Map GitlabHost GitlabKey
mGitlabKeys of
      Just (GitlabKey Text
token) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
Req.header ByteString
"PRIVATE-TOKEN" (Text -> ByteString
Text.Encoding.encodeUtf8 Text
token)
      Maybe GitlabKey
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

httpExcHandler ::
  MonadKrank m =>
  GitServer ->
  Req.HttpException ->
  m Value
httpExcHandler :: forall (m :: * -> *).
MonadKrank m =>
GitServer -> HttpException -> m Value
httpExcHandler GitServer
gitServer HttpException
exc =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
AesonT.object forall a b. (a -> b) -> a -> b
$ [(Key
"error", Text -> Value
AesonT.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall a b. (a -> b) -> a -> b
$ [fmt|{(showGitServerException gitServer exc)}|])]

showGitServerException ::
  GitServer ->
  Req.HttpException ->
  Text
showGitServerException :: GitServer -> HttpException -> Text
showGitServerException GitServer
Github HttpException
exc = HttpException -> Text
showGithubException HttpException
exc
showGitServerException (Gitlab GitlabHost
_) HttpException
exc = HttpException -> Text
showGitlabException HttpException
exc

restIssue ::
  MonadKrank m =>
  Localized GitIssueRef ->
  m Value
restIssue :: forall (m :: * -> *).
MonadKrank m =>
Localized GitIssueRef -> m Value
restIssue Localized GitIssueRef
issue = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *).
MonadKrank m =>
Localized GitIssueRef -> m Value
tryRestIssue Localized GitIssueRef
issue) (forall (m :: * -> *).
MonadKrank m =>
GitServer -> HttpException -> m Value
httpExcHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitIssueRef -> GitServer
server forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Localized t -> t
unLocalized forall a b. (a -> b) -> a -> b
$ Localized GitIssueRef
issue)

statusParser ::
  Value ->
  Either Text IssueStatus
statusParser :: Value -> Either Text IssueStatus
statusParser (AesonT.Object Object
o) = do
  let Result String
state :: AesonT.Result String = forall a b. (a -> Parser b) -> a -> Result b
AesonT.parse (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state") Object
o
  forall {i}.
(Eq i, IsString i, FormatAny2 (PyFClassify i) i 'AlignAll) =>
Result i -> Either Text IssueStatus
readState Result String
state
  where
    readState :: Result i -> Either Text IssueStatus
readState (AesonT.Success i
status) = case i
status of
      i
"closed" -> forall a b. b -> Either a b
Right IssueStatus
Closed -- Both Gitlab and Github use the same keyword for closed
      i
"open" -> forall a b. b -> Either a b
Right IssueStatus
Open -- Github uses the 'open' status
      i
"opened" -> forall a b. b -> Either a b
Right IssueStatus
Open -- Gitlab uses the 'opened' status
      i
_ -> forall a b. a -> Either a b
Left [fmt|Could not parse status '{status}'|]
    readState (AesonT.Error String
_) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Object -> Text
errorParser Object
o
statusParser Value
_ = forall a b. a -> Either a b
Left Text
"invalid JSON"

titleParser ::
  Value ->
  Either Text Text
titleParser :: Value -> Either Text Text
titleParser (AesonT.Object Object
o) = do
  let Result String
title :: AesonT.Result String = forall a b. (a -> Parser b) -> a -> Result b
AesonT.parse (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title") Object
o
  forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Result String -> Text
readTitle Result String
title
  where
    readTitle :: Result String -> Text
readTitle (AesonT.Success String
title) = String -> Text
pack String
title
    readTitle (AesonT.Error String
_) = Text
"invalid JSON"
titleParser Value
_ = forall a b. a -> Either a b
Left Text
"invalid JSON"

errorParser ::
  AesonT.Object ->
  Text
errorParser :: Object -> Text
errorParser Object
o = do
  let err :: Result String
err = forall a b. (a -> Parser b) -> a -> Result b
AesonT.parse (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error") Object
o
  Result String -> Text
readErr Result String
err
  where
    readErr :: Result String -> Text
readErr (AesonT.Success String
errText) = String -> Text
pack String
errText
    readErr (AesonT.Error String
_) = Text
"invalid JSON"

gitIssuesWithStatus ::
  MonadKrank m =>
  [Localized GitIssueRef] ->
  m [Either (Text, Localized GitIssueRef) GitIssueData]
gitIssuesWithStatus :: forall (m :: * -> *).
MonadKrank m =>
[Localized GitIssueRef]
-> m [Either (Text, Localized GitIssueRef) GitIssueData]
gitIssuesWithStatus [Localized GitIssueRef]
issues = do
  [Value]
jsonData <- forall (m :: * -> *) a b.
MonadKrank m =>
(a -> m b) -> [a] -> m [b]
krankMapConcurrently forall (m :: * -> *).
MonadKrank m =>
Localized GitIssueRef -> m Value
restIssue [Localized GitIssueRef]
issues
  let statuses :: [Either Text IssueStatus]
statuses = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Either Text IssueStatus
statusParser [Value]
jsonData
  let titles :: [Either Text Text]
titles = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Either Text Text
titleParser [Value]
jsonData
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 forall {a}.
Localized GitIssueRef
-> Either a IssueStatus
-> Either a Text
-> Either (a, Localized GitIssueRef) GitIssueData
f [Localized GitIssueRef]
issues [Either Text IssueStatus]
statuses [Either Text Text]
titles
  where
    f :: Localized GitIssueRef
-> Either a IssueStatus
-> Either a Text
-> Either (a, Localized GitIssueRef) GitIssueData
f Localized GitIssueRef
issue (Left a
err) Either a Text
_ = forall a b. a -> Either a b
Left (a
err, Localized GitIssueRef
issue)
    f Localized GitIssueRef
issue Either a IssueStatus
_ (Left a
err) = forall a b. a -> Either a b
Left (a
err, Localized GitIssueRef
issue)
    f Localized GitIssueRef
issue (Right IssueStatus
status) (Right Text
title) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Localized GitIssueRef -> IssueStatus -> Text -> GitIssueData
GitIssueData Localized GitIssueRef
issue IssueStatus
status Text
title

issueToLevel ::
  GitIssueData ->
  ViolationLevel
issueToLevel :: GitIssueData -> ViolationLevel
issueToLevel GitIssueData
i = case GitIssueData -> IssueStatus
issueStatus GitIssueData
i of
  IssueStatus
Open -> ViolationLevel
Info
  IssueStatus
Closed -> ViolationLevel
Error

issueToMessage ::
  GitIssueData ->
  Text
issueToMessage :: GitIssueData -> Text
issueToMessage GitIssueData
i =
  case GitIssueData -> IssueStatus
issueStatus GitIssueData
i of
    IssueStatus
Open -> [fmt|the issue is still Open\ntitle: {title}|]
    IssueStatus
Closed -> [fmt|the issue is now Closed - You can remove the workaround you used there\ntitle: {title}|]
  where
    title :: Text
title = GitIssueData -> Text
issueTitle GitIssueData
i

issuePrintUrl :: GitIssueRef -> Text
issuePrintUrl :: GitIssueRef -> Text
issuePrintUrl GitIssueRef {Text
owner :: Text
$sel:owner:GitIssueRef :: GitIssueRef -> Text
owner, Text
repo :: Text
$sel:repo:GitIssueRef :: GitIssueRef -> Text
repo, GitServer
server :: GitServer
$sel:server:GitIssueRef :: GitIssueRef -> GitServer
server, Int
issueNum :: Int
$sel:issueNum:GitIssueRef :: GitIssueRef -> Int
issueNum} = [fmt|IssueTracker check for https://{serverDomain server}/{owner}/{repo}/issues/{issueNum}|]

checkText ::
  MonadKrank m =>
  FilePath ->
  ByteString ->
  m [Violation]
checkText :: forall (m :: * -> *).
MonadKrank m =>
String -> ByteString -> m [Violation]
checkText String
path ByteString
t = do
  let issues :: [Localized GitIssueRef]
issues = String -> ByteString -> [Localized GitIssueRef]
extractIssues String
path ByteString
t
  Bool
isDryRun <- forall (m :: * -> *) b. MonadKrank m => (KrankConfig -> b) -> m b
krankAsks KrankConfig -> Bool
dryRun
  if Bool
isDryRun
    then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \Localized GitIssueRef
issue ->
              Violation
                { checker :: Text
checker = GitIssueRef -> Text
issuePrintUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Localized t -> t
unLocalized forall a b. (a -> b) -> a -> b
$ Localized GitIssueRef
issue,
                  level :: ViolationLevel
level = ViolationLevel
Info,
                  message :: Text
message = Text
"Dry run",
                  location :: SourcePos
location = forall t. Localized t -> SourcePos
getLocation (Localized GitIssueRef
issue :: Localized GitIssueRef)
                }
          )
          [Localized GitIssueRef]
issues
    else do
      [Either (Text, Localized GitIssueRef) GitIssueData]
issuesWithStatus <- forall (m :: * -> *).
MonadKrank m =>
[Localized GitIssueRef]
-> m [Either (Text, Localized GitIssueRef) GitIssueData]
gitIssuesWithStatus [Localized GitIssueRef]
issues
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (Text, Localized GitIssueRef) GitIssueData -> Violation
f [Either (Text, Localized GitIssueRef) GitIssueData]
issuesWithStatus
  where
    f :: Either (Text, Localized GitIssueRef) GitIssueData -> Violation
f (Left (Text
err, Localized GitIssueRef
issue)) =
      Violation
        { checker :: Text
checker = GitIssueRef -> Text
issuePrintUrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Localized t -> t
unLocalized forall a b. (a -> b) -> a -> b
$ Localized GitIssueRef
issue,
          level :: ViolationLevel
level = ViolationLevel
Warning,
          message :: Text
message = Text
"Error when calling the API:\n" forall a. Semigroup a => a -> a -> a
<> Text
err,
          location :: SourcePos
location = forall t. Localized t -> SourcePos
getLocation (Localized GitIssueRef
issue :: Localized GitIssueRef)
        }
    f (Right GitIssueData
issue) =
      Violation
        { checker :: Text
checker = GitIssueRef -> Text
issuePrintUrl (forall t. Localized t -> t
unLocalized forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitIssueData -> Localized GitIssueRef
gitIssue forall a b. (a -> b) -> a -> b
$ GitIssueData
issue),
          level :: ViolationLevel
level = GitIssueData -> ViolationLevel
issueToLevel GitIssueData
issue,
          message :: Text
message = GitIssueData -> Text
issueToMessage GitIssueData
issue,
          location :: SourcePos
location = forall t. Localized t -> SourcePos
getLocation (GitIssueData -> Localized GitIssueRef
gitIssue GitIssueData
issue :: Localized GitIssueRef)
        }