{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

-- | This module contains the gerrit data type
module Gerrit.Data
  ( -- * Main data types
    GerritVersion (..),
    GerritQuery (..),
    GerritChangeStatus (..),
    GerritChange (..),
    GerritRevision (..),
    GerritLabel (..),
    GerritAccount (..),
    GerritLabelVote (..),
    GerritDetailedLabelVote (..),
    GerritDetailedLabel (..),
    ReviewResult (..),
    ReviewInput (..),

    -- * Convenient functions
    queryText,
  )
where

import Data.Aeson
import Data.Char (isUpper, toLower, toUpper)
import qualified Data.Map as M
import qualified Data.Text as T
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
showList :: [GerritVersion] -> ShowS
$cshowList :: [GerritVersion] -> ShowS
show :: GerritVersion -> String
$cshow :: GerritVersion -> String
showsPrec :: Int -> GerritVersion -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GerritVersion x -> GerritVersion
$cfrom :: forall x. GerritVersion -> Rep GerritVersion x
Generic, Value -> Parser [GerritVersion]
Value -> Parser GerritVersion
(Value -> Parser GerritVersion)
-> (Value -> Parser [GerritVersion]) -> FromJSON 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)

-- https://gerrit-review.googlesource.com/Documentation/json.html
data GerritRevisionKind = REWORK | TRIVIAL_REBASE | MERGE_FIRST_PARENT_UPDATE | NO_CODE_CHANGE | NO_CHANGE
  deriving (GerritRevisionKind -> GerritRevisionKind -> Bool
(GerritRevisionKind -> GerritRevisionKind -> Bool)
-> (GerritRevisionKind -> GerritRevisionKind -> Bool)
-> Eq GerritRevisionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritRevisionKind -> GerritRevisionKind -> Bool
$c/= :: GerritRevisionKind -> GerritRevisionKind -> Bool
== :: GerritRevisionKind -> GerritRevisionKind -> Bool
$c== :: GerritRevisionKind -> GerritRevisionKind -> Bool
Eq, Int -> GerritRevisionKind -> ShowS
[GerritRevisionKind] -> ShowS
GerritRevisionKind -> String
(Int -> GerritRevisionKind -> ShowS)
-> (GerritRevisionKind -> String)
-> ([GerritRevisionKind] -> ShowS)
-> Show GerritRevisionKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritRevisionKind] -> ShowS
$cshowList :: [GerritRevisionKind] -> ShowS
show :: GerritRevisionKind -> String
$cshow :: GerritRevisionKind -> String
showsPrec :: Int -> GerritRevisionKind -> ShowS
$cshowsPrec :: Int -> GerritRevisionKind -> ShowS
Show, (forall x. GerritRevisionKind -> Rep GerritRevisionKind x)
-> (forall x. Rep GerritRevisionKind x -> GerritRevisionKind)
-> Generic GerritRevisionKind
forall x. Rep GerritRevisionKind x -> GerritRevisionKind
forall x. GerritRevisionKind -> Rep GerritRevisionKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritRevisionKind x -> GerritRevisionKind
$cfrom :: forall x. GerritRevisionKind -> Rep GerritRevisionKind x
Generic, Value -> Parser [GerritRevisionKind]
Value -> Parser GerritRevisionKind
(Value -> Parser GerritRevisionKind)
-> (Value -> Parser [GerritRevisionKind])
-> FromJSON GerritRevisionKind
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritRevisionKind]
$cparseJSONList :: Value -> Parser [GerritRevisionKind]
parseJSON :: Value -> Parser GerritRevisionKind
$cparseJSON :: Value -> Parser GerritRevisionKind
FromJSON)

data GerritChangeStatus = NEW | MERGED | ABANDONED | DRAFT
  deriving (GerritChangeStatus -> GerritChangeStatus -> Bool
(GerritChangeStatus -> GerritChangeStatus -> Bool)
-> (GerritChangeStatus -> GerritChangeStatus -> Bool)
-> Eq GerritChangeStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritChangeStatus -> GerritChangeStatus -> Bool
$c/= :: GerritChangeStatus -> GerritChangeStatus -> Bool
== :: GerritChangeStatus -> GerritChangeStatus -> Bool
$c== :: GerritChangeStatus -> GerritChangeStatus -> Bool
Eq, Int -> GerritChangeStatus -> ShowS
[GerritChangeStatus] -> ShowS
GerritChangeStatus -> String
(Int -> GerritChangeStatus -> ShowS)
-> (GerritChangeStatus -> String)
-> ([GerritChangeStatus] -> ShowS)
-> Show GerritChangeStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritChangeStatus] -> ShowS
$cshowList :: [GerritChangeStatus] -> ShowS
show :: GerritChangeStatus -> String
$cshow :: GerritChangeStatus -> String
showsPrec :: Int -> GerritChangeStatus -> ShowS
$cshowsPrec :: Int -> GerritChangeStatus -> ShowS
Show, (forall x. GerritChangeStatus -> Rep GerritChangeStatus x)
-> (forall x. Rep GerritChangeStatus x -> GerritChangeStatus)
-> Generic GerritChangeStatus
forall x. Rep GerritChangeStatus x -> GerritChangeStatus
forall x. GerritChangeStatus -> Rep GerritChangeStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritChangeStatus x -> GerritChangeStatus
$cfrom :: forall x. GerritChangeStatus -> Rep GerritChangeStatus x
Generic, Value -> Parser [GerritChangeStatus]
Value -> Parser GerritChangeStatus
(Value -> Parser GerritChangeStatus)
-> (Value -> Parser [GerritChangeStatus])
-> FromJSON GerritChangeStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritChangeStatus]
$cparseJSONList :: Value -> Parser [GerritChangeStatus]
parseJSON :: Value -> Parser GerritChangeStatus
$cparseJSON :: Value -> Parser GerritChangeStatus
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
/= :: GerritLabelVote -> GerritLabelVote -> Bool
$c/= :: GerritLabelVote -> GerritLabelVote -> Bool
== :: GerritLabelVote -> GerritLabelVote -> Bool
$c== :: 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
showList :: [GerritLabelVote] -> ShowS
$cshowList :: [GerritLabelVote] -> ShowS
show :: GerritLabelVote -> String
$cshow :: GerritLabelVote -> String
showsPrec :: Int -> GerritLabelVote -> ShowS
$cshowsPrec :: Int -> 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
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
$cp1Ord :: Eq 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
$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 = Options -> Value -> Parser GerritLabelVote
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
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 :: ShowS
keyModifier = (Char -> Char) -> ShowS
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 prefix :: String
prefix = Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
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 (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    updateCase :: ShowS
updateCase [] = []
    updateCase (x :: Char
x : xs :: String
xs) = Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
    updateCase' :: ShowS
updateCase' [] = []
    updateCase' (x :: Char
x : xs :: String
xs)
      | Char -> Bool
isUpper Char
x = '_' 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
/= :: ReviewResult -> ReviewResult -> Bool
$c/= :: ReviewResult -> ReviewResult -> Bool
== :: ReviewResult -> ReviewResult -> Bool
$c== :: 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
showList :: [ReviewResult] -> ShowS
$cshowList :: [ReviewResult] -> ShowS
show :: ReviewResult -> String
$cshow :: ReviewResult -> String
showsPrec :: Int -> ReviewResult -> ShowS
$cshowsPrec :: Int -> 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
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
$cp1Ord :: Eq 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
$cto :: forall x. Rep ReviewResult x -> ReviewResult
$cfrom :: forall x. ReviewResult -> Rep ReviewResult x
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 "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 "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
/= :: ReviewInput -> ReviewInput -> Bool
$c/= :: ReviewInput -> ReviewInput -> Bool
== :: ReviewInput -> ReviewInput -> Bool
$c== :: 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
showList :: [ReviewInput] -> ShowS
$cshowList :: [ReviewInput] -> ShowS
show :: ReviewInput -> String
$cshow :: ReviewInput -> String
showsPrec :: Int -> ReviewInput -> ShowS
$cshowsPrec :: Int -> 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
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
$cp1Ord :: Eq 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
$cto :: forall x. Rep ReviewInput x -> ReviewInput
$cfrom :: forall x. ReviewInput -> Rep ReviewInput x
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 "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 "ri") {omitNothingFields :: Bool
omitNothingFields = Bool
True}

-- https://gerrit-review.googlesource.com/Documentation/user-search.html
data GerritQuery
  = Status GerritChangeStatus
  | Owner Text
  | CommitMessage Text
  | Project Text
  | ChangeId Text

-- | Convert a GerritQuery object to the search terms
queryText :: GerritQuery -> Text
queryText :: GerritQuery -> Text
queryText (Status stat :: GerritChangeStatus
stat) = "status:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ GerritChangeStatus -> String
forall a. Show a => a -> String
show GerritChangeStatus
stat)
queryText (Owner owner :: Text
owner) = "owner:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
owner
queryText (CommitMessage message :: Text
message) = "message:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message
queryText (Project project :: Text
project) = "project:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
project
queryText (ChangeId changeId :: Text
changeId) = "change:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
changeId

data GerritRevision
  = GerritRevision
      { GerritRevision -> Text
ref :: Text,
        GerritRevision -> GerritRevisionKind
kind :: GerritRevisionKind
      }
  deriving (Int -> GerritRevision -> ShowS
[GerritRevision] -> ShowS
GerritRevision -> String
(Int -> GerritRevision -> ShowS)
-> (GerritRevision -> String)
-> ([GerritRevision] -> ShowS)
-> Show GerritRevision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritRevision] -> ShowS
$cshowList :: [GerritRevision] -> ShowS
show :: GerritRevision -> String
$cshow :: GerritRevision -> String
showsPrec :: Int -> GerritRevision -> ShowS
$cshowsPrec :: Int -> GerritRevision -> ShowS
Show, (forall x. GerritRevision -> Rep GerritRevision x)
-> (forall x. Rep GerritRevision x -> GerritRevision)
-> Generic GerritRevision
forall x. Rep GerritRevision x -> GerritRevision
forall x. GerritRevision -> Rep GerritRevision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritRevision x -> GerritRevision
$cfrom :: forall x. GerritRevision -> Rep GerritRevision x
Generic, Value -> Parser [GerritRevision]
Value -> Parser GerritRevision
(Value -> Parser GerritRevision)
-> (Value -> Parser [GerritRevision]) -> FromJSON GerritRevision
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritRevision]
$cparseJSONList :: Value -> Parser [GerritRevision]
parseJSON :: Value -> Parser GerritRevision
$cparseJSON :: Value -> Parser GerritRevision
FromJSON)

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

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

newtype GerritLabel
  = GerritLabel (M.Map GerritLabelVote GerritAccount)
  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
showList :: [GerritLabel] -> ShowS
$cshowList :: [GerritLabel] -> ShowS
show :: GerritLabel -> String
$cshow :: GerritLabel -> String
showsPrec :: Int -> GerritLabel -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GerritLabel x -> GerritLabel
$cfrom :: forall x. GerritLabel -> Rep GerritLabel x
Generic, Value -> Parser [GerritLabel]
Value -> Parser GerritLabel
(Value -> Parser GerritLabel)
-> (Value -> Parser [GerritLabel]) -> FromJSON 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)

data GerritDetailedLabelVote
  = GerritDetailedLabelVote
      { GerritDetailedLabelVote -> Maybe Int
value :: Maybe Int,
        GerritDetailedLabelVote -> Int
account_id :: Int
      }
  deriving (Int -> GerritDetailedLabelVote -> ShowS
[GerritDetailedLabelVote] -> ShowS
GerritDetailedLabelVote -> String
(Int -> GerritDetailedLabelVote -> ShowS)
-> (GerritDetailedLabelVote -> String)
-> ([GerritDetailedLabelVote] -> ShowS)
-> Show GerritDetailedLabelVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritDetailedLabelVote] -> ShowS
$cshowList :: [GerritDetailedLabelVote] -> ShowS
show :: GerritDetailedLabelVote -> String
$cshow :: GerritDetailedLabelVote -> String
showsPrec :: Int -> GerritDetailedLabelVote -> ShowS
$cshowsPrec :: Int -> GerritDetailedLabelVote -> ShowS
Show, (forall x.
 GerritDetailedLabelVote -> Rep GerritDetailedLabelVote x)
-> (forall x.
    Rep GerritDetailedLabelVote x -> GerritDetailedLabelVote)
-> Generic GerritDetailedLabelVote
forall x. Rep GerritDetailedLabelVote x -> GerritDetailedLabelVote
forall x. GerritDetailedLabelVote -> Rep GerritDetailedLabelVote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritDetailedLabelVote x -> GerritDetailedLabelVote
$cfrom :: forall x. GerritDetailedLabelVote -> Rep GerritDetailedLabelVote x
Generic)

-- We use a cusom parseJSON to decode record field properly
instance FromJSON GerritDetailedLabelVote where
  parseJSON :: Value -> Parser GerritDetailedLabelVote
parseJSON = Options -> Value -> Parser GerritDetailedLabelVote
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data GerritDetailedLabel
  = GerritDetailedLabel
      { GerritDetailedLabel -> [GerritDetailedLabelVote]
all :: [GerritDetailedLabelVote],
        GerritDetailedLabel -> Int
default_value :: Int
      }
  deriving (Int -> GerritDetailedLabel -> ShowS
[GerritDetailedLabel] -> ShowS
GerritDetailedLabel -> String
(Int -> GerritDetailedLabel -> ShowS)
-> (GerritDetailedLabel -> String)
-> ([GerritDetailedLabel] -> ShowS)
-> Show GerritDetailedLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritDetailedLabel] -> ShowS
$cshowList :: [GerritDetailedLabel] -> ShowS
show :: GerritDetailedLabel -> String
$cshow :: GerritDetailedLabel -> String
showsPrec :: Int -> GerritDetailedLabel -> ShowS
$cshowsPrec :: Int -> GerritDetailedLabel -> ShowS
Show, (forall x. GerritDetailedLabel -> Rep GerritDetailedLabel x)
-> (forall x. Rep GerritDetailedLabel x -> GerritDetailedLabel)
-> Generic GerritDetailedLabel
forall x. Rep GerritDetailedLabel x -> GerritDetailedLabel
forall x. GerritDetailedLabel -> Rep GerritDetailedLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritDetailedLabel x -> GerritDetailedLabel
$cfrom :: forall x. GerritDetailedLabel -> Rep GerritDetailedLabel x
Generic, Value -> Parser [GerritDetailedLabel]
Value -> Parser GerritDetailedLabel
(Value -> Parser GerritDetailedLabel)
-> (Value -> Parser [GerritDetailedLabel])
-> FromJSON GerritDetailedLabel
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GerritDetailedLabel]
$cparseJSONList :: Value -> Parser [GerritDetailedLabel]
parseJSON :: Value -> Parser GerritDetailedLabel
$cparseJSON :: Value -> Parser GerritDetailedLabel
FromJSON)

data GerritChange
  = GerritChange
      { GerritChange -> Text
id :: Text,
        GerritChange -> Text
project :: Text,
        GerritChange -> Text
branch :: Text,
        GerritChange -> Text
subject :: Text,
        GerritChange -> GerritChangeStatus
status :: GerritChangeStatus,
        GerritChange -> Maybe Bool
mergeable :: Maybe Bool,
        GerritChange -> Map Text (Maybe GerritRevision)
revisions :: M.Map Text (Maybe GerritRevision),
        GerritChange -> Maybe Text
current_revision :: Maybe Text,
        GerritChange -> Int
number :: Int,
        GerritChange -> Map Text GerritDetailedLabel
labels :: M.Map Text GerritDetailedLabel
      }
  deriving (Int -> GerritChange -> ShowS
[GerritChange] -> ShowS
GerritChange -> String
(Int -> GerritChange -> ShowS)
-> (GerritChange -> String)
-> ([GerritChange] -> ShowS)
-> Show GerritChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritChange] -> ShowS
$cshowList :: [GerritChange] -> ShowS
show :: GerritChange -> String
$cshow :: GerritChange -> String
showsPrec :: Int -> GerritChange -> ShowS
$cshowsPrec :: Int -> GerritChange -> ShowS
Show, (forall x. GerritChange -> Rep GerritChange x)
-> (forall x. Rep GerritChange x -> GerritChange)
-> Generic GerritChange
forall x. Rep GerritChange x -> GerritChange
forall x. GerritChange -> Rep GerritChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritChange x -> GerritChange
$cfrom :: forall x. GerritChange -> Rep GerritChange x
Generic)

-- We use a cusom parseJSON to decode `_number` as `number`
instance FromJSON GerritChange where
  parseJSON :: Value -> Parser GerritChange
parseJSON = Options -> Value -> Parser GerritChange
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

aesonOptions :: Options
aesonOptions :: Options
aesonOptions = Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
forall p. (Eq p, IsString p) => p -> p
recordToJson}
  where
    recordToJson :: p -> p
recordToJson "number" = "_number"
    recordToJson "account_id" = "_account_id"
    recordToJson n :: p
n = p
n