{-# 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

-- | Clone URL appropriate to output in a message
--
-- This is a URL that will work if you are otherwised authorized to clone the
-- repository (e.g.) you have an SSH key.
--
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

-- | Clone URL using the given Access Token
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"

-- | Some API actions need to treat the PR like an Issue
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

--------------------------------------------------------------------------------
-- Internal functions below this point
--------------------------------------------------------------------------------

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

-- |
--
-- N.B. The source of all partiality and @'HasCallStack'@ constraints
--
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)