{-# OPTIONS_GHC -fno-warn-orphans #-}
module Restyler.PullRequest
( PullRequest
, pullRequestHtmlUrl
, pullRequestNumber
, pullRequestTitle
, pullRequestState
, HasPullRequest(..)
, pullRequestOwnerName
, pullRequestRepoName
, pullRequestUserLogin
, pullRequestCloneUrl
, pullRequestCloneUrlToken
, pullRequestIssueId
, pullRequestIsClosed
, pullRequestIsFork
, pullRequestIsNonDefaultBranch
, pullRequestBaseRef
, pullRequestHeadRef
, pullRequestHeadSha
, pullRequestRemoteHeadRef
, pullRequestLocalHeadRef
, pullRequestRestyledHeadRef
)
where
import Restyler.Prelude
import GitHub.Data
import Restyler.PullRequestSpec
instance Display PullRequest where
textDisplay :: PullRequest -> Text
textDisplay pullRequest :: PullRequest
pullRequest = PullRequestSpec -> Text
forall a. Display a => a -> Text
textDisplay PullRequestSpec :: Name Owner -> Name Repo -> IssueNumber -> PullRequestSpec
PullRequestSpec
{ prsOwner :: Name Owner
prsOwner = HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
pullRequest
, prsRepo :: Name Repo
prsRepo = HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
pullRequest
, prsPullRequest :: IssueNumber
prsPullRequest = PullRequest -> IssueNumber
pullRequestNumber PullRequest
pullRequest
}
class HasPullRequest env where
pullRequestL :: Lens' env PullRequest
pullRequestOwnerName :: HasCallStack => PullRequest -> Name Owner
pullRequestOwnerName :: PullRequest -> Name Owner
pullRequestOwnerName = SimpleOwner -> Name Owner
simpleOwnerLogin (SimpleOwner -> Name Owner)
-> (PullRequest -> SimpleOwner) -> PullRequest -> Name Owner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PullRequest -> SimpleOwner
PullRequest -> SimpleOwner
pullRequestOwner
pullRequestRepoName :: HasCallStack => PullRequest -> Name Repo
pullRequestRepoName :: PullRequest -> Name Repo
pullRequestRepoName = Repo -> Name Repo
repoName (Repo -> Name Repo)
-> (PullRequest -> Repo) -> PullRequest -> Name Repo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PullRequest -> Repo
PullRequest -> Repo
pullRequestRepo
pullRequestUserLogin :: PullRequest -> Name User
pullRequestUserLogin :: PullRequest -> Name User
pullRequestUserLogin = SimpleUser -> Name User
simpleUserLogin (SimpleUser -> Name User)
-> (PullRequest -> SimpleUser) -> PullRequest -> Name User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> SimpleUser
pullRequestUser
pullRequestCloneUrl :: HasCallStack => PullRequest -> URL
pullRequestCloneUrl :: PullRequest -> URL
pullRequestCloneUrl =
String -> Maybe URL -> URL
forall a. HasCallStack => String -> Maybe a -> a
fromJustNote "Pull Request without clone URL"
(Maybe URL -> URL)
-> (PullRequest -> Maybe URL) -> PullRequest -> URL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> Maybe URL
repoCloneUrl
(Repo -> Maybe URL)
-> (PullRequest -> Repo) -> PullRequest -> Maybe URL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PullRequest -> Repo
PullRequest -> Repo
pullRequestRepo
pullRequestCloneUrlToken :: HasCallStack => Text -> PullRequest -> Text
pullRequestCloneUrlToken :: Text -> PullRequest -> Text
pullRequestCloneUrlToken token :: Text
token pullRequest :: PullRequest
pullRequest =
"https://x-access-token:"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
token
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "@github.com/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Owner -> Text
forall entity. Name entity -> Text
untagName (HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName PullRequest
pullRequest)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name Repo -> Text
forall entity. Name entity -> Text
untagName (HasCallStack => PullRequest -> Name Repo
PullRequest -> Name Repo
pullRequestRepoName PullRequest
pullRequest)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".git"
pullRequestIssueId :: PullRequest -> Id Issue
pullRequestIssueId :: PullRequest -> Id Issue
pullRequestIssueId = Proxy Issue -> Int -> Id Issue
forall (proxy :: * -> *) entity. proxy entity -> Int -> Id entity
mkId Proxy Issue
forall k (t :: k). Proxy t
Proxy (Int -> Id Issue)
-> (PullRequest -> Int) -> PullRequest -> Id Issue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueNumber -> Int
unIssueNumber (IssueNumber -> Int)
-> (PullRequest -> IssueNumber) -> PullRequest -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> IssueNumber
pullRequestNumber
pullRequestIsClosed :: PullRequest -> Bool
pullRequestIsClosed :: PullRequest -> Bool
pullRequestIsClosed = (IssueState -> IssueState -> Bool
forall a. Eq a => a -> a -> Bool
== IssueState
StateClosed) (IssueState -> Bool)
-> (PullRequest -> IssueState) -> PullRequest -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> IssueState
pullRequestState
pullRequestIsFork :: PullRequest -> Bool
pullRequestIsFork :: PullRequest -> Bool
pullRequestIsFork = Maybe Repo -> Maybe Repo -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Maybe Repo -> Maybe Repo -> Bool)
-> (PullRequest -> Maybe Repo) -> PullRequest -> Maybe Repo -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PullRequest -> Maybe Repo
pullRequestHeadRepo (PullRequest -> Maybe Repo -> Bool)
-> (PullRequest -> Maybe Repo) -> PullRequest -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PullRequest -> Maybe Repo
pullRequestBaseRepo
pullRequestIsNonDefaultBranch :: PullRequest -> Bool
pullRequestIsNonDefaultBranch :: PullRequest -> Bool
pullRequestIsNonDefaultBranch =
Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Text -> Text -> Bool)
-> (PullRequest -> Text) -> PullRequest -> Text -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PullRequest -> Text
pullRequestBaseRef (PullRequest -> Text -> Bool)
-> (PullRequest -> Text) -> PullRequest -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PullRequest -> Text
pullRequestDefaultBranch
pullRequestBaseRef :: PullRequest -> Text
pullRequestBaseRef :: PullRequest -> Text
pullRequestBaseRef = PullRequestCommit -> Text
pullRequestCommitRef (PullRequestCommit -> Text)
-> (PullRequest -> PullRequestCommit) -> PullRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> PullRequestCommit
pullRequestBase
pullRequestHeadRef :: PullRequest -> Text
pullRequestHeadRef :: PullRequest -> Text
pullRequestHeadRef = PullRequestCommit -> Text
pullRequestCommitRef (PullRequestCommit -> Text)
-> (PullRequest -> PullRequestCommit) -> PullRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> PullRequestCommit
pullRequestHead
pullRequestHeadSha :: PullRequest -> Text
pullRequestHeadSha :: PullRequest -> Text
pullRequestHeadSha = PullRequestCommit -> Text
pullRequestCommitSha (PullRequestCommit -> Text)
-> (PullRequest -> PullRequestCommit) -> PullRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> PullRequestCommit
pullRequestHead
pullRequestRemoteHeadRef :: PullRequest -> Text
pullRequestRemoteHeadRef :: PullRequest -> Text
pullRequestRemoteHeadRef pullRequest :: PullRequest
pullRequest@PullRequest {..}
| PullRequest -> Bool
pullRequestIsFork PullRequest
pullRequest
= "pull/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IssueNumber -> Text
forall a. IsPathPart a => a -> Text
toPathPart IssueNumber
pullRequestNumber Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/head"
| Bool
otherwise
= PullRequestCommit -> Text
pullRequestCommitRef PullRequestCommit
pullRequestHead
pullRequestLocalHeadRef :: PullRequest -> Text
pullRequestLocalHeadRef :: PullRequest -> Text
pullRequestLocalHeadRef pullRequest :: PullRequest
pullRequest@PullRequest {..}
| PullRequest -> Bool
pullRequestIsFork PullRequest
pullRequest = "pull-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IssueNumber -> Text
forall a. IsPathPart a => a -> Text
toPathPart IssueNumber
pullRequestNumber
| Bool
otherwise = PullRequestCommit -> Text
pullRequestCommitRef PullRequestCommit
pullRequestHead
pullRequestRestyledHeadRef :: PullRequest -> Text
pullRequestRestyledHeadRef :: PullRequest -> Text
pullRequestRestyledHeadRef = ("restyled/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (PullRequest -> Text) -> PullRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> Text
pullRequestLocalHeadRef
pullRequestOwner :: HasCallStack => PullRequest -> SimpleOwner
pullRequestOwner :: PullRequest -> SimpleOwner
pullRequestOwner = Repo -> SimpleOwner
repoOwner (Repo -> SimpleOwner)
-> (PullRequest -> Repo) -> PullRequest -> SimpleOwner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PullRequest -> Repo
PullRequest -> Repo
pullRequestRepo
pullRequestRepo :: HasCallStack => PullRequest -> Repo
pullRequestRepo :: PullRequest -> Repo
pullRequestRepo =
String -> Maybe Repo -> Repo
forall a. HasCallStack => String -> Maybe a -> a
fromJustNote "Pull Request without Repository" (Maybe Repo -> Repo)
-> (PullRequest -> Maybe Repo) -> PullRequest -> Repo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> Maybe Repo
pullRequestBaseRepo
pullRequestBaseRepo :: PullRequest -> Maybe Repo
pullRequestBaseRepo :: PullRequest -> Maybe Repo
pullRequestBaseRepo = PullRequestCommit -> Maybe Repo
pullRequestCommitRepo (PullRequestCommit -> Maybe Repo)
-> (PullRequest -> PullRequestCommit) -> PullRequest -> Maybe Repo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> PullRequestCommit
pullRequestBase
pullRequestHeadRepo :: PullRequest -> Maybe Repo
pullRequestHeadRepo :: PullRequest -> Maybe Repo
pullRequestHeadRepo = PullRequestCommit -> Maybe Repo
pullRequestCommitRepo (PullRequestCommit -> Maybe Repo)
-> (PullRequest -> PullRequestCommit) -> PullRequest -> Maybe Repo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> PullRequestCommit
pullRequestHead
pullRequestDefaultBranch :: PullRequest -> Text
pullRequestDefaultBranch :: PullRequest -> Text
pullRequestDefaultBranch =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "master" (Maybe Text -> Text)
-> (PullRequest -> Maybe Text) -> PullRequest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repo -> Maybe Text
repoDefaultBranch (Repo -> Maybe Text)
-> (PullRequest -> Maybe Repo) -> PullRequest -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PullRequest -> Maybe Repo
pullRequestBaseRepo)