{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritVersion] -> ShowS
$cshowList :: [GerritVersion] -> ShowS
show :: GerritVersion -> String
$cshow :: GerritVersion -> String
showsPrec :: Int -> GerritVersion -> ShowS
$cshowsPrec :: Int -> GerritVersion -> ShowS
Show, 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
$cto :: forall x. Rep GerritVersion x -> GerritVersion
$cfrom :: forall x. GerritVersion -> Rep GerritVersion x
Generic)
  deriving anyclass (Value -> Parser [GerritVersion]
Value -> Parser GerritVersion
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritVersion]
$cparseJSONList :: Value -> Parser [GerritVersion]
parseJSON :: Value -> Parser GerritVersion
$cparseJSON :: Value -> Parser GerritVersion
FromJSON)

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

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

instance FromJSONKey GerritLabelVote where
  fromJSONKey :: FromJSONKeyFunction GerritLabelVote
fromJSONKey = forall a.
(Generic a, GFromJSONKey (Rep a)) =>
JSONKeyOptions -> FromJSONKeyFunction a
genericFromJSONKey JSONKeyOptions
defaultJSONKeyOptions {keyModifier :: ShowS
keyModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
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 :: ShowS
fieldLabelModifier = ShowS
recordToJson}
  where
    recordToJson :: ShowS
recordToJson = ShowS
updateCase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    updateCase :: ShowS
updateCase [] = []
    updateCase (Char
x : String
xs) = Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
    updateCase' :: ShowS
updateCase' [] = []
    updateCase' (Char
x : String
xs)
      | Char -> Bool
isUpper Char
x = Char
'_' forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
      | Bool
otherwise = Char
x 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReviewResult -> ReviewResult -> Bool
$c/= :: ReviewResult -> ReviewResult -> Bool
== :: ReviewResult -> ReviewResult -> Bool
$c== :: ReviewResult -> ReviewResult -> Bool
Eq, Int -> ReviewResult -> ShowS
[ReviewResult] -> ShowS
ReviewResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReviewResult] -> ShowS
$cshowList :: [ReviewResult] -> ShowS
show :: ReviewResult -> String
$cshow :: ReviewResult -> String
showsPrec :: Int -> ReviewResult -> ShowS
$cshowsPrec :: Int -> ReviewResult -> ShowS
Show, Eq 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
min :: ReviewResult -> ReviewResult -> ReviewResult
$cmin :: ReviewResult -> ReviewResult -> ReviewResult
max :: ReviewResult -> ReviewResult -> ReviewResult
$cmax :: ReviewResult -> ReviewResult -> ReviewResult
>= :: ReviewResult -> ReviewResult -> Bool
$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
compare :: ReviewResult -> ReviewResult -> Ordering
$ccompare :: ReviewResult -> ReviewResult -> Ordering
Ord, 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
$cto :: forall x. Rep ReviewResult x -> ReviewResult
$cfrom :: forall x. ReviewResult -> Rep ReviewResult x
Generic)

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

instance ToJSON ReviewResult where
  toJSON :: ReviewResult -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReviewInput -> ReviewInput -> Bool
$c/= :: ReviewInput -> ReviewInput -> Bool
== :: ReviewInput -> ReviewInput -> Bool
$c== :: ReviewInput -> ReviewInput -> Bool
Eq, Int -> ReviewInput -> ShowS
[ReviewInput] -> ShowS
ReviewInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReviewInput] -> ShowS
$cshowList :: [ReviewInput] -> ShowS
show :: ReviewInput -> String
$cshow :: ReviewInput -> String
showsPrec :: Int -> ReviewInput -> ShowS
$cshowsPrec :: Int -> ReviewInput -> ShowS
Show, Eq 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
min :: ReviewInput -> ReviewInput -> ReviewInput
$cmin :: ReviewInput -> ReviewInput -> ReviewInput
max :: ReviewInput -> ReviewInput -> ReviewInput
$cmax :: ReviewInput -> ReviewInput -> ReviewInput
>= :: ReviewInput -> ReviewInput -> Bool
$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
compare :: ReviewInput -> ReviewInput -> Ordering
$ccompare :: ReviewInput -> ReviewInput -> Ordering
Ord, 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
$cto :: forall x. Rep ReviewInput x -> ReviewInput
$cfrom :: forall x. ReviewInput -> Rep ReviewInput x
Generic)

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

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

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

-- We use a cusom parseJSON to decode `_account_id` as `account_id`
instance FromJSON GerritReviewAccount where
  parseJSON :: Value -> Parser GerritReviewAccount
parseJSON = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritLabel] -> ShowS
$cshowList :: [GerritLabel] -> ShowS
show :: GerritLabel -> String
$cshow :: GerritLabel -> String
showsPrec :: Int -> GerritLabel -> ShowS
$cshowsPrec :: Int -> GerritLabel -> ShowS
Show, 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
$cto :: forall x. Rep GerritLabel x -> GerritLabel
$cfrom :: forall x. GerritLabel -> Rep GerritLabel x
Generic)
  deriving anyclass (Value -> Parser [GerritLabel]
Value -> Parser GerritLabel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritLabel]
$cparseJSONList :: Value -> Parser [GerritLabel]
parseJSON :: Value -> Parser GerritLabel
$cparseJSON :: Value -> Parser GerritLabel
FromJSON)