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

module Gerrit.Data.Change
  ( GerritQuery (..),
    GerritChangeStatus (..),
    GerritRevisionKind (..),
    GerritFile (..),
    GerritCommit (..),
    GerritRevision (..),
    GerritDetailedLabelVote (..),
    GerritDetailedLabel (..),
    GerritAuthor (..),
    GerritCommitAuthor (..),
    GerritChangeMessage (..),
    GerritChange (..),
    GerritTime (..),
    changeQS,
    queryText,
    defaultQueryChangeOptions,
    hasLabel,
  )
where

import Data.Aeson
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import GHC.Generics (Generic)

aesonOptions :: Options
aesonOptions :: Options
aesonOptions = Options
defaultOptions {fieldLabelModifier :: String -> String
fieldLabelModifier = forall {a}. (Eq a, IsString a) => a -> a
recordToJson}
  where
    recordToJson :: a -> a
recordToJson a
"number" = a
"_number"
    recordToJson a
"account_id" = a
"_account_id"
    recordToJson a
"aAccountId" = a
"_account_id"
    recordToJson a
"aName" = a
"name"
    recordToJson a
"aEmail" = a
"email"
    recordToJson a
"aUsername" = a
"username"
    recordToJson a
"more_changes" = a
"_more_changes"
    recordToJson a
n = a
n

-- https://gerrit-review.googlesource.com/Documentation/user-search.html
data GerritQuery
  = Status GerritChangeStatus
  | Owner Text
  | CommitMessage Text
  | Project Text
  | ChangeId Text
  | After UTCTime
  deriving (GerritQuery -> GerritQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritQuery -> GerritQuery -> Bool
$c/= :: GerritQuery -> GerritQuery -> Bool
== :: GerritQuery -> GerritQuery -> Bool
$c== :: GerritQuery -> GerritQuery -> Bool
Eq, Int -> GerritQuery -> String -> String
[GerritQuery] -> String -> String
GerritQuery -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritQuery] -> String -> String
$cshowList :: [GerritQuery] -> String -> String
show :: GerritQuery -> String
$cshow :: GerritQuery -> String
showsPrec :: Int -> GerritQuery -> String -> String
$cshowsPrec :: Int -> GerritQuery -> String -> String
Show)

-- | Convert a GerritQuery object to the search terms
queryText :: GerritQuery -> Text
queryText :: GerritQuery -> Text
queryText (Status GerritChangeStatus
stat) = Text
"status:" forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show GerritChangeStatus
stat)
queryText (Owner Text
owner') = Text
"owner:" forall a. Semigroup a => a -> a -> a
<> Text
owner'
queryText (CommitMessage Text
message) = Text
"message:" forall a. Semigroup a => a -> a -> a
<> Text
message
queryText (Project Text
project') = Text
"project:" forall a. Semigroup a => a -> a -> a
<> Text
project'
queryText (ChangeId Text
changeId) = Text
"change:" forall a. Semigroup a => a -> a -> a
<> Text
changeId
queryText (After UTCTime
date') = Text
"after:" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
formatedDate
  where
    formatedDate :: String
formatedDate = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" UTCTime
date'

defaultQueryChangeOptions :: Text
defaultQueryChangeOptions :: Text
defaultQueryChangeOptions =
  Text
"o="
    forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate
      Text
"&o="
      [ Text
"MESSAGES",
        Text
"DETAILED_ACCOUNTS",
        Text
"DETAILED_LABELS",
        Text
"CURRENT_REVISION",
        Text
"CURRENT_FILES",
        Text
"CURRENT_COMMIT"
      ]

-- | Build the Query String for the changes endpoint
-- >>> changeQS 10 [Project "software-factory/gerrit-haskell"] Nothing
-- "q=project:software-factory/gerrit-haskell&n=10&o=MESSAGES&o=DETAILED_ACCOUNTS&o=DETAILED_LABELS&o=CURRENT_REVISION&o=CURRENT_FILES&o=CURRENT_COMMIT"
-- >>> changeQS 10 [Project "software-factory/gerrit-haskell"] $ Just 100
-- "q=project:software-factory/gerrit-haskell&n=10&o=MESSAGES&o=DETAILED_ACCOUNTS&o=DETAILED_LABELS&o=CURRENT_REVISION&o=CURRENT_FILES&o=CURRENT_COMMIT&start=100"
changeQS :: Int -> [GerritQuery] -> Maybe Int -> Text
changeQS :: Int -> [GerritQuery] -> Maybe Int -> Text
changeQS Int
count [GerritQuery]
queries Maybe Int
startM =
  let base :: Text
base =
        Text -> [Text] -> Text
T.intercalate
          Text
"&"
          [ Text
changeString,
            Text
countString,
            Text
defaultQueryChangeOptions
          ]
   in Text
base forall a. Semigroup a => a -> a -> a
<> Text
startString
  where
    changeString :: Text
changeString = Text
"q=" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"+" (forall a b. (a -> b) -> [a] -> [b]
map GerritQuery -> Text
queryText [GerritQuery]
queries)
    countString :: Text
countString = Text
"n=" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
count)
    startString :: Text
startString = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\Int
s -> Text
"&start=" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
s)) Maybe Int
startM

-- | Check if a gerrit change as a label
hasLabel :: T.Text -> Int -> GerritChange -> Bool
hasLabel :: Text -> Int -> GerritChange -> Bool
hasLabel Text
label Int
labelValue GerritChange
change = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
label (GerritChange -> Map Text GerritDetailedLabel
labels GerritChange
change) of
  Just GerritDetailedLabel
gerritLabel ->
    (forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> [a]
filter
          (\GerritDetailedLabelVote
vote -> forall a. a -> Maybe a -> a
fromMaybe Int
0 (GerritDetailedLabelVote -> Maybe Int
value GerritDetailedLabelVote
vote) forall a. Eq a => a -> a -> Bool
== Int
labelValue)
          (forall a. a -> Maybe a -> a
fromMaybe [] (GerritDetailedLabel -> Maybe [GerritDetailedLabelVote]
Gerrit.Data.Change.all GerritDetailedLabel
gerritLabel))
  Maybe GerritDetailedLabel
_ -> Bool
False

data GerritChangeStatus = NEW | MERGED | ABANDONED
  deriving (GerritChangeStatus -> GerritChangeStatus -> Bool
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 -> String -> String
[GerritChangeStatus] -> String -> String
GerritChangeStatus -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritChangeStatus] -> String -> String
$cshowList :: [GerritChangeStatus] -> String -> String
show :: GerritChangeStatus -> String
$cshow :: GerritChangeStatus -> String
showsPrec :: Int -> GerritChangeStatus -> String -> String
$cshowsPrec :: Int -> GerritChangeStatus -> String -> String
Show, 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
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)

-- 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
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 -> String -> String
[GerritRevisionKind] -> String -> String
GerritRevisionKind -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritRevisionKind] -> String -> String
$cshowList :: [GerritRevisionKind] -> String -> String
show :: GerritRevisionKind -> String
$cshow :: GerritRevisionKind -> String
showsPrec :: Int -> GerritRevisionKind -> String -> String
$cshowsPrec :: Int -> GerritRevisionKind -> String -> String
Show, 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
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 GerritFile = GerritFile
  { GerritFile -> Maybe Text
gfStatus :: Maybe Text,
    GerritFile -> Maybe Int
gfLinesInserted :: Maybe Int,
    GerritFile -> Maybe Int
gfLinesDeleted :: Maybe Int,
    GerritFile -> Maybe Int
gfSizeDelta :: Maybe Int,
    GerritFile -> Maybe Int
gfSize :: Maybe Int
  }
  deriving (GerritFile -> GerritFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritFile -> GerritFile -> Bool
$c/= :: GerritFile -> GerritFile -> Bool
== :: GerritFile -> GerritFile -> Bool
$c== :: GerritFile -> GerritFile -> Bool
Eq, Int -> GerritFile -> String -> String
[GerritFile] -> String -> String
GerritFile -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritFile] -> String -> String
$cshowList :: [GerritFile] -> String -> String
show :: GerritFile -> String
$cshow :: GerritFile -> String
showsPrec :: Int -> GerritFile -> String -> String
$cshowsPrec :: Int -> GerritFile -> String -> String
Show, forall x. Rep GerritFile x -> GerritFile
forall x. GerritFile -> Rep GerritFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritFile x -> GerritFile
$cfrom :: forall x. GerritFile -> Rep GerritFile x
Generic)

instance FromJSON GerritFile where
  parseJSON :: Value -> Parser GerritFile
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase

data GerritCommit = GerritCommit
  { GerritCommit -> GerritCommitAuthor
cAuthor :: GerritCommitAuthor,
    GerritCommit -> GerritCommitAuthor
cCommitter :: GerritCommitAuthor,
    GerritCommit -> Text
cSubject :: Text,
    GerritCommit -> Text
cMessage :: Text
  }
  deriving (GerritCommit -> GerritCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritCommit -> GerritCommit -> Bool
$c/= :: GerritCommit -> GerritCommit -> Bool
== :: GerritCommit -> GerritCommit -> Bool
$c== :: GerritCommit -> GerritCommit -> Bool
Eq, Int -> GerritCommit -> String -> String
[GerritCommit] -> String -> String
GerritCommit -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritCommit] -> String -> String
$cshowList :: [GerritCommit] -> String -> String
show :: GerritCommit -> String
$cshow :: GerritCommit -> String
showsPrec :: Int -> GerritCommit -> String -> String
$cshowsPrec :: Int -> GerritCommit -> String -> String
Show, forall x. Rep GerritCommit x -> GerritCommit
forall x. GerritCommit -> Rep GerritCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritCommit x -> GerritCommit
$cfrom :: forall x. GerritCommit -> Rep GerritCommit x
Generic)

instance FromJSON GerritCommit where
  parseJSON :: Value -> Parser GerritCommit
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase

data GerritRevision = GerritRevision
  { GerritRevision -> Text
grRef :: Text,
    GerritRevision -> GerritRevisionKind
grKind :: GerritRevisionKind,
    GerritRevision -> Map Text GerritFile
grFiles :: M.Map Text GerritFile,
    GerritRevision -> GerritCommit
grCommit :: GerritCommit,
    GerritRevision -> GerritAuthor
grUploader :: GerritAuthor
  }
  deriving (GerritRevision -> GerritRevision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritRevision -> GerritRevision -> Bool
$c/= :: GerritRevision -> GerritRevision -> Bool
== :: GerritRevision -> GerritRevision -> Bool
$c== :: GerritRevision -> GerritRevision -> Bool
Eq, Int -> GerritRevision -> String -> String
[GerritRevision] -> String -> String
GerritRevision -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritRevision] -> String -> String
$cshowList :: [GerritRevision] -> String -> String
show :: GerritRevision -> String
$cshow :: GerritRevision -> String
showsPrec :: Int -> GerritRevision -> String -> String
$cshowsPrec :: Int -> GerritRevision -> String -> String
Show, 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)

instance FromJSON GerritRevision where
  parseJSON :: Value -> Parser GerritRevision
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase

data GerritDetailedLabelVote = GerritDetailedLabelVote
  { GerritDetailedLabelVote -> Maybe Int
value :: Maybe Int,
    GerritDetailedLabelVote -> Int
account_id :: Int
  }
  deriving (GerritDetailedLabelVote -> GerritDetailedLabelVote -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritDetailedLabelVote -> GerritDetailedLabelVote -> Bool
$c/= :: GerritDetailedLabelVote -> GerritDetailedLabelVote -> Bool
== :: GerritDetailedLabelVote -> GerritDetailedLabelVote -> Bool
$c== :: GerritDetailedLabelVote -> GerritDetailedLabelVote -> Bool
Eq, Int -> GerritDetailedLabelVote -> String -> String
[GerritDetailedLabelVote] -> String -> String
GerritDetailedLabelVote -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritDetailedLabelVote] -> String -> String
$cshowList :: [GerritDetailedLabelVote] -> String -> String
show :: GerritDetailedLabelVote -> String
$cshow :: GerritDetailedLabelVote -> String
showsPrec :: Int -> GerritDetailedLabelVote -> String -> String
$cshowsPrec :: Int -> GerritDetailedLabelVote -> String -> String
Show, 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)

instance FromJSON GerritDetailedLabelVote where
  parseJSON :: Value -> Parser GerritDetailedLabelVote
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data GerritDetailedLabel = GerritDetailedLabel
  { GerritDetailedLabel -> Maybe [GerritDetailedLabelVote]
all :: Maybe [GerritDetailedLabelVote],
    GerritDetailedLabel -> Int
default_value :: Int
  }
  deriving (GerritDetailedLabel -> GerritDetailedLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritDetailedLabel -> GerritDetailedLabel -> Bool
$c/= :: GerritDetailedLabel -> GerritDetailedLabel -> Bool
== :: GerritDetailedLabel -> GerritDetailedLabel -> Bool
$c== :: GerritDetailedLabel -> GerritDetailedLabel -> Bool
Eq, Int -> GerritDetailedLabel -> String -> String
[GerritDetailedLabel] -> String -> String
GerritDetailedLabel -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritDetailedLabel] -> String -> String
$cshowList :: [GerritDetailedLabel] -> String -> String
show :: GerritDetailedLabel -> String
$cshow :: GerritDetailedLabel -> String
showsPrec :: Int -> GerritDetailedLabel -> String -> String
$cshowsPrec :: Int -> GerritDetailedLabel -> String -> String
Show, 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
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 GerritAuthor = GerritAuthor
  { GerritAuthor -> Int
aAccountId :: Int,
    GerritAuthor -> Maybe Text
aName :: Maybe Text,
    GerritAuthor -> Maybe Text
aEmail :: Maybe Text,
    GerritAuthor -> Maybe Text
aUsername :: Maybe Text
  }
  deriving (GerritAuthor -> GerritAuthor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritAuthor -> GerritAuthor -> Bool
$c/= :: GerritAuthor -> GerritAuthor -> Bool
== :: GerritAuthor -> GerritAuthor -> Bool
$c== :: GerritAuthor -> GerritAuthor -> Bool
Eq, Int -> GerritAuthor -> String -> String
[GerritAuthor] -> String -> String
GerritAuthor -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritAuthor] -> String -> String
$cshowList :: [GerritAuthor] -> String -> String
show :: GerritAuthor -> String
$cshow :: GerritAuthor -> String
showsPrec :: Int -> GerritAuthor -> String -> String
$cshowsPrec :: Int -> GerritAuthor -> String -> String
Show, forall x. Rep GerritAuthor x -> GerritAuthor
forall x. GerritAuthor -> Rep GerritAuthor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritAuthor x -> GerritAuthor
$cfrom :: forall x. GerritAuthor -> Rep GerritAuthor x
Generic)

instance FromJSON GerritAuthor where
  parseJSON :: Value -> Parser GerritAuthor
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

data GerritCommitAuthor = GerritCommitAuthor
  { GerritCommitAuthor -> Text
caName :: Text,
    GerritCommitAuthor -> Maybe Text
caEmail :: Maybe Text,
    GerritCommitAuthor -> GerritTime
caDate :: GerritTime
  }
  deriving (GerritCommitAuthor -> GerritCommitAuthor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritCommitAuthor -> GerritCommitAuthor -> Bool
$c/= :: GerritCommitAuthor -> GerritCommitAuthor -> Bool
== :: GerritCommitAuthor -> GerritCommitAuthor -> Bool
$c== :: GerritCommitAuthor -> GerritCommitAuthor -> Bool
Eq, Int -> GerritCommitAuthor -> String -> String
[GerritCommitAuthor] -> String -> String
GerritCommitAuthor -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritCommitAuthor] -> String -> String
$cshowList :: [GerritCommitAuthor] -> String -> String
show :: GerritCommitAuthor -> String
$cshow :: GerritCommitAuthor -> String
showsPrec :: Int -> GerritCommitAuthor -> String -> String
$cshowsPrec :: Int -> GerritCommitAuthor -> String -> String
Show, forall x. Rep GerritCommitAuthor x -> GerritCommitAuthor
forall x. GerritCommitAuthor -> Rep GerritCommitAuthor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritCommitAuthor x -> GerritCommitAuthor
$cfrom :: forall x. GerritCommitAuthor -> Rep GerritCommitAuthor x
Generic)

instance FromJSON GerritCommitAuthor where
  parseJSON :: Value -> Parser GerritCommitAuthor
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase

newtype GerritTime = GerritTime {GerritTime -> UTCTime
unGerritTime :: UTCTime}
  deriving (GerritTime -> GerritTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritTime -> GerritTime -> Bool
$c/= :: GerritTime -> GerritTime -> Bool
== :: GerritTime -> GerritTime -> Bool
$c== :: GerritTime -> GerritTime -> Bool
Eq, Int -> GerritTime -> String -> String
[GerritTime] -> String -> String
GerritTime -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritTime] -> String -> String
$cshowList :: [GerritTime] -> String -> String
show :: GerritTime -> String
$cshow :: GerritTime -> String
showsPrec :: Int -> GerritTime -> String -> String
$cshowsPrec :: Int -> GerritTime -> String -> String
Show)

instance FromJSON GerritTime where
  parseJSON :: Value -> Parser GerritTime
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"UTCTimePlus" (forall {f :: * -> *}. MonadFail f => String -> f GerritTime
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
    where
      format :: String
format = String
"%F %T.000000000"
      tryParse :: String -> String -> m t
tryParse String
f String
s = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
f String
s
      parse :: String -> f GerritTime
parse String
s = UTCTime -> GerritTime
GerritTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
String -> String -> m t
tryParse String
format String
s

data GerritChangeMessage = GerritChangeMessage
  { GerritChangeMessage -> Text
mId :: Text,
    GerritChangeMessage -> Maybe GerritAuthor
mAuthor :: Maybe GerritAuthor,
    GerritChangeMessage -> GerritTime
mDate :: GerritTime,
    GerritChangeMessage -> Text
mMessage :: Text
  }
  deriving (GerritChangeMessage -> GerritChangeMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritChangeMessage -> GerritChangeMessage -> Bool
$c/= :: GerritChangeMessage -> GerritChangeMessage -> Bool
== :: GerritChangeMessage -> GerritChangeMessage -> Bool
$c== :: GerritChangeMessage -> GerritChangeMessage -> Bool
Eq, Int -> GerritChangeMessage -> String -> String
[GerritChangeMessage] -> String -> String
GerritChangeMessage -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritChangeMessage] -> String -> String
$cshowList :: [GerritChangeMessage] -> String -> String
show :: GerritChangeMessage -> String
$cshow :: GerritChangeMessage -> String
showsPrec :: Int -> GerritChangeMessage -> String -> String
$cshowsPrec :: Int -> GerritChangeMessage -> String -> String
Show, forall x. Rep GerritChangeMessage x -> GerritChangeMessage
forall x. GerritChangeMessage -> Rep GerritChangeMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritChangeMessage x -> GerritChangeMessage
$cfrom :: forall x. GerritChangeMessage -> Rep GerritChangeMessage x
Generic)

instance FromJSON GerritChangeMessage where
  parseJSON :: Value -> Parser GerritChangeMessage
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ (String -> String) -> Options
aesonPrefix String -> String
snakeCase

data GerritChange = GerritChange
  { GerritChange -> Text
id :: Text,
    GerritChange -> Text
project :: Text,
    GerritChange -> Text
branch :: Text,
    GerritChange -> [Text]
hashtags :: [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,
    GerritChange -> [GerritChangeMessage]
messages :: [GerritChangeMessage],
    GerritChange -> GerritAuthor
owner :: GerritAuthor,
    GerritChange -> GerritTime
created :: GerritTime,
    GerritChange -> GerritTime
updated :: GerritTime,
    GerritChange -> Maybe GerritTime
submitted :: Maybe GerritTime,
    GerritChange -> Maybe GerritAuthor
submitter :: Maybe GerritAuthor,
    GerritChange -> Maybe Text
topic :: Maybe Text,
    GerritChange -> Int
insertions :: Int,
    GerritChange -> Int
deletions :: Int,
    GerritChange -> Maybe Bool
more_changes :: Maybe Bool,
    GerritChange -> Maybe Bool
work_in_progress :: Maybe Bool
  }
  deriving (GerritChange -> GerritChange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritChange -> GerritChange -> Bool
$c/= :: GerritChange -> GerritChange -> Bool
== :: GerritChange -> GerritChange -> Bool
$c== :: GerritChange -> GerritChange -> Bool
Eq, Int -> GerritChange -> String -> String
[GerritChange] -> String -> String
GerritChange -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GerritChange] -> String -> String
$cshowList :: [GerritChange] -> String -> String
show :: GerritChange -> String
$cshow :: GerritChange -> String
showsPrec :: Int -> GerritChange -> String -> String
$cshowsPrec :: Int -> GerritChange -> String -> String
Show, 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)

instance FromJSON GerritChange where
  parseJSON :: Value -> Parser GerritChange
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions