{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module contains the gerrit data type
module Gerrit.Data.Review (
    GerritVersion (..),
    GerritLabel (..),
    GerritReviewAccount (..),
    GerritLabelVote (..),
    ReviewResult (..),
    ReviewInput (..),
)
where

import Data.Aeson
import Data.Char (isUpper, toLower)
import qualified Data.Map as M
import Data.Text (Text)
import GHC.Generics (Generic)

newtype GerritVersion = GerritVersion Text
    deriving (Int -> GerritVersion -> ShowS
[GerritVersion] -> ShowS
GerritVersion -> String
(Int -> GerritVersion -> ShowS)
-> (GerritVersion -> String)
-> ([GerritVersion] -> ShowS)
-> Show GerritVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GerritVersion -> ShowS
showsPrec :: Int -> GerritVersion -> ShowS
$cshow :: GerritVersion -> String
show :: GerritVersion -> String
$cshowList :: [GerritVersion] -> ShowS
showList :: [GerritVersion] -> ShowS
Show, (forall x. GerritVersion -> Rep GerritVersion x)
-> (forall x. Rep GerritVersion x -> GerritVersion)
-> Generic GerritVersion
forall x. Rep GerritVersion x -> GerritVersion
forall x. GerritVersion -> Rep GerritVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GerritVersion -> Rep GerritVersion x
from :: forall x. GerritVersion -> Rep GerritVersion x
$cto :: forall x. Rep GerritVersion x -> GerritVersion
to :: forall x. Rep GerritVersion x -> GerritVersion
Generic)
    deriving anyclass (Maybe GerritVersion
Value -> Parser [GerritVersion]
Value -> Parser GerritVersion
(Value -> Parser GerritVersion)
-> (Value -> Parser [GerritVersion])
-> Maybe GerritVersion
-> FromJSON GerritVersion
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GerritVersion
parseJSON :: Value -> Parser GerritVersion
$cparseJSONList :: Value -> Parser [GerritVersion]
parseJSONList :: Value -> Parser [GerritVersion]
$comittedField :: Maybe GerritVersion
omittedField :: Maybe GerritVersion
FromJSON)

data GerritLabelVote = REJECTED | APPROVED | DISLIKED | RECOMMENDED
    deriving (GerritLabelVote -> GerritLabelVote -> Bool
(GerritLabelVote -> GerritLabelVote -> Bool)
-> (GerritLabelVote -> GerritLabelVote -> Bool)
-> Eq GerritLabelVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GerritLabelVote -> GerritLabelVote -> Bool
== :: GerritLabelVote -> GerritLabelVote -> Bool
$c/= :: GerritLabelVote -> GerritLabelVote -> Bool
/= :: GerritLabelVote -> GerritLabelVote -> Bool
Eq, Int -> GerritLabelVote -> ShowS
[GerritLabelVote] -> ShowS
GerritLabelVote -> String
(Int -> GerritLabelVote -> ShowS)
-> (GerritLabelVote -> String)
-> ([GerritLabelVote] -> ShowS)
-> Show GerritLabelVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GerritLabelVote -> ShowS
showsPrec :: Int -> GerritLabelVote -> ShowS
$cshow :: GerritLabelVote -> String
show :: GerritLabelVote -> String
$cshowList :: [GerritLabelVote] -> ShowS
showList :: [GerritLabelVote] -> ShowS
Show, Eq GerritLabelVote
Eq GerritLabelVote =>
(GerritLabelVote -> GerritLabelVote -> Ordering)
-> (GerritLabelVote -> GerritLabelVote -> Bool)
-> (GerritLabelVote -> GerritLabelVote -> Bool)
-> (GerritLabelVote -> GerritLabelVote -> Bool)
-> (GerritLabelVote -> GerritLabelVote -> Bool)
-> (GerritLabelVote -> GerritLabelVote -> GerritLabelVote)
-> (GerritLabelVote -> GerritLabelVote -> GerritLabelVote)
-> Ord GerritLabelVote
GerritLabelVote -> GerritLabelVote -> Bool
GerritLabelVote -> GerritLabelVote -> Ordering
GerritLabelVote -> GerritLabelVote -> GerritLabelVote
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GerritLabelVote -> GerritLabelVote -> Ordering
compare :: GerritLabelVote -> GerritLabelVote -> Ordering
$c< :: GerritLabelVote -> GerritLabelVote -> Bool
< :: GerritLabelVote -> GerritLabelVote -> Bool
$c<= :: GerritLabelVote -> GerritLabelVote -> Bool
<= :: GerritLabelVote -> GerritLabelVote -> Bool
$c> :: GerritLabelVote -> GerritLabelVote -> Bool
> :: GerritLabelVote -> GerritLabelVote -> Bool
$c>= :: GerritLabelVote -> GerritLabelVote -> Bool
>= :: GerritLabelVote -> GerritLabelVote -> Bool
$cmax :: GerritLabelVote -> GerritLabelVote -> GerritLabelVote
max :: GerritLabelVote -> GerritLabelVote -> GerritLabelVote
$cmin :: GerritLabelVote -> GerritLabelVote -> GerritLabelVote
min :: GerritLabelVote -> GerritLabelVote -> GerritLabelVote
Ord, (forall x. GerritLabelVote -> Rep GerritLabelVote x)
-> (forall x. Rep GerritLabelVote x -> GerritLabelVote)
-> Generic GerritLabelVote
forall x. Rep GerritLabelVote x -> GerritLabelVote
forall x. GerritLabelVote -> Rep GerritLabelVote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GerritLabelVote -> Rep GerritLabelVote x
from :: forall x. GerritLabelVote -> Rep GerritLabelVote x
$cto :: forall x. Rep GerritLabelVote x -> GerritLabelVote
to :: forall x. Rep GerritLabelVote x -> GerritLabelVote
Generic)

-- We use a custom parseJSON to decode Label Vote as lowercase
instance FromJSON GerritLabelVote where
    parseJSON :: Value -> Parser GerritLabelVote
parseJSON = Options -> Value -> Parser GerritLabelVote
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions{fieldLabelModifier = map toLower}

instance FromJSONKey GerritLabelVote where
    fromJSONKey :: FromJSONKeyFunction GerritLabelVote
fromJSONKey = JSONKeyOptions -> FromJSONKeyFunction GerritLabelVote
forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions{keyModifier = map toLower}

{- | Modify record attribute to match json schema
Remove the prefix and use snakecase
-}
customParseJSON :: String -> Options
customParseJSON :: String -> Options
customParseJSON String
prefix = Options
defaultOptions{fieldLabelModifier = recordToJson}
  where
    recordToJson :: ShowS
recordToJson = ShowS
updateCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    updateCase :: ShowS
updateCase [] = []
    updateCase (Char
x : String
xs) = Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
    updateCase' :: ShowS
updateCase' [] = []
    updateCase' (Char
x : String
xs)
        | Char -> Bool
isUpper Char
x = Char
'_' Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
        | Bool
otherwise = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs

-- https://gerrit-review.googlesource.com/Documentation/rest-api-changes.html
data ReviewResult = ReviewResult
    { ReviewResult -> Maybe (Map Text Int)
rrLabels :: Maybe (M.Map Text Int)
    , ReviewResult -> Maybe Int
rrReady :: Maybe Int
    }
    deriving (ReviewResult -> ReviewResult -> Bool
(ReviewResult -> ReviewResult -> Bool)
-> (ReviewResult -> ReviewResult -> Bool) -> Eq ReviewResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReviewResult -> ReviewResult -> Bool
== :: ReviewResult -> ReviewResult -> Bool
$c/= :: ReviewResult -> ReviewResult -> Bool
/= :: ReviewResult -> ReviewResult -> Bool
Eq, Int -> ReviewResult -> ShowS
[ReviewResult] -> ShowS
ReviewResult -> String
(Int -> ReviewResult -> ShowS)
-> (ReviewResult -> String)
-> ([ReviewResult] -> ShowS)
-> Show ReviewResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReviewResult -> ShowS
showsPrec :: Int -> ReviewResult -> ShowS
$cshow :: ReviewResult -> String
show :: ReviewResult -> String
$cshowList :: [ReviewResult] -> ShowS
showList :: [ReviewResult] -> ShowS
Show, Eq ReviewResult
Eq ReviewResult =>
(ReviewResult -> ReviewResult -> Ordering)
-> (ReviewResult -> ReviewResult -> Bool)
-> (ReviewResult -> ReviewResult -> Bool)
-> (ReviewResult -> ReviewResult -> Bool)
-> (ReviewResult -> ReviewResult -> Bool)
-> (ReviewResult -> ReviewResult -> ReviewResult)
-> (ReviewResult -> ReviewResult -> ReviewResult)
-> Ord ReviewResult
ReviewResult -> ReviewResult -> Bool
ReviewResult -> ReviewResult -> Ordering
ReviewResult -> ReviewResult -> ReviewResult
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReviewResult -> ReviewResult -> Ordering
compare :: ReviewResult -> ReviewResult -> Ordering
$c< :: ReviewResult -> ReviewResult -> Bool
< :: ReviewResult -> ReviewResult -> Bool
$c<= :: ReviewResult -> ReviewResult -> Bool
<= :: ReviewResult -> ReviewResult -> Bool
$c> :: ReviewResult -> ReviewResult -> Bool
> :: ReviewResult -> ReviewResult -> Bool
$c>= :: ReviewResult -> ReviewResult -> Bool
>= :: ReviewResult -> ReviewResult -> Bool
$cmax :: ReviewResult -> ReviewResult -> ReviewResult
max :: ReviewResult -> ReviewResult -> ReviewResult
$cmin :: ReviewResult -> ReviewResult -> ReviewResult
min :: ReviewResult -> ReviewResult -> ReviewResult
Ord, (forall x. ReviewResult -> Rep ReviewResult x)
-> (forall x. Rep ReviewResult x -> ReviewResult)
-> Generic ReviewResult
forall x. Rep ReviewResult x -> ReviewResult
forall x. ReviewResult -> Rep ReviewResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReviewResult -> Rep ReviewResult x
from :: forall x. ReviewResult -> Rep ReviewResult x
$cto :: forall x. Rep ReviewResult x -> ReviewResult
to :: forall x. Rep ReviewResult x -> ReviewResult
Generic)

instance FromJSON ReviewResult where
    parseJSON :: Value -> Parser ReviewResult
parseJSON = Options -> Value -> Parser ReviewResult
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ReviewResult)
-> Options -> Value -> Parser ReviewResult
forall a b. (a -> b) -> a -> b
$ String -> Options
customParseJSON String
"rr"

instance ToJSON ReviewResult where
    toJSON :: ReviewResult -> Value
toJSON = Options -> ReviewResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ReviewResult -> Value)
-> Options -> ReviewResult -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
customParseJSON String
"rr"

data ReviewInput = ReviewInput
    { ReviewInput -> Maybe Text
riMessage :: Maybe Text
    , ReviewInput -> Maybe (Map Text Int)
riLabels :: Maybe (M.Map Text Int)
    }
    deriving (ReviewInput -> ReviewInput -> Bool
(ReviewInput -> ReviewInput -> Bool)
-> (ReviewInput -> ReviewInput -> Bool) -> Eq ReviewInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReviewInput -> ReviewInput -> Bool
== :: ReviewInput -> ReviewInput -> Bool
$c/= :: ReviewInput -> ReviewInput -> Bool
/= :: ReviewInput -> ReviewInput -> Bool
Eq, Int -> ReviewInput -> ShowS
[ReviewInput] -> ShowS
ReviewInput -> String
(Int -> ReviewInput -> ShowS)
-> (ReviewInput -> String)
-> ([ReviewInput] -> ShowS)
-> Show ReviewInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReviewInput -> ShowS
showsPrec :: Int -> ReviewInput -> ShowS
$cshow :: ReviewInput -> String
show :: ReviewInput -> String
$cshowList :: [ReviewInput] -> ShowS
showList :: [ReviewInput] -> ShowS
Show, Eq ReviewInput
Eq ReviewInput =>
(ReviewInput -> ReviewInput -> Ordering)
-> (ReviewInput -> ReviewInput -> Bool)
-> (ReviewInput -> ReviewInput -> Bool)
-> (ReviewInput -> ReviewInput -> Bool)
-> (ReviewInput -> ReviewInput -> Bool)
-> (ReviewInput -> ReviewInput -> ReviewInput)
-> (ReviewInput -> ReviewInput -> ReviewInput)
-> Ord ReviewInput
ReviewInput -> ReviewInput -> Bool
ReviewInput -> ReviewInput -> Ordering
ReviewInput -> ReviewInput -> ReviewInput
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ReviewInput -> ReviewInput -> Ordering
compare :: ReviewInput -> ReviewInput -> Ordering
$c< :: ReviewInput -> ReviewInput -> Bool
< :: ReviewInput -> ReviewInput -> Bool
$c<= :: ReviewInput -> ReviewInput -> Bool
<= :: ReviewInput -> ReviewInput -> Bool
$c> :: ReviewInput -> ReviewInput -> Bool
> :: ReviewInput -> ReviewInput -> Bool
$c>= :: ReviewInput -> ReviewInput -> Bool
>= :: ReviewInput -> ReviewInput -> Bool
$cmax :: ReviewInput -> ReviewInput -> ReviewInput
max :: ReviewInput -> ReviewInput -> ReviewInput
$cmin :: ReviewInput -> ReviewInput -> ReviewInput
min :: ReviewInput -> ReviewInput -> ReviewInput
Ord, (forall x. ReviewInput -> Rep ReviewInput x)
-> (forall x. Rep ReviewInput x -> ReviewInput)
-> Generic ReviewInput
forall x. Rep ReviewInput x -> ReviewInput
forall x. ReviewInput -> Rep ReviewInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReviewInput -> Rep ReviewInput x
from :: forall x. ReviewInput -> Rep ReviewInput x
$cto :: forall x. Rep ReviewInput x -> ReviewInput
to :: forall x. Rep ReviewInput x -> ReviewInput
Generic)

instance FromJSON ReviewInput where
    parseJSON :: Value -> Parser ReviewInput
parseJSON = Options -> Value -> Parser ReviewInput
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ReviewInput)
-> Options -> Value -> Parser ReviewInput
forall a b. (a -> b) -> a -> b
$ String -> Options
customParseJSON String
"ri"

instance ToJSON ReviewInput where
    toJSON :: ReviewInput -> Value
toJSON = Options -> ReviewInput -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> ReviewInput -> Value)
-> Options -> ReviewInput -> Value
forall a b. (a -> b) -> a -> b
$ (String -> Options
customParseJSON String
"ri"){omitNothingFields = True}

newtype GerritReviewAccount = GerritReviewAccount
    { GerritReviewAccount -> Int
unused_account_id :: Int
    }
    deriving (Int -> GerritReviewAccount -> ShowS
[GerritReviewAccount] -> ShowS
GerritReviewAccount -> String
(Int -> GerritReviewAccount -> ShowS)
-> (GerritReviewAccount -> String)
-> ([GerritReviewAccount] -> ShowS)
-> Show GerritReviewAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GerritReviewAccount -> ShowS
showsPrec :: Int -> GerritReviewAccount -> ShowS
$cshow :: GerritReviewAccount -> String
show :: GerritReviewAccount -> String
$cshowList :: [GerritReviewAccount] -> ShowS
showList :: [GerritReviewAccount] -> ShowS
Show, (forall x. GerritReviewAccount -> Rep GerritReviewAccount x)
-> (forall x. Rep GerritReviewAccount x -> GerritReviewAccount)
-> Generic GerritReviewAccount
forall x. Rep GerritReviewAccount x -> GerritReviewAccount
forall x. GerritReviewAccount -> Rep GerritReviewAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GerritReviewAccount -> Rep GerritReviewAccount x
from :: forall x. GerritReviewAccount -> Rep GerritReviewAccount x
$cto :: forall x. Rep GerritReviewAccount x -> GerritReviewAccount
to :: forall x. Rep GerritReviewAccount x -> GerritReviewAccount
Generic)

-- We use a cusom parseJSON to decode `_account_id` as `account_id`
instance FromJSON GerritReviewAccount where
    parseJSON :: Value -> Parser GerritReviewAccount
parseJSON = Options -> Value -> Parser GerritReviewAccount
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

newtype GerritLabel
    = GerritLabel (M.Map GerritLabelVote GerritReviewAccount)
    deriving (Int -> GerritLabel -> ShowS
[GerritLabel] -> ShowS
GerritLabel -> String
(Int -> GerritLabel -> ShowS)
-> (GerritLabel -> String)
-> ([GerritLabel] -> ShowS)
-> Show GerritLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GerritLabel -> ShowS
showsPrec :: Int -> GerritLabel -> ShowS
$cshow :: GerritLabel -> String
show :: GerritLabel -> String
$cshowList :: [GerritLabel] -> ShowS
showList :: [GerritLabel] -> ShowS
Show, (forall x. GerritLabel -> Rep GerritLabel x)
-> (forall x. Rep GerritLabel x -> GerritLabel)
-> Generic GerritLabel
forall x. Rep GerritLabel x -> GerritLabel
forall x. GerritLabel -> Rep GerritLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GerritLabel -> Rep GerritLabel x
from :: forall x. GerritLabel -> Rep GerritLabel x
$cto :: forall x. Rep GerritLabel x -> GerritLabel
to :: forall x. Rep GerritLabel x -> GerritLabel
Generic)
    deriving anyclass (Maybe GerritLabel
Value -> Parser [GerritLabel]
Value -> Parser GerritLabel
(Value -> Parser GerritLabel)
-> (Value -> Parser [GerritLabel])
-> Maybe GerritLabel
-> FromJSON GerritLabel
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser GerritLabel
parseJSON :: Value -> Parser GerritLabel
$cparseJSONList :: Value -> Parser [GerritLabel]
parseJSONList :: Value -> Parser [GerritLabel]
$comittedField :: Maybe GerritLabel
omittedField :: Maybe GerritLabel
FromJSON)