{-# LANGUAGE LambdaCase #-}

module Restyler.Config.RequestReview
    ( RequestReviewConfig
    , determineReviewer
    )
where

import Restyler.Prelude

import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Types (typeMismatch)
import GitHub.Data (User, toPathPart)
import Restyler.Config.ExpectedKeys
import Restyler.PullRequest

data RequestReviewFrom
    = RequestReviewFromNone
    | RequestReviewFromAuthor
    | RequestReviewFromOwner
    | RequestReviewFrom (Name User)
    deriving (RequestReviewFrom -> RequestReviewFrom -> Bool
(RequestReviewFrom -> RequestReviewFrom -> Bool)
-> (RequestReviewFrom -> RequestReviewFrom -> Bool)
-> Eq RequestReviewFrom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestReviewFrom -> RequestReviewFrom -> Bool
$c/= :: RequestReviewFrom -> RequestReviewFrom -> Bool
== :: RequestReviewFrom -> RequestReviewFrom -> Bool
$c== :: RequestReviewFrom -> RequestReviewFrom -> Bool
Eq, Int -> RequestReviewFrom -> ShowS
[RequestReviewFrom] -> ShowS
RequestReviewFrom -> String
(Int -> RequestReviewFrom -> ShowS)
-> (RequestReviewFrom -> String)
-> ([RequestReviewFrom] -> ShowS)
-> Show RequestReviewFrom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestReviewFrom] -> ShowS
$cshowList :: [RequestReviewFrom] -> ShowS
show :: RequestReviewFrom -> String
$cshow :: RequestReviewFrom -> String
showsPrec :: Int -> RequestReviewFrom -> ShowS
$cshowsPrec :: Int -> RequestReviewFrom -> ShowS
Show, (forall x. RequestReviewFrom -> Rep RequestReviewFrom x)
-> (forall x. Rep RequestReviewFrom x -> RequestReviewFrom)
-> Generic RequestReviewFrom
forall x. Rep RequestReviewFrom x -> RequestReviewFrom
forall x. RequestReviewFrom -> Rep RequestReviewFrom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestReviewFrom x -> RequestReviewFrom
$cfrom :: forall x. RequestReviewFrom -> Rep RequestReviewFrom x
Generic)

instance FromJSON RequestReviewFrom where
    parseJSON :: Value -> Parser RequestReviewFrom
parseJSON = String
-> (Text -> Parser RequestReviewFrom)
-> Value
-> Parser RequestReviewFrom
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "RequestReviewFrom" ((Text -> Parser RequestReviewFrom)
 -> Value -> Parser RequestReviewFrom)
-> (Text -> Parser RequestReviewFrom)
-> Value
-> Parser RequestReviewFrom
forall a b. (a -> b) -> a -> b
$ RequestReviewFrom -> Parser RequestReviewFrom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestReviewFrom -> Parser RequestReviewFrom)
-> (Text -> RequestReviewFrom) -> Text -> Parser RequestReviewFrom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RequestReviewFrom
readRequestReviewFrom

instance ToJSON RequestReviewFrom where
    toJSON :: RequestReviewFrom -> Value
toJSON RequestReviewFromNone = Text -> Value
String "none"
    toJSON RequestReviewFromAuthor = Text -> Value
String "author"
    toJSON RequestReviewFromOwner = Text -> Value
String "owner"
    toJSON (RequestReviewFrom name :: Name User
name) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Name User -> Text
forall a. IsPathPart a => a -> Text
toPathPart Name User
name

readRequestReviewFrom :: Text -> RequestReviewFrom
readRequestReviewFrom :: Text -> RequestReviewFrom
readRequestReviewFrom = \case
    "none" -> RequestReviewFrom
RequestReviewFromNone
    "author" -> RequestReviewFrom
RequestReviewFromAuthor
    "owner" -> RequestReviewFrom
RequestReviewFromOwner
    x :: Text
x -> Name User -> RequestReviewFrom
RequestReviewFrom (Name User -> RequestReviewFrom) -> Name User -> RequestReviewFrom
forall a b. (a -> b) -> a -> b
$ Proxy User -> Text -> Name User
forall (proxy :: * -> *) entity.
proxy entity -> Text -> Name entity
mkName Proxy User
forall k (t :: k). Proxy t
Proxy Text
x

data RequestReviewConfig = RequestReviewConfig
    { RequestReviewConfig -> RequestReviewFrom
rrcOrigin :: RequestReviewFrom
    , RequestReviewConfig -> RequestReviewFrom
rrcForked :: RequestReviewFrom
    }
    deriving (RequestReviewConfig -> RequestReviewConfig -> Bool
(RequestReviewConfig -> RequestReviewConfig -> Bool)
-> (RequestReviewConfig -> RequestReviewConfig -> Bool)
-> Eq RequestReviewConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestReviewConfig -> RequestReviewConfig -> Bool
$c/= :: RequestReviewConfig -> RequestReviewConfig -> Bool
== :: RequestReviewConfig -> RequestReviewConfig -> Bool
$c== :: RequestReviewConfig -> RequestReviewConfig -> Bool
Eq, Int -> RequestReviewConfig -> ShowS
[RequestReviewConfig] -> ShowS
RequestReviewConfig -> String
(Int -> RequestReviewConfig -> ShowS)
-> (RequestReviewConfig -> String)
-> ([RequestReviewConfig] -> ShowS)
-> Show RequestReviewConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestReviewConfig] -> ShowS
$cshowList :: [RequestReviewConfig] -> ShowS
show :: RequestReviewConfig -> String
$cshow :: RequestReviewConfig -> String
showsPrec :: Int -> RequestReviewConfig -> ShowS
$cshowsPrec :: Int -> RequestReviewConfig -> ShowS
Show, (forall x. RequestReviewConfig -> Rep RequestReviewConfig x)
-> (forall x. Rep RequestReviewConfig x -> RequestReviewConfig)
-> Generic RequestReviewConfig
forall x. Rep RequestReviewConfig x -> RequestReviewConfig
forall x. RequestReviewConfig -> Rep RequestReviewConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestReviewConfig x -> RequestReviewConfig
$cfrom :: forall x. RequestReviewConfig -> Rep RequestReviewConfig x
Generic)

bothFrom :: RequestReviewFrom -> RequestReviewConfig
bothFrom :: RequestReviewFrom -> RequestReviewConfig
bothFrom x :: RequestReviewFrom
x = RequestReviewConfig :: RequestReviewFrom -> RequestReviewFrom -> RequestReviewConfig
RequestReviewConfig { rrcOrigin :: RequestReviewFrom
rrcOrigin = RequestReviewFrom
x, rrcForked :: RequestReviewFrom
rrcForked = RequestReviewFrom
x }

-- brittany-disable-next-binding

instance FromJSON RequestReviewConfig where
    parseJSON :: Value -> Parser RequestReviewConfig
parseJSON (String t :: Text
t) =
        RequestReviewConfig -> Parser RequestReviewConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RequestReviewConfig -> Parser RequestReviewConfig)
-> RequestReviewConfig -> Parser RequestReviewConfig
forall a b. (a -> b) -> a -> b
$ RequestReviewFrom -> RequestReviewConfig
bothFrom (RequestReviewFrom -> RequestReviewConfig)
-> RequestReviewFrom -> RequestReviewConfig
forall a b. (a -> b) -> a -> b
$ Text -> RequestReviewFrom
readRequestReviewFrom Text
t
    parseJSON (Object o :: Object
o) = do
        [String] -> Object -> Parser ()
forall v. [String] -> HashMap Text v -> Parser ()
validateObjectKeys ["origin", "forked"] Object
o
        RequestReviewFrom -> RequestReviewFrom -> RequestReviewConfig
RequestReviewConfig
            (RequestReviewFrom -> RequestReviewFrom -> RequestReviewConfig)
-> Parser RequestReviewFrom
-> Parser (RequestReviewFrom -> RequestReviewConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe RequestReviewFrom)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "origin" Parser (Maybe RequestReviewFrom)
-> RequestReviewFrom -> Parser RequestReviewFrom
forall a. Parser (Maybe a) -> a -> Parser a
.!= RequestReviewFrom
RequestReviewFromAuthor
            Parser (RequestReviewFrom -> RequestReviewConfig)
-> Parser RequestReviewFrom -> Parser RequestReviewConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RequestReviewFrom)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "forked" Parser (Maybe RequestReviewFrom)
-> RequestReviewFrom -> Parser RequestReviewFrom
forall a. Parser (Maybe a) -> a -> Parser a
.!= RequestReviewFrom
RequestReviewFromNone
    parseJSON x :: Value
x = String -> Value -> Parser RequestReviewConfig
forall a. String -> Value -> Parser a
typeMismatch
        "Invalid type for RequestReview. Expected String or Object."
        Value
x

instance ToJSON RequestReviewConfig where
    toJSON :: RequestReviewConfig -> Value
toJSON = Options -> RequestReviewConfig -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestReviewConfig -> Value)
-> Options -> RequestReviewConfig -> Value
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase
    toEncoding :: RequestReviewConfig -> Encoding
toEncoding = Options -> RequestReviewConfig -> Encoding
forall a.
(Generic a, GToJSON Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> RequestReviewConfig -> Encoding)
-> Options -> RequestReviewConfig -> Encoding
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

determineReviewer
    :: PullRequest -- ^ The Original PR
    -> RequestReviewConfig
    -> Maybe (Name User)
determineReviewer :: PullRequest -> RequestReviewConfig -> Maybe (Name User)
determineReviewer pr :: PullRequest
pr RequestReviewConfig {..} =
    (RequestReviewFrom -> PullRequest -> Maybe (Name User)
`reviewerFor` PullRequest
pr) (RequestReviewFrom -> Maybe (Name User))
-> RequestReviewFrom -> Maybe (Name User)
forall a b. (a -> b) -> a -> b
$ RequestReviewFrom -> RequestReviewFrom -> Bool -> RequestReviewFrom
forall a. a -> a -> Bool -> a
bool RequestReviewFrom
rrcOrigin RequestReviewFrom
rrcForked (Bool -> RequestReviewFrom) -> Bool -> RequestReviewFrom
forall a b. (a -> b) -> a -> b
$ PullRequest -> Bool
pullRequestIsFork PullRequest
pr

reviewerFor :: RequestReviewFrom -> PullRequest -> Maybe (Name User)
reviewerFor :: RequestReviewFrom -> PullRequest -> Maybe (Name User)
reviewerFor RequestReviewFromNone = Maybe (Name User) -> PullRequest -> Maybe (Name User)
forall a b. a -> b -> a
const Maybe (Name User)
forall a. Maybe a
Nothing
reviewerFor RequestReviewFromAuthor = Name User -> Maybe (Name User)
forall a. a -> Maybe a
Just (Name User -> Maybe (Name User))
-> (PullRequest -> Name User) -> PullRequest -> Maybe (Name User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequest -> Name User
pullRequestUserLogin
reviewerFor RequestReviewFromOwner = Name User -> Maybe (Name User)
forall a. a -> Maybe a
Just (Name User -> Maybe (Name User))
-> (PullRequest -> Name User) -> PullRequest -> Maybe (Name User)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Owner -> Name User
forall a b. Name a -> Name b
coerceName (Name Owner -> Name User)
-> (PullRequest -> Name Owner) -> PullRequest -> Name User
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => PullRequest -> Name Owner
PullRequest -> Name Owner
pullRequestOwnerName
reviewerFor (RequestReviewFrom name :: Name User
name) = Maybe (Name User) -> PullRequest -> Maybe (Name User)
forall a b. a -> b -> a
const (Maybe (Name User) -> PullRequest -> Maybe (Name User))
-> Maybe (Name User) -> PullRequest -> Maybe (Name User)
forall a b. (a -> b) -> a -> b
$ Name User -> Maybe (Name User)
forall a. a -> Maybe a
Just Name User
name

-- TODO: centralize this?
coerceName :: Name a -> Name b
coerceName :: Name a -> Name b
coerceName = Proxy b -> Text -> Name b
forall (proxy :: * -> *) entity.
proxy entity -> Text -> Name entity
mkName Proxy b
forall k (t :: k). Proxy t
Proxy (Text -> Name b) -> (Name a -> Text) -> Name a -> Name b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> Text
forall entity. Name entity -> Text
untagName