gerrit 0.1.6.0 → 0.1.6.1
raw patch · 10 files changed
+734/−709 lines, 10 filesdep ~aesondep ~aeson-casingdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, aeson-casing, base, bytestring, containers, directory, http-client-openssl, tasty, tasty-hunit, text, time
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- gerrit.cabal +13/−13
- src/Gerrit.hs +45/−45
- src/Gerrit/Client.hs +45/−45
- src/Gerrit/Data/Account.hs +37/−37
- src/Gerrit/Data/Change.hs +127/−126
- src/Gerrit/Data/Event.hs +327/−327
- src/Gerrit/Data/Project.hs +8/−8
- src/Gerrit/Data/Review.hs +33/−32
- test/Spec.hs +94/−76
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog +## 0.1.6.1++- Apply hlint suggestion+- Add version bounds to the build-depends+ ## 0.1.6.0 - Add a nix flake
gerrit.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: gerrit-version: 0.1.6.0+version: 0.1.6.1 synopsis: A gerrit client library description: Gerrit is a client library to interface with https://www.gerritcodereview.com/@@ -26,10 +26,10 @@ location: https://github.com/softwarefactory-project/gerrit-haskell.git common common-options- build-depends: base >= 4.11.0.0 && < 5- , aeson >= 1.0.0.0 && < 2.1- , bytestring < 0.12- , time >= 1.9.3 && < 2.0+ build-depends: base >= 4.11 && < 5+ , aeson >= 2.0 && < 2.3+ , bytestring >= 0.10 && < 0.13+ , time >= 1 && < 2 ghc-options: -Wall -Wcompat -Widentities@@ -48,11 +48,11 @@ library import: common-options- build-depends: containers >= 0.5.8.0 && < 0.7- , http-client >= 0.5.0 && < 0.8- , http-client-openssl >= 0.3.0 && < 0.4- , text >= 0.11.1.0 && < 1.3- , aeson-casing >= 0.2.0.0 && < 0.3.0.0+ build-depends: containers >= 0.5.8.0 && < 0.8+ , http-client >= 0.5.0 && < 0.8+ , http-client-openssl >= 0.3.0 && < 1+ , text >= 0.11 && < 3+ , aeson-casing >= 0.2.0.0 && < 0.4 hs-source-dirs: src exposed-modules: Gerrit@@ -68,10 +68,10 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs- build-depends: directory+ build-depends: directory >= 1.0 && < 2 , gerrit- , tasty >= 0.11.2 && < 1.5- , tasty-hunit >= 0.10 && < 0.11+ , tasty >= 0.11.2 && < 2+ , tasty-hunit >= 0.10 && < 2 ghc-options: -threaded -rtsopts -with-rtsopts=-N
src/Gerrit.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -- | This module contains the gerrit client library-module Gerrit- ( -- * Client+module Gerrit (+ -- * Client GerritClient, withClient, getClient,@@ -30,7 +30,7 @@ -- * Convenient functions changeUrl, serverUrl,- )+) where import Control.Exception (try)@@ -60,66 +60,66 @@ -- | Get projects getProjects ::- -- | Count of projects to get back- Int ->- -- | The project query type- GerritProjectQuery ->- -- | Whether or not to ask result from offset- Maybe Int ->- -- | The client- GerritClient ->- IO GerritProjectsMessage+ -- | Count of projects to get back+ Int ->+ -- | The project query type+ GerritProjectQuery ->+ -- | Whether or not to ask result from offset+ Maybe Int ->+ -- | The client+ GerritClient ->+ IO GerritProjectsMessage getProjects count query startM = gerritGet ("projects/?" <> projectQS count query startM) -- | Search for changes queryChanges ::- -- | Count of changes to get back- Int ->- -- | The change query- [GerritQuery] ->- -- | Whether or not to ask result from offset- Maybe Int ->- -- | The client- GerritClient ->- IO [GerritChange]+ -- | Count of changes to get back+ Int ->+ -- | The change query+ [GerritQuery] ->+ -- | Whether or not to ask result from offset+ Maybe Int ->+ -- | The client+ GerritClient ->+ IO [GerritChange] queryChanges count queries startM = gerritGet ("changes/?" <> changeQS count queries startM) -- | Get a change by change Id getChange :: Int -> GerritClient -> IO (Maybe GerritChange) getChange changeNumber client = do- res <-- try- ( gerritGet ("changes/" <> T.pack (show changeNumber) <> "?" <> defaultQueryChangeOptions) client- ) ::- IO (Either HttpException GerritChange)- pure $ case res of- Right change -> Just change- Left _err -> Nothing+ res <-+ try+ ( gerritGet ("changes/" <> T.pack (show changeNumber) <> "?" <> defaultQueryChangeOptions) client+ ) ::+ IO (Either HttpException GerritChange)+ pure $ case res of+ Right change -> Just change+ Left _err -> Nothing -- | Post a review postReview ::- -- | The change to review- GerritChange ->- -- | A message- Text ->- -- | A label- Text ->- -- | A vote- Int ->- -- | The client- GerritClient ->- -- | Returns the ReviewResult- IO ReviewResult+ -- | The change to review+ GerritChange ->+ -- | A message+ Text ->+ -- | A label+ Text ->+ -- | A vote+ Int ->+ -- | The client+ GerritClient ->+ -- | Returns the ReviewResult+ IO ReviewResult postReview change message label value' = gerritPost urlPath review where urlPath = "changes/" <> changeId <> "/revisions/" <> revHash <> "/review" changeId = Gerrit.Data.Change.id change revHash = fromMaybe "" (Gerrit.Data.Change.current_revision change) review =- ReviewInput- { riMessage = Just message,- riLabels = Just (M.fromList [(label, value')])- }+ ReviewInput+ { riMessage = Just message+ , riLabels = Just (M.fromList [(label, value')])+ } -- | Get user account id getAccountId :: Int -> NonEmpty GerritAccountQuery -> GerritClient -> IO [GerritAccountId]
src/Gerrit/Client.hs view
@@ -2,14 +2,14 @@ {-# LANGUAGE RecordWildCards #-} -- | This module contains the internal gerrit REST client-module Gerrit.Client- ( GerritClient (baseUrl),+module Gerrit.Client (+ GerritClient (baseUrl), withClient, gerritGet, gerritPost, getClient, getClientWithManager,- )+) where import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode)@@ -22,66 +22,66 @@ -- | The GerritClient record, use 'withClient' to create data GerritClient = GerritClient- { baseUrl :: Text,- manager :: Manager,- auth :: Maybe (Text, Text)- }+ { baseUrl :: Text+ , manager :: Manager+ , auth :: Maybe (Text, Text)+ } -- | Need to be call through withOpenSSL getClient :: Text -> Maybe (Text, Text) -> IO GerritClient getClient url auth = do- manager <- newOpenSSLManager- pure $ getClientWithManager manager url auth+ manager <- newOpenSSLManager+ pure $ getClientWithManager manager url auth -- | Creates a GerritClient with a provided http manager. getClientWithManager :: Manager -> Text -> Maybe (Text, Text) -> GerritClient getClientWithManager manager url auth =- let baseUrl = T.dropWhileEnd (== '/') url <> "/"- in GerritClient {..}+ let baseUrl = T.dropWhileEnd (== '/') url <> "/"+ in GerritClient{..} -- | Create the 'GerritClient' withClient ::- -- | The gerrit api url- Text ->- -- | Credentials (login, password) [Optional]- Maybe (Text, Text) ->- -- | The callback- (GerritClient -> IO a) ->- -- | withClient performs the IO- IO a+ -- | The gerrit api url+ Text ->+ -- | Credentials (login, password) [Optional]+ Maybe (Text, Text) ->+ -- | The callback+ (GerritClient -> IO a) ->+ -- | withClient performs the IO+ IO a withClient url creds callBack = withOpenSSL $ do- client <- getClient url creds- callBack client+ client <- getClient url creds+ callBack client gerritDecode :: (FromJSON a, Applicative f) => Response BSL.ByteString -> f a gerritDecode response = case eitherDecode $ BSL.drop 5 $ responseBody response of- Left err -> error $ "Decoding of " <> show (responseBody response) <> " failed with: " <> err- Right a -> pure a+ Left err -> error $ "Decoding of " <> show (responseBody response) <> " failed with: " <> err+ Right a -> pure a gerritRequest :: Text -> GerritClient -> IO Request-gerritRequest path GerritClient {..} =- case auth of- Just (user, pass) ->- applyBasicAuth (T.encodeUtf8 user) (T.encodeUtf8 pass)- <$> parseUrlThrow (unpack $ baseUrl <> "a/" <> path)- Nothing -> parseUrlThrow (unpack $ baseUrl <> path)+gerritRequest path GerritClient{..} =+ case auth of+ Just (user, pass) ->+ applyBasicAuth (T.encodeUtf8 user) (T.encodeUtf8 pass)+ <$> parseUrlThrow (unpack $ baseUrl <> "a/" <> path)+ Nothing -> parseUrlThrow (unpack $ baseUrl <> path) gerritPost :: (ToJSON a, FromJSON b) => Text -> a -> GerritClient -> IO b-gerritPost path postData client@GerritClient {..} =- do- initRequest <- gerritRequest path client- let request =- initRequest- { method = "POST",- requestHeaders = requestHeaders initRequest <> [("Content-Type", "application/json; charset=UTF-8")],- requestBody = RequestBodyLBS $ encode postData- }- response <- httpLbs request manager- gerritDecode response+gerritPost path postData client@GerritClient{..} =+ do+ initRequest <- gerritRequest path client+ let request =+ initRequest+ { method = "POST"+ , requestHeaders = requestHeaders initRequest <> [("Content-Type", "application/json; charset=UTF-8")]+ , requestBody = RequestBodyLBS $ encode postData+ }+ response <- httpLbs request manager+ gerritDecode response gerritGet :: (FromJSON a) => Text -> GerritClient -> IO a-gerritGet path client@GerritClient {..} =- do- request <- gerritRequest path client- response <- httpLbs request manager- gerritDecode response+gerritGet path client@GerritClient{..} =+ do+ request <- gerritRequest path client+ response <- httpLbs request manager+ gerritDecode response
src/Gerrit/Data/Account.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} -module Gerrit.Data.Account- ( GerritAccountId (..),+module Gerrit.Data.Account (+ GerritAccountId (..), GerritAccount (..), GerritAccountQuery (..), userQueryText, accountQs,- )+) where import Control.Monad (mzero)@@ -18,22 +18,22 @@ -- https://gerrit-review.googlesource.com/Documentation/user-search-accounts.html#_search_operators data GerritAccountQuery- = CanSee Text- | Email Text- | Name Text- | Username Text- | IsActive- | IsInactive- deriving (Eq, Show)+ = CanSee Text+ | Email Text+ | Name Text+ | Username Text+ | IsActive+ | IsInactive+ deriving (Eq, Show) userQueryText :: GerritAccountQuery -> Text userQueryText guq = case guq of- CanSee change -> "cansee:" <> change- Email email -> "email:" <> email- Name name -> "name:" <> escapeChar name- Username username -> "username:" <> username- IsActive -> "is:active"- IsInactive -> "is:inactive"+ CanSee change -> "cansee:" <> change+ Email email -> "email:" <> email+ Name name -> "name:" <> escapeChar name+ Username username -> "username:" <> username+ IsActive -> "is:active"+ IsInactive -> "is:inactive" where escapeChar = T.replace "'" " " @@ -44,30 +44,30 @@ countString = "n=" <> T.pack (show count) data GerritAccountId = GerritAccountId- { gerritAccountId' :: Int,- gerritAccountHasMore' :: Maybe Bool- }- deriving (Eq, Show)+ { gerritAccountId' :: Int+ , gerritAccountHasMore' :: Maybe Bool+ }+ deriving (Eq, Show) instance FromJSON GerritAccountId where- parseJSON (Object v) = GerritAccountId <$> v .: "_account_id" <*> v .:? "_more_accounts"- parseJSON _ = mzero+ parseJSON (Object v) = GerritAccountId <$> v .: "_account_id" <*> v .:? "_more_accounts"+ parseJSON _ = mzero data GerritAccount = GerritAccount- { gerritAccountId :: Int,- gerritAccountName :: Text,- gerritAccountUsername :: Maybe Text,- gerritAccountEmail :: Maybe Text,- gerritAccountHasMore :: Maybe Bool- }- deriving (Eq, Show)+ { gerritAccountId :: Int+ , gerritAccountName :: Text+ , gerritAccountUsername :: Maybe Text+ , gerritAccountEmail :: Maybe Text+ , gerritAccountHasMore :: Maybe Bool+ }+ deriving (Eq, Show) instance FromJSON GerritAccount where- parseJSON (Object v) =- GerritAccount- <$> v .: "_account_id"- <*> v .: "name"- <*> v .:? "username"- <*> v .:? "email"- <*> v .:? "_more_accounts"- parseJSON _ = mzero+ parseJSON (Object v) =+ GerritAccount+ <$> v .: "_account_id"+ <*> v .: "name"+ <*> v .:? "username"+ <*> v .:? "email"+ <*> v .:? "_more_accounts"+ parseJSON _ = mzero
src/Gerrit/Data/Change.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} -module Gerrit.Data.Change- ( GerritQuery (..),+module Gerrit.Data.Change (+ GerritQuery (..), GerritChangeStatus (..), GerritRevisionKind (..), GerritFile (..),@@ -21,7 +21,7 @@ queryText, defaultQueryChangeOptions, hasLabel,- )+) where import Data.Aeson@@ -35,7 +35,7 @@ import GHC.Generics (Generic) aesonOptions :: Options-aesonOptions = defaultOptions {fieldLabelModifier = recordToJson}+aesonOptions = defaultOptions{fieldLabelModifier = recordToJson} where recordToJson "number" = "_number" recordToJson "account_id" = "_account_id"@@ -48,13 +48,13 @@ -- https://gerrit-review.googlesource.com/Documentation/user-search.html data GerritQuery- = Status GerritChangeStatus- | Owner Text- | CommitMessage Text- | Project Text- | ChangeId Text- | After UTCTime- deriving (Eq, Show)+ = Status GerritChangeStatus+ | Owner Text+ | CommitMessage Text+ | Project Text+ | ChangeId Text+ | After UTCTime+ deriving (Eq, Show) -- | Convert a GerritQuery object to the search terms queryText :: GerritQuery -> Text@@ -69,32 +69,33 @@ defaultQueryChangeOptions :: Text defaultQueryChangeOptions =- "o="- <> T.intercalate- "&o="- [ "MESSAGES",- "DETAILED_ACCOUNTS",- "DETAILED_LABELS",- "CURRENT_REVISION",- "CURRENT_FILES",- "CURRENT_COMMIT"- ]+ "o="+ <> T.intercalate+ "&o="+ [ "MESSAGES"+ , "DETAILED_ACCOUNTS"+ , "DETAILED_LABELS"+ , "CURRENT_REVISION"+ , "CURRENT_FILES"+ , "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"+{- | 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 count queries startM =- let base =- T.intercalate- "&"- [ changeString,- countString,- defaultQueryChangeOptions- ]- in base <> startString+ let base =+ T.intercalate+ "&"+ [ changeString+ , countString+ , defaultQueryChangeOptions+ ]+ in base <> startString where changeString = "q=" <> T.intercalate "+" (map queryText queries) countString = "n=" <> T.pack (show count)@@ -103,138 +104,138 @@ -- | Check if a gerrit change as a label hasLabel :: T.Text -> Int -> GerritChange -> Bool hasLabel label labelValue change = case M.lookup label (labels change) of- Just gerritLabel ->- (> 0) $- length $- filter- (\vote -> fromMaybe 0 (value vote) == labelValue)- (fromMaybe [] (Gerrit.Data.Change.all gerritLabel))- _ -> False+ Just gerritLabel ->+ (> 0) $+ length $+ filter+ (\vote -> fromMaybe 0 (value vote) == labelValue)+ (fromMaybe [] (Gerrit.Data.Change.all gerritLabel))+ _ -> False data GerritChangeStatus = NEW | MERGED | ABANDONED- deriving (Eq, Show, Generic, FromJSON)+ deriving (Eq, Show, Generic, FromJSON) -- https://gerrit-review.googlesource.com/Documentation/json.html data GerritRevisionKind = REWORK | TRIVIAL_REBASE | MERGE_FIRST_PARENT_UPDATE | NO_CODE_CHANGE | NO_CHANGE- deriving (Eq, Show, Generic, FromJSON)+ deriving (Eq, Show, Generic, FromJSON) data GerritFile = GerritFile- { gfStatus :: Maybe Text,- gfLinesInserted :: Maybe Int,- gfLinesDeleted :: Maybe Int,- gfSizeDelta :: Maybe Int,- gfSize :: Maybe Int- }- deriving (Eq, Show, Generic)+ { gfStatus :: Maybe Text+ , gfLinesInserted :: Maybe Int+ , gfLinesDeleted :: Maybe Int+ , gfSizeDelta :: Maybe Int+ , gfSize :: Maybe Int+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritFile where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase data GerritCommit = GerritCommit- { cAuthor :: GerritCommitAuthor,- cCommitter :: GerritCommitAuthor,- cSubject :: Text,- cMessage :: Text- }- deriving (Eq, Show, Generic)+ { cAuthor :: GerritCommitAuthor+ , cCommitter :: GerritCommitAuthor+ , cSubject :: Text+ , cMessage :: Text+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritCommit where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase data GerritRevision = GerritRevision- { grRef :: Text,- grKind :: GerritRevisionKind,- grFiles :: M.Map Text GerritFile,- grCommit :: GerritCommit,- grUploader :: GerritAuthor- }- deriving (Eq, Show, Generic)+ { grRef :: Text+ , grKind :: GerritRevisionKind+ , grFiles :: M.Map Text GerritFile+ , grCommit :: GerritCommit+ , grUploader :: GerritAuthor+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritRevision where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase data GerritDetailedLabelVote = GerritDetailedLabelVote- { value :: Maybe Int,- account_id :: Int- }- deriving (Eq, Show, Generic)+ { value :: Maybe Int+ , account_id :: Int+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritDetailedLabelVote where- parseJSON = genericParseJSON aesonOptions+ parseJSON = genericParseJSON aesonOptions data GerritDetailedLabel = GerritDetailedLabel- { all :: Maybe [GerritDetailedLabelVote],- default_value :: Int- }- deriving (Eq, Show, Generic, FromJSON)+ { all :: Maybe [GerritDetailedLabelVote]+ , default_value :: Int+ }+ deriving (Eq, Show, Generic, FromJSON) data GerritAuthor = GerritAuthor- { aAccountId :: Int,- aName :: Maybe Text,- aEmail :: Maybe Text,- aUsername :: Maybe Text- }- deriving (Eq, Show, Generic)+ { aAccountId :: Int+ , aName :: Maybe Text+ , aEmail :: Maybe Text+ , aUsername :: Maybe Text+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritAuthor where- parseJSON = genericParseJSON aesonOptions+ parseJSON = genericParseJSON aesonOptions data GerritCommitAuthor = GerritCommitAuthor- { caName :: Text,- caEmail :: Maybe Text,- caDate :: GerritTime- }- deriving (Eq, Show, Generic)+ { caName :: Text+ , caEmail :: Maybe Text+ , caDate :: GerritTime+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritCommitAuthor where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase newtype GerritTime = GerritTime {unGerritTime :: UTCTime}- deriving (Eq, Show)+ deriving (Eq, Show) instance FromJSON GerritTime where- parseJSON = withText "UTCTimePlus" (parse . T.unpack)- where- format = "%F %T.000000000"- tryParse f s = parseTimeM False defaultTimeLocale f s- parse s = GerritTime <$> tryParse format s+ parseJSON = withText "UTCTimePlus" (parse . T.unpack)+ where+ format = "%F %T.000000000"+ tryParse = parseTimeM False defaultTimeLocale+ parse s = GerritTime <$> tryParse format s data GerritChangeMessage = GerritChangeMessage- { mId :: Text,- mAuthor :: Maybe GerritAuthor,- mDate :: GerritTime,- mMessage :: Text- }- deriving (Eq, Show, Generic)+ { mId :: Text+ , mAuthor :: Maybe GerritAuthor+ , mDate :: GerritTime+ , mMessage :: Text+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritChangeMessage where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase data GerritChange = GerritChange- { id :: Text,- project :: Text,- branch :: Text,- hashtags :: [Text],- subject :: Text,- status :: GerritChangeStatus,- mergeable :: Maybe Bool,- revisions :: M.Map Text (Maybe GerritRevision),- current_revision :: Maybe Text,- number :: Int,- labels :: M.Map Text GerritDetailedLabel,- messages :: [GerritChangeMessage],- owner :: GerritAuthor,- created :: GerritTime,- updated :: GerritTime,- submitted :: Maybe GerritTime,- submitter :: Maybe GerritAuthor,- topic :: Maybe Text,- insertions :: Int,- deletions :: Int,- more_changes :: Maybe Bool,- work_in_progress :: Maybe Bool- }- deriving (Eq, Show, Generic)+ { id :: Text+ , project :: Text+ , branch :: Text+ , hashtags :: [Text]+ , subject :: Text+ , status :: GerritChangeStatus+ , mergeable :: Maybe Bool+ , revisions :: M.Map Text (Maybe GerritRevision)+ , current_revision :: Maybe Text+ , number :: Int+ , labels :: M.Map Text GerritDetailedLabel+ , messages :: [GerritChangeMessage]+ , owner :: GerritAuthor+ , created :: GerritTime+ , updated :: GerritTime+ , submitted :: Maybe GerritTime+ , submitter :: Maybe GerritAuthor+ , topic :: Maybe Text+ , insertions :: Int+ , deletions :: Int+ , more_changes :: Maybe Bool+ , work_in_progress :: Maybe Bool+ }+ deriving (Eq, Show, Generic) instance FromJSON GerritChange where- parseJSON = genericParseJSON aesonOptions+ parseJSON = genericParseJSON aesonOptions
src/Gerrit/Data/Event.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE RecordWildCards #-} -- | Gerrit stream event data type-module Gerrit.Data.Event- ( -- * Main event data types+module Gerrit.Data.Event (+ -- * Main event data types EventType (..), Event (..), @@ -39,18 +39,18 @@ getCreatedOn, getEventType, eventName,- )+) where import Control.Monad (mzero)-import Data.Aeson- ( FromJSON (..),+import Data.Aeson (+ FromJSON (..), Options (fieldLabelModifier), Value (Object, String), defaultOptions, genericParseJSON, (.:),- )+ ) import Data.Char (toLower) import Data.Text (Text) import qualified Data.Text as Text@@ -58,7 +58,7 @@ import GHC.Int (Int64) aesonOption :: Text -> Options-aesonOption prefix = defaultOptions {fieldLabelModifier = recordToJson}+aesonOption prefix = defaultOptions{fieldLabelModifier = recordToJson} where recordToJson = updateCase . drop (Text.length prefix) updateCase [] = []@@ -68,318 +68,318 @@ -- Shared types ------------------------------------------------------------------------------- data User = User- { userName :: Maybe Text,- userEmail :: Maybe Text,- userUsername :: Maybe Text- }- deriving (Show, Eq, Generic)+ { userName :: Maybe Text+ , userEmail :: Maybe Text+ , userUsername :: Maybe Text+ }+ deriving (Show, Eq, Generic) instance FromJSON User where- parseJSON = genericParseJSON $ aesonOption "user"+ parseJSON = genericParseJSON $ aesonOption "user" data PatchSet = PatchSet- { patchSetNumber :: Int,- patchSetRef :: Text,- patchSetUploader :: User,- patchsetAuthor :: User- }- deriving (Show, Eq, Generic)+ { patchSetNumber :: Int+ , patchSetRef :: Text+ , patchSetUploader :: User+ , patchsetAuthor :: User+ }+ deriving (Show, Eq, Generic) instance FromJSON PatchSet where- parseJSON = genericParseJSON $ aesonOption "patchSet"+ parseJSON = genericParseJSON $ aesonOption "patchSet" data Change = Change- { changeProject :: Text,- changeBranch :: Text,- changeSubject :: Text,- changeNumber :: Int,- changeUrl :: Text,- changeOwner :: User,- changeWip :: Maybe Bool,- changeTopic :: Maybe Text,- changeCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { changeProject :: Text+ , changeBranch :: Text+ , changeSubject :: Text+ , changeNumber :: Int+ , changeUrl :: Text+ , changeOwner :: User+ , changeWip :: Maybe Bool+ , changeTopic :: Maybe Text+ , changeCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) instance FromJSON Change where- parseJSON = genericParseJSON $ aesonOption "change"+ parseJSON = genericParseJSON $ aesonOption "change" data Ref = Ref- { refOldRev :: Text,- refNewRev :: Text,- refRefName :: Text,- refProject :: Text- }- deriving (Show, Eq, Generic)+ { refOldRev :: Text+ , refNewRev :: Text+ , refRefName :: Text+ , refProject :: Text+ }+ deriving (Show, Eq, Generic) instance FromJSON Ref where- parseJSON = genericParseJSON $ aesonOption "ref"+ parseJSON = genericParseJSON $ aesonOption "ref" ------------------------------------------------------------------------------- -- Individual Event data types ------------------------------------------------------------------------------- data AssigneeChanged = AssigneeChanged- { assigneeChangedChange :: Change,- assigneeChangedChanger :: User,- assigneeChangedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { assigneeChangedChange :: Change+ , assigneeChangedChanger :: User+ , assigneeChangedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ChangeAbandoned = ChangeAbandoned- { changeAbandonedProject :: Text,- changeAbandonedAbandoner :: User,- changeAbandonedChange :: Change,- changeAbandonedPatchSet :: PatchSet,- changeAbandonedReason :: Maybe Text,- changeAbandonedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { changeAbandonedProject :: Text+ , changeAbandonedAbandoner :: User+ , changeAbandonedChange :: Change+ , changeAbandonedPatchSet :: PatchSet+ , changeAbandonedReason :: Maybe Text+ , changeAbandonedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ChangeDeleted = ChangeDeleted- { changeDeletedChange :: Change,- changeDeletedDeleter :: User- }- deriving (Show, Eq, Generic)+ { changeDeletedChange :: Change+ , changeDeletedDeleter :: User+ }+ deriving (Show, Eq, Generic) data ChangeMerged = ChangeMerged- { changeMergedProject :: Text,- changeMergedSubmitter :: User,- changeMergedChange :: Change,- changeMergedPatchSet :: PatchSet,- changeMergedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { changeMergedProject :: Text+ , changeMergedSubmitter :: User+ , changeMergedChange :: Change+ , changeMergedPatchSet :: PatchSet+ , changeMergedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ChangeRestored = ChangeRestored- { changeRestoredChange :: Change,- changeRestoredPatchSet :: PatchSet,- changeRestoredRestorer :: User,- changeRestoredReason :: Maybe Text,- changeRestoredEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { changeRestoredChange :: Change+ , changeRestoredPatchSet :: PatchSet+ , changeRestoredRestorer :: User+ , changeRestoredReason :: Maybe Text+ , changeRestoredEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data CommentAdded = CommentAdded- { commentAddedChange :: Change,- commentAddedPatchSet :: PatchSet,- commentAddedAuthor :: User,- commentAddedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { commentAddedChange :: Change+ , commentAddedPatchSet :: PatchSet+ , commentAddedAuthor :: User+ , commentAddedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data HashtagsChanged = HashtagsChanged- { hashtagsChangedChange :: Change,- hashtagsChangedEditor :: User,- hashtagsChangedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { hashtagsChangedChange :: Change+ , hashtagsChangedEditor :: User+ , hashtagsChangedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ProjectCreated = ProjectCreated- { projectCreatedProjectName :: Text,- projectCreatedHeadName :: Text,- projectCreatedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { projectCreatedProjectName :: Text+ , projectCreatedHeadName :: Text+ , projectCreatedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data PatchsetCreated = PatchsetCreated- { patchsetCreatedUploader :: User,- patchsetCreatedChange :: Change,- patchsetCreatedPatchSet :: PatchSet,- patchsetCreatedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { patchsetCreatedUploader :: User+ , patchsetCreatedChange :: Change+ , patchsetCreatedPatchSet :: PatchSet+ , patchsetCreatedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data RefUpdated = RefUpdated- { refUpdatedSubmitter :: User,- refUpdatedRefUpdate :: Ref,- refUpdatedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { refUpdatedSubmitter :: User+ , refUpdatedRefUpdate :: Ref+ , refUpdatedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ReviewerAdded = ReviewerAdded- { reviewerAddedChange :: Change,- reviewerAddedPatchSet :: PatchSet,- reviewerAddedAdder :: User,- reviewerAddedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { reviewerAddedChange :: Change+ , reviewerAddedPatchSet :: PatchSet+ , reviewerAddedAdder :: User+ , reviewerAddedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data ReviewerDeleted = ReviewerDeleted- { reviewerDeletedChange :: Change,- reviewerDeletedPatchSet :: PatchSet,- reviewerDeletedRemover :: User,- reviewerDeletedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { reviewerDeletedChange :: Change+ , reviewerDeletedPatchSet :: PatchSet+ , reviewerDeletedRemover :: User+ , reviewerDeletedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data TopicChanged = TopicChanged- { topicChangedChange :: Change,- topicChangedChanger :: User,- topicChangedOldTopic :: Text,- topicChangedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { topicChangedChange :: Change+ , topicChangedChanger :: User+ , topicChangedOldTopic :: Text+ , topicChangedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data WorkInProgressStateChanged = WorkInProgressStateChanged- { workInProgressStateChangedChange :: Change,- workInProgressStateChangedPatchSet :: PatchSet,- workInProgressStateChangedChanger :: User,- workInProgressStateChangedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { workInProgressStateChangedChange :: Change+ , workInProgressStateChangedPatchSet :: PatchSet+ , workInProgressStateChangedChanger :: User+ , workInProgressStateChangedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data PrivateStateChanged = PrivateStateChanged- { privateStateChangedChange :: Change,- privateStateChangedPatchSet :: PatchSet,- privateStateChangedChanger :: User,- privateStateChangedChangedEventCreatedOn :: Int64- }- deriving (Show, Eq, Generic)+ { privateStateChangedChange :: Change+ , privateStateChangedPatchSet :: PatchSet+ , privateStateChangedChanger :: User+ , privateStateChangedChangedEventCreatedOn :: Int64+ }+ deriving (Show, Eq, Generic) data VoteDeleted = VoteDeleted- { voteDeletedChange :: Change,- voteDeletedPatchSet :: PatchSet,- voteDeletedRemover :: User- }- deriving (Show, Eq, Generic)+ { voteDeletedChange :: Change+ , voteDeletedPatchSet :: PatchSet+ , voteDeletedRemover :: User+ }+ deriving (Show, Eq, Generic) ------------------------------------------------------------------------------- -- Events FromJSON instances ------------------------------------------------------------------------------- instance FromJSON AssigneeChanged where- parseJSON = genericParseJSON $ aesonOption "assigneeChanged"+ parseJSON = genericParseJSON $ aesonOption "assigneeChanged" instance FromJSON ChangeAbandoned where- parseJSON = genericParseJSON $ aesonOption "changeAbandoned"+ parseJSON = genericParseJSON $ aesonOption "changeAbandoned" instance FromJSON ChangeDeleted where- parseJSON = genericParseJSON $ aesonOption "changeDeleted"+ parseJSON = genericParseJSON $ aesonOption "changeDeleted" instance FromJSON ChangeMerged where- parseJSON = genericParseJSON $ aesonOption "changeMerged"+ parseJSON = genericParseJSON $ aesonOption "changeMerged" instance FromJSON ChangeRestored where- parseJSON = genericParseJSON $ aesonOption "changeRestored"+ parseJSON = genericParseJSON $ aesonOption "changeRestored" instance FromJSON CommentAdded where- parseJSON = genericParseJSON $ aesonOption "commentAdded"+ parseJSON = genericParseJSON $ aesonOption "commentAdded" instance FromJSON HashtagsChanged where- parseJSON = genericParseJSON $ aesonOption "hashtagsChanged"+ parseJSON = genericParseJSON $ aesonOption "hashtagsChanged" instance FromJSON ProjectCreated where- parseJSON = genericParseJSON $ aesonOption "projectCreated"+ parseJSON = genericParseJSON $ aesonOption "projectCreated" instance FromJSON PatchsetCreated where- parseJSON = genericParseJSON $ aesonOption "patchsetCreated"+ parseJSON = genericParseJSON $ aesonOption "patchsetCreated" instance FromJSON RefUpdated where- parseJSON = genericParseJSON $ aesonOption "refUpdated"+ parseJSON = genericParseJSON $ aesonOption "refUpdated" instance FromJSON ReviewerAdded where- parseJSON = genericParseJSON $ aesonOption "reviewerAdded"+ parseJSON = genericParseJSON $ aesonOption "reviewerAdded" instance FromJSON ReviewerDeleted where- parseJSON = genericParseJSON $ aesonOption "reviewerDeleted"+ parseJSON = genericParseJSON $ aesonOption "reviewerDeleted" instance FromJSON TopicChanged where- parseJSON = genericParseJSON $ aesonOption "topicChanged"+ parseJSON = genericParseJSON $ aesonOption "topicChanged" instance FromJSON WorkInProgressStateChanged where- parseJSON = genericParseJSON $ aesonOption "workInProgressStateChanged"+ parseJSON = genericParseJSON $ aesonOption "workInProgressStateChanged" instance FromJSON PrivateStateChanged where- parseJSON = genericParseJSON $ aesonOption "privateStateChanged"+ parseJSON = genericParseJSON $ aesonOption "privateStateChanged" instance FromJSON VoteDeleted where- parseJSON = genericParseJSON $ aesonOption "voteDeleted"+ parseJSON = genericParseJSON $ aesonOption "voteDeleted" -- | The event "type" data type data EventType- = AssigneeChangedEvent- | ChangeAbandonedEvent- | ChangeDeletedEvent- | ChangeMergedEvent- | ChangeRestoredEvent- | CommentAddedEvent- | DroppedOutputEvent- | HashtagsChangedEvent- | ProjectCreatedEvent- | PatchsetCreatedEvent- | RefUpdatedEvent- | ReviewerAddedEvent- | ReviewerDeletedEvent- | TopicChangedEvent- | WorkInProgressStateChangedEvent- | PrivateStateChangedEvent- | VoteDeletedEvent- deriving (Show, Eq)+ = AssigneeChangedEvent+ | ChangeAbandonedEvent+ | ChangeDeletedEvent+ | ChangeMergedEvent+ | ChangeRestoredEvent+ | CommentAddedEvent+ | DroppedOutputEvent+ | HashtagsChangedEvent+ | ProjectCreatedEvent+ | PatchsetCreatedEvent+ | RefUpdatedEvent+ | ReviewerAddedEvent+ | ReviewerDeletedEvent+ | TopicChangedEvent+ | WorkInProgressStateChangedEvent+ | PrivateStateChangedEvent+ | VoteDeletedEvent+ deriving (Show, Eq) instance FromJSON EventType where- parseJSON (String v) = case v of- "assignee-changed" -> pure AssigneeChangedEvent- "change-abandoned" -> pure ChangeAbandonedEvent- "change-deleted" -> pure ChangeDeletedEvent- "change-merged" -> pure ChangeMergedEvent- "change-restored" -> pure ChangeRestoredEvent- "comment-added" -> pure CommentAddedEvent- "dropped-output" -> pure DroppedOutputEvent- "hashtags-changed" -> pure HashtagsChangedEvent- "project-created" -> pure ProjectCreatedEvent- "patchset-created" -> pure PatchsetCreatedEvent- "ref-updated" -> pure RefUpdatedEvent- "reviewer-added" -> pure ReviewerAddedEvent- "reviewer-deleted" -> pure ReviewerDeletedEvent- "topic-changed" -> pure TopicChangedEvent- "wip-state-changed" -> pure WorkInProgressStateChangedEvent- "private-state-changed" -> pure PrivateStateChangedEvent- "vote-deleted" -> pure VoteDeletedEvent- _ -> mzero- parseJSON _ = mzero+ parseJSON (String v) = case v of+ "assignee-changed" -> pure AssigneeChangedEvent+ "change-abandoned" -> pure ChangeAbandonedEvent+ "change-deleted" -> pure ChangeDeletedEvent+ "change-merged" -> pure ChangeMergedEvent+ "change-restored" -> pure ChangeRestoredEvent+ "comment-added" -> pure CommentAddedEvent+ "dropped-output" -> pure DroppedOutputEvent+ "hashtags-changed" -> pure HashtagsChangedEvent+ "project-created" -> pure ProjectCreatedEvent+ "patchset-created" -> pure PatchsetCreatedEvent+ "ref-updated" -> pure RefUpdatedEvent+ "reviewer-added" -> pure ReviewerAddedEvent+ "reviewer-deleted" -> pure ReviewerDeletedEvent+ "topic-changed" -> pure TopicChangedEvent+ "wip-state-changed" -> pure WorkInProgressStateChangedEvent+ "private-state-changed" -> pure PrivateStateChangedEvent+ "vote-deleted" -> pure VoteDeletedEvent+ _ -> mzero+ parseJSON _ = mzero -- | The main event union data type data Event- = EventAssigneeChanged AssigneeChanged- | EventChangeAbandoned ChangeAbandoned- | EventChangeDeleted ChangeDeleted- | EventChangeMerged ChangeMerged- | EventChangeRestored ChangeRestored- | EventCommentAdded CommentAdded- | EventDroppedOutput- | EventHashtagsChanged HashtagsChanged- | EventProjectCreated ProjectCreated- | EventPatchsetCreated PatchsetCreated- | EventRefUpdated RefUpdated- | EventReviewerAdded ReviewerAdded- | EventReviewerDeleted ReviewerDeleted- | EventTopicChanged TopicChanged- | EventWorkInProgressStateChanged WorkInProgressStateChanged- | EventPrivateStateChanged PrivateStateChanged- | EventVoteDeleted VoteDeleted- deriving (Show, Eq)+ = EventAssigneeChanged AssigneeChanged+ | EventChangeAbandoned ChangeAbandoned+ | EventChangeDeleted ChangeDeleted+ | EventChangeMerged ChangeMerged+ | EventChangeRestored ChangeRestored+ | EventCommentAdded CommentAdded+ | EventDroppedOutput+ | EventHashtagsChanged HashtagsChanged+ | EventProjectCreated ProjectCreated+ | EventPatchsetCreated PatchsetCreated+ | EventRefUpdated RefUpdated+ | EventReviewerAdded ReviewerAdded+ | EventReviewerDeleted ReviewerDeleted+ | EventTopicChanged TopicChanged+ | EventWorkInProgressStateChanged WorkInProgressStateChanged+ | EventPrivateStateChanged PrivateStateChanged+ | EventVoteDeleted VoteDeleted+ deriving (Show, Eq) instance FromJSON Event where- parseJSON o@(Object v) = do- eType <- v .: "type"- case eType of- AssigneeChangedEvent -> EventAssigneeChanged <$> parseJSON o- ChangeAbandonedEvent -> EventChangeAbandoned <$> parseJSON o- ChangeDeletedEvent -> EventChangeDeleted <$> parseJSON o- ChangeMergedEvent -> EventChangeMerged <$> parseJSON o- ChangeRestoredEvent -> EventChangeRestored <$> parseJSON o- CommentAddedEvent -> EventCommentAdded <$> parseJSON o- DroppedOutputEvent -> pure EventDroppedOutput- HashtagsChangedEvent -> EventHashtagsChanged <$> parseJSON o- ProjectCreatedEvent -> EventProjectCreated <$> parseJSON o- PatchsetCreatedEvent -> EventPatchsetCreated <$> parseJSON o- RefUpdatedEvent -> EventRefUpdated <$> parseJSON o- ReviewerAddedEvent -> EventReviewerAdded <$> parseJSON o- ReviewerDeletedEvent -> EventReviewerDeleted <$> parseJSON o- TopicChangedEvent -> EventTopicChanged <$> parseJSON o- WorkInProgressStateChangedEvent -> EventWorkInProgressStateChanged <$> parseJSON o- PrivateStateChangedEvent -> EventPrivateStateChanged <$> parseJSON o- VoteDeletedEvent -> EventVoteDeleted <$> parseJSON o- parseJSON _ = mzero+ parseJSON o@(Object v) = do+ eType <- v .: "type"+ case eType of+ AssigneeChangedEvent -> EventAssigneeChanged <$> parseJSON o+ ChangeAbandonedEvent -> EventChangeAbandoned <$> parseJSON o+ ChangeDeletedEvent -> EventChangeDeleted <$> parseJSON o+ ChangeMergedEvent -> EventChangeMerged <$> parseJSON o+ ChangeRestoredEvent -> EventChangeRestored <$> parseJSON o+ CommentAddedEvent -> EventCommentAdded <$> parseJSON o+ DroppedOutputEvent -> pure EventDroppedOutput+ HashtagsChangedEvent -> EventHashtagsChanged <$> parseJSON o+ ProjectCreatedEvent -> EventProjectCreated <$> parseJSON o+ PatchsetCreatedEvent -> EventPatchsetCreated <$> parseJSON o+ RefUpdatedEvent -> EventRefUpdated <$> parseJSON o+ ReviewerAddedEvent -> EventReviewerAdded <$> parseJSON o+ ReviewerDeletedEvent -> EventReviewerDeleted <$> parseJSON o+ TopicChangedEvent -> EventTopicChanged <$> parseJSON o+ WorkInProgressStateChangedEvent -> EventWorkInProgressStateChanged <$> parseJSON o+ PrivateStateChangedEvent -> EventPrivateStateChanged <$> parseJSON o+ VoteDeletedEvent -> EventVoteDeleted <$> parseJSON o+ parseJSON _ = mzero ------------------------------------------------------------------------------- -- Utilities function@@ -388,125 +388,125 @@ -- | Get the associated change getChange :: Event -> Maybe Change getChange event = case event of- EventAssigneeChanged AssigneeChanged {..} -> Just assigneeChangedChange- EventChangeAbandoned ChangeAbandoned {..} -> Just changeAbandonedChange- EventChangeDeleted ChangeDeleted {..} -> Just changeDeletedChange- EventChangeMerged ChangeMerged {..} -> Just changeMergedChange- EventChangeRestored ChangeRestored {..} -> Just changeRestoredChange- EventCommentAdded CommentAdded {..} -> Just commentAddedChange- EventDroppedOutput -> Nothing- EventHashtagsChanged HashtagsChanged {..} -> Just hashtagsChangedChange- EventProjectCreated _ -> Nothing- EventPatchsetCreated PatchsetCreated {..} -> Just patchsetCreatedChange- EventRefUpdated _ -> Nothing- EventReviewerAdded ReviewerAdded {..} -> Just reviewerAddedChange- EventReviewerDeleted ReviewerDeleted {..} -> Just reviewerDeletedChange- EventTopicChanged TopicChanged {..} -> Just topicChangedChange- EventWorkInProgressStateChanged WorkInProgressStateChanged {..} -> Just workInProgressStateChangedChange- EventPrivateStateChanged PrivateStateChanged {..} -> Just privateStateChangedChange- EventVoteDeleted VoteDeleted {..} -> Just voteDeletedChange+ EventAssigneeChanged AssigneeChanged{..} -> Just assigneeChangedChange+ EventChangeAbandoned ChangeAbandoned{..} -> Just changeAbandonedChange+ EventChangeDeleted ChangeDeleted{..} -> Just changeDeletedChange+ EventChangeMerged ChangeMerged{..} -> Just changeMergedChange+ EventChangeRestored ChangeRestored{..} -> Just changeRestoredChange+ EventCommentAdded CommentAdded{..} -> Just commentAddedChange+ EventDroppedOutput -> Nothing+ EventHashtagsChanged HashtagsChanged{..} -> Just hashtagsChangedChange+ EventProjectCreated _ -> Nothing+ EventPatchsetCreated PatchsetCreated{..} -> Just patchsetCreatedChange+ EventRefUpdated _ -> Nothing+ EventReviewerAdded ReviewerAdded{..} -> Just reviewerAddedChange+ EventReviewerDeleted ReviewerDeleted{..} -> Just reviewerDeletedChange+ EventTopicChanged TopicChanged{..} -> Just topicChangedChange+ EventWorkInProgressStateChanged WorkInProgressStateChanged{..} -> Just workInProgressStateChangedChange+ EventPrivateStateChanged PrivateStateChanged{..} -> Just privateStateChangedChange+ EventVoteDeleted VoteDeleted{..} -> Just voteDeletedChange -- | Get the associated patchset getPatchSet :: Event -> Maybe PatchSet getPatchSet event = case event of- EventAssigneeChanged _ -> Nothing- EventChangeAbandoned ChangeAbandoned {..} -> Just changeAbandonedPatchSet- EventChangeDeleted _ -> Nothing- EventChangeMerged ChangeMerged {..} -> Just changeMergedPatchSet- EventChangeRestored ChangeRestored {..} -> Just changeRestoredPatchSet- EventCommentAdded CommentAdded {..} -> Just commentAddedPatchSet- EventDroppedOutput -> Nothing- EventHashtagsChanged _ -> Nothing- EventProjectCreated _ -> Nothing- EventPatchsetCreated PatchsetCreated {..} -> Just patchsetCreatedPatchSet- EventRefUpdated _ -> Nothing- EventReviewerAdded ReviewerAdded {..} -> Just reviewerAddedPatchSet- EventReviewerDeleted ReviewerDeleted {..} -> Just reviewerDeletedPatchSet- EventTopicChanged _ -> Nothing- EventWorkInProgressStateChanged WorkInProgressStateChanged {..} -> Just workInProgressStateChangedPatchSet- EventPrivateStateChanged PrivateStateChanged {..} -> Just privateStateChangedPatchSet- EventVoteDeleted VoteDeleted {..} -> Just voteDeletedPatchSet+ EventAssigneeChanged _ -> Nothing+ EventChangeAbandoned ChangeAbandoned{..} -> Just changeAbandonedPatchSet+ EventChangeDeleted _ -> Nothing+ EventChangeMerged ChangeMerged{..} -> Just changeMergedPatchSet+ EventChangeRestored ChangeRestored{..} -> Just changeRestoredPatchSet+ EventCommentAdded CommentAdded{..} -> Just commentAddedPatchSet+ EventDroppedOutput -> Nothing+ EventHashtagsChanged _ -> Nothing+ EventProjectCreated _ -> Nothing+ EventPatchsetCreated PatchsetCreated{..} -> Just patchsetCreatedPatchSet+ EventRefUpdated _ -> Nothing+ EventReviewerAdded ReviewerAdded{..} -> Just reviewerAddedPatchSet+ EventReviewerDeleted ReviewerDeleted{..} -> Just reviewerDeletedPatchSet+ EventTopicChanged _ -> Nothing+ EventWorkInProgressStateChanged WorkInProgressStateChanged{..} -> Just workInProgressStateChangedPatchSet+ EventPrivateStateChanged PrivateStateChanged{..} -> Just privateStateChangedPatchSet+ EventVoteDeleted VoteDeleted{..} -> Just voteDeletedPatchSet -- | Get the associated author getUser :: Event -> Maybe User getUser event = case event of- EventAssigneeChanged AssigneeChanged {..} -> Just assigneeChangedChanger- EventChangeAbandoned ChangeAbandoned {..} -> Just changeAbandonedAbandoner- EventChangeDeleted ChangeDeleted {..} -> Just changeDeletedDeleter- EventChangeMerged ChangeMerged {..} -> Just changeMergedSubmitter- EventChangeRestored ChangeRestored {..} -> Just changeRestoredRestorer- EventCommentAdded CommentAdded {..} -> Just commentAddedAuthor- EventDroppedOutput -> Nothing- EventHashtagsChanged HashtagsChanged {..} -> Just hashtagsChangedEditor- EventProjectCreated _ -> Nothing- EventPatchsetCreated PatchsetCreated {..} -> Just patchsetCreatedUploader- EventRefUpdated _ -> Nothing- EventReviewerAdded ReviewerAdded {..} -> Just reviewerAddedAdder- EventReviewerDeleted ReviewerDeleted {..} -> Just reviewerDeletedRemover- EventTopicChanged TopicChanged {..} -> Just topicChangedChanger- EventWorkInProgressStateChanged WorkInProgressStateChanged {..} -> Just workInProgressStateChangedChanger- EventPrivateStateChanged PrivateStateChanged {..} -> Just privateStateChangedChanger- EventVoteDeleted VoteDeleted {..} -> Just voteDeletedRemover+ EventAssigneeChanged AssigneeChanged{..} -> Just assigneeChangedChanger+ EventChangeAbandoned ChangeAbandoned{..} -> Just changeAbandonedAbandoner+ EventChangeDeleted ChangeDeleted{..} -> Just changeDeletedDeleter+ EventChangeMerged ChangeMerged{..} -> Just changeMergedSubmitter+ EventChangeRestored ChangeRestored{..} -> Just changeRestoredRestorer+ EventCommentAdded CommentAdded{..} -> Just commentAddedAuthor+ EventDroppedOutput -> Nothing+ EventHashtagsChanged HashtagsChanged{..} -> Just hashtagsChangedEditor+ EventProjectCreated _ -> Nothing+ EventPatchsetCreated PatchsetCreated{..} -> Just patchsetCreatedUploader+ EventRefUpdated _ -> Nothing+ EventReviewerAdded ReviewerAdded{..} -> Just reviewerAddedAdder+ EventReviewerDeleted ReviewerDeleted{..} -> Just reviewerDeletedRemover+ EventTopicChanged TopicChanged{..} -> Just topicChangedChanger+ EventWorkInProgressStateChanged WorkInProgressStateChanged{..} -> Just workInProgressStateChangedChanger+ EventPrivateStateChanged PrivateStateChanged{..} -> Just privateStateChangedChanger+ EventVoteDeleted VoteDeleted{..} -> Just voteDeletedRemover -- | Get the creation timestamp getCreatedOn :: Event -> Maybe Int64 getCreatedOn event = case event of- EventAssigneeChanged AssigneeChanged {..} -> Just assigneeChangedEventCreatedOn- EventChangeAbandoned ChangeAbandoned {..} -> Just changeAbandonedEventCreatedOn- EventChangeDeleted _ -> Nothing- EventChangeMerged ChangeMerged {..} -> Just changeMergedEventCreatedOn- EventChangeRestored ChangeRestored {..} -> Just changeRestoredEventCreatedOn- EventCommentAdded CommentAdded {..} -> Just commentAddedEventCreatedOn- EventDroppedOutput -> Nothing- EventHashtagsChanged HashtagsChanged {..} -> Just hashtagsChangedEventCreatedOn- EventProjectCreated ProjectCreated {..} -> Just projectCreatedEventCreatedOn- EventPatchsetCreated PatchsetCreated {..} -> Just patchsetCreatedEventCreatedOn- EventRefUpdated RefUpdated {..} -> Just refUpdatedEventCreatedOn- EventReviewerAdded ReviewerAdded {..} -> Just reviewerAddedEventCreatedOn- EventReviewerDeleted ReviewerDeleted {..} -> Just reviewerDeletedEventCreatedOn- EventTopicChanged TopicChanged {..} -> Just topicChangedEventCreatedOn- EventWorkInProgressStateChanged WorkInProgressStateChanged {..} -> Just workInProgressStateChangedEventCreatedOn- EventPrivateStateChanged PrivateStateChanged {..} -> Just privateStateChangedChangedEventCreatedOn- EventVoteDeleted _ -> Nothing+ EventAssigneeChanged AssigneeChanged{..} -> Just assigneeChangedEventCreatedOn+ EventChangeAbandoned ChangeAbandoned{..} -> Just changeAbandonedEventCreatedOn+ EventChangeDeleted _ -> Nothing+ EventChangeMerged ChangeMerged{..} -> Just changeMergedEventCreatedOn+ EventChangeRestored ChangeRestored{..} -> Just changeRestoredEventCreatedOn+ EventCommentAdded CommentAdded{..} -> Just commentAddedEventCreatedOn+ EventDroppedOutput -> Nothing+ EventHashtagsChanged HashtagsChanged{..} -> Just hashtagsChangedEventCreatedOn+ EventProjectCreated ProjectCreated{..} -> Just projectCreatedEventCreatedOn+ EventPatchsetCreated PatchsetCreated{..} -> Just patchsetCreatedEventCreatedOn+ EventRefUpdated RefUpdated{..} -> Just refUpdatedEventCreatedOn+ EventReviewerAdded ReviewerAdded{..} -> Just reviewerAddedEventCreatedOn+ EventReviewerDeleted ReviewerDeleted{..} -> Just reviewerDeletedEventCreatedOn+ EventTopicChanged TopicChanged{..} -> Just topicChangedEventCreatedOn+ EventWorkInProgressStateChanged WorkInProgressStateChanged{..} -> Just workInProgressStateChangedEventCreatedOn+ EventPrivateStateChanged PrivateStateChanged{..} -> Just privateStateChangedChangedEventCreatedOn+ EventVoteDeleted _ -> Nothing -- | Get the 'EventType' back from an 'Event' getEventType :: Event -> EventType getEventType event = case event of- EventAssigneeChanged _ -> AssigneeChangedEvent- EventChangeAbandoned _ -> ChangeAbandonedEvent- EventChangeDeleted _ -> ChangeDeletedEvent- EventChangeMerged _ -> ChangeMergedEvent- EventChangeRestored _ -> ChangeRestoredEvent- EventCommentAdded _ -> CommentAddedEvent- EventDroppedOutput -> DroppedOutputEvent- EventHashtagsChanged _ -> HashtagsChangedEvent- EventProjectCreated _ -> ProjectCreatedEvent- EventPatchsetCreated _ -> PatchsetCreatedEvent- EventRefUpdated _ -> RefUpdatedEvent- EventReviewerAdded _ -> ReviewerAddedEvent- EventReviewerDeleted _ -> ReviewerDeletedEvent- EventTopicChanged _ -> TopicChangedEvent- EventWorkInProgressStateChanged _ -> WorkInProgressStateChangedEvent- EventPrivateStateChanged _ -> PrivateStateChangedEvent- EventVoteDeleted _ -> VoteDeletedEvent+ EventAssigneeChanged _ -> AssigneeChangedEvent+ EventChangeAbandoned _ -> ChangeAbandonedEvent+ EventChangeDeleted _ -> ChangeDeletedEvent+ EventChangeMerged _ -> ChangeMergedEvent+ EventChangeRestored _ -> ChangeRestoredEvent+ EventCommentAdded _ -> CommentAddedEvent+ EventDroppedOutput -> DroppedOutputEvent+ EventHashtagsChanged _ -> HashtagsChangedEvent+ EventProjectCreated _ -> ProjectCreatedEvent+ EventPatchsetCreated _ -> PatchsetCreatedEvent+ EventRefUpdated _ -> RefUpdatedEvent+ EventReviewerAdded _ -> ReviewerAddedEvent+ EventReviewerDeleted _ -> ReviewerDeletedEvent+ EventTopicChanged _ -> TopicChangedEvent+ EventWorkInProgressStateChanged _ -> WorkInProgressStateChangedEvent+ EventPrivateStateChanged _ -> PrivateStateChangedEvent+ EventVoteDeleted _ -> VoteDeletedEvent -- | Get the text representation suitable for event subscription. eventName :: EventType -> Text eventName eventType = case eventType of- AssigneeChangedEvent -> "assignee-changed"- ChangeAbandonedEvent -> "change-abandoned"- ChangeDeletedEvent -> "change-deleted"- ChangeMergedEvent -> "change-merged"- ChangeRestoredEvent -> "change-restored"- CommentAddedEvent -> "comment-added"- DroppedOutputEvent -> "dropped-output"- HashtagsChangedEvent -> "hashtags-changed"- ProjectCreatedEvent -> "project-created"- PatchsetCreatedEvent -> "patchset-created"- RefUpdatedEvent -> "ref-updated"- ReviewerAddedEvent -> "reviewer-added"- ReviewerDeletedEvent -> "reviewer-deleted"- TopicChangedEvent -> "topic-changed"- WorkInProgressStateChangedEvent -> "wip-state-changed"- PrivateStateChangedEvent -> "private-state-changed"- VoteDeletedEvent -> "vote-deleted"+ AssigneeChangedEvent -> "assignee-changed"+ ChangeAbandonedEvent -> "change-abandoned"+ ChangeDeletedEvent -> "change-deleted"+ ChangeMergedEvent -> "change-merged"+ ChangeRestoredEvent -> "change-restored"+ CommentAddedEvent -> "comment-added"+ DroppedOutputEvent -> "dropped-output"+ HashtagsChangedEvent -> "hashtags-changed"+ ProjectCreatedEvent -> "project-created"+ PatchsetCreatedEvent -> "patchset-created"+ RefUpdatedEvent -> "ref-updated"+ ReviewerAddedEvent -> "reviewer-added"+ ReviewerDeletedEvent -> "reviewer-deleted"+ TopicChangedEvent -> "topic-changed"+ WorkInProgressStateChangedEvent -> "wip-state-changed"+ PrivateStateChangedEvent -> "private-state-changed"+ VoteDeletedEvent -> "vote-deleted"
src/Gerrit/Data/Project.hs view
@@ -2,12 +2,12 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} -module Gerrit.Data.Project- ( GerritProjectInfo (..),+module Gerrit.Data.Project (+ GerritProjectInfo (..), GerritProjectQuery (..), projectQS, GerritProjectsMessage,- )+) where import Data.Aeson@@ -17,7 +17,7 @@ import GHC.Generics (Generic) data GerritProjectQuery = Regexp Text | Prefix Text- deriving (Eq, Show)+ deriving (Eq, Show) queryText :: GerritProjectQuery -> Text queryText (Regexp re) = "r=" <> re@@ -27,17 +27,17 @@ -- "r:test/.*|rpms/.*&n=10" projectQS :: Int -> GerritProjectQuery -> Maybe Int -> Text projectQS count query startM =- intercalate "&" [qtString, countString] <> startString+ intercalate "&" [qtString, countString] <> startString where qtString = queryText query countString = "n=" <> pack (show count) startString = maybe mempty (\s -> "&S=" <> pack (show s)) startM newtype GerritProjectInfo = GerritProjectInfo- {gerritprojectinfoId :: Text}- deriving (Eq, Show, Generic)+ {gerritprojectinfoId :: Text}+ deriving (Eq, Show, Generic) type GerritProjectsMessage = Map Text GerritProjectInfo instance FromJSON GerritProjectInfo where- parseJSON = genericParseJSON $ aesonPrefix snakeCase+ parseJSON = genericParseJSON $ aesonPrefix snakeCase
src/Gerrit/Data/Review.hs view
@@ -4,14 +4,14 @@ {-# LANGUAGE OverloadedStrings #-} -- | This module contains the gerrit data type-module Gerrit.Data.Review- ( GerritVersion (..),+module Gerrit.Data.Review (+ GerritVersion (..), GerritLabel (..), GerritReviewAccount (..), GerritLabelVote (..), ReviewResult (..), ReviewInput (..),- )+) where import Data.Aeson@@ -21,67 +21,68 @@ import GHC.Generics (Generic) newtype GerritVersion = GerritVersion Text- deriving (Show, Generic)- deriving anyclass (FromJSON)+ deriving (Show, Generic)+ deriving anyclass (FromJSON) data GerritLabelVote = REJECTED | APPROVED | DISLIKED | RECOMMENDED- deriving (Eq, Show, Ord, Generic)+ deriving (Eq, Show, Ord, Generic) -- We use a custom parseJSON to decode Label Vote as lowercase instance FromJSON GerritLabelVote where- parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = map toLower}+ parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = map toLower} instance FromJSONKey GerritLabelVote where- fromJSONKey = genericFromJSONKey defaultJSONKeyOptions {keyModifier = map toLower}+ fromJSONKey = genericFromJSONKey defaultJSONKeyOptions{keyModifier = map toLower} --- | Modify record attribute to match json schema--- Remove the prefix and use snakecase+{- | Modify record attribute to match json schema+Remove the prefix and use snakecase+-} customParseJSON :: String -> Options-customParseJSON prefix = defaultOptions {fieldLabelModifier = recordToJson}+customParseJSON prefix = defaultOptions{fieldLabelModifier = recordToJson} where recordToJson = updateCase . drop (length prefix) updateCase [] = [] updateCase (x : xs) = toLower x : updateCase' xs updateCase' [] = [] updateCase' (x : xs)- | isUpper x = '_' : toLower x : updateCase' xs- | otherwise = x : updateCase' xs+ | isUpper x = '_' : toLower x : updateCase' xs+ | otherwise = x : updateCase' xs -- https://gerrit-review.googlesource.com/Documentation/rest-api-changes.html data ReviewResult = ReviewResult- { rrLabels :: Maybe (M.Map Text Int),- rrReady :: Maybe Int- }- deriving (Eq, Show, Ord, Generic)+ { rrLabels :: Maybe (M.Map Text Int)+ , rrReady :: Maybe Int+ }+ deriving (Eq, Show, Ord, Generic) instance FromJSON ReviewResult where- parseJSON = genericParseJSON $ customParseJSON "rr"+ parseJSON = genericParseJSON $ customParseJSON "rr" instance ToJSON ReviewResult where- toJSON = genericToJSON $ customParseJSON "rr"+ toJSON = genericToJSON $ customParseJSON "rr" data ReviewInput = ReviewInput- { riMessage :: Maybe Text,- riLabels :: Maybe (M.Map Text Int)- }- deriving (Eq, Show, Ord, Generic)+ { riMessage :: Maybe Text+ , riLabels :: Maybe (M.Map Text Int)+ }+ deriving (Eq, Show, Ord, Generic) instance FromJSON ReviewInput where- parseJSON = genericParseJSON $ customParseJSON "ri"+ parseJSON = genericParseJSON $ customParseJSON "ri" instance ToJSON ReviewInput where- toJSON = genericToJSON $ (customParseJSON "ri") {omitNothingFields = True}+ toJSON = genericToJSON $ (customParseJSON "ri"){omitNothingFields = True} newtype GerritReviewAccount = GerritReviewAccount- { unused_account_id :: Int- }- deriving (Show, Generic)+ { unused_account_id :: Int+ }+ deriving (Show, Generic) -- We use a cusom parseJSON to decode `_account_id` as `account_id` instance FromJSON GerritReviewAccount where- parseJSON = genericParseJSON defaultOptions+ parseJSON = genericParseJSON defaultOptions newtype GerritLabel- = GerritLabel (M.Map GerritLabelVote GerritReviewAccount)- deriving (Show, Generic)- deriving anyclass (FromJSON)+ = GerritLabel (M.Map GerritLabelVote GerritReviewAccount)+ deriving (Show, Generic)+ deriving anyclass (FromJSON)
test/Spec.hs view
@@ -17,72 +17,90 @@ main :: IO () main =- do- files' <- listDirectory "./test/data"- dataFiles <- traverse (BSL.readFile . ("./test/data/" <>)) files'- withClient "http://example.com/r" Nothing $ \client ->- defaultMain (tests (zip files' dataFiles) client)+ do+ files' <- listDirectory "./test/data"+ dataFiles <- traverse (BSL.readFile . ("./test/data/" <>)) files'+ withClient "http://example.com/r" Nothing $ \client ->+ defaultMain (tests (zip files' dataFiles) client) tests :: [(FilePath, ByteString)] -> GerritClient -> TestTree tests dataFiles client = testGroup "Tests" $ [unitTests] <> encodingTests dataFiles client unitTests :: TestTree unitTests =- testGroup- "unitTests"- [ testCase "queryString status" $- assertEqual "Query string is valid" "status:new" (queryText (Status NEW)),- testCase "changeQS w/o start" $- assertEqual "Change query is valid" expected1 (changeQS 10 [Project "gerrit-haskell"] Nothing),- testCase "changeQS with start" $- assertEqual "Change query is valid" expected2 (changeQS 10 [Project "gerrit-haskell"] (Just 100))- ]+ testGroup+ "unitTests"+ [ testCase "queryString status" $+ assertEqual "Query string is valid" "status:new" (queryText (Status NEW))+ , testCase "changeQS w/o start" $+ assertEqual "Change query is valid" expected1 (changeQS 10 [Project "gerrit-haskell"] Nothing)+ , testCase "changeQS with start" $+ assertEqual "Change query is valid" expected2 (changeQS 10 [Project "gerrit-haskell"] (Just 100))+ ] where expected1 = "q=project:gerrit-haskell&n=10&o=MESSAGES&o=DETAILED_ACCOUNTS&o=DETAILED_LABELS&o=CURRENT_REVISION&o=CURRENT_FILES&o=CURRENT_COMMIT" expected2 = "q=project:gerrit-haskell&n=10&o=MESSAGES&o=DETAILED_ACCOUNTS&o=DETAILED_LABELS&o=CURRENT_REVISION&o=CURRENT_FILES&o=CURRENT_COMMIT&start=100" encodingTests :: [(FilePath, ByteString)] -> GerritClient -> [TestTree] encodingTests dataFiles client =- [ testGroup- "FromJSON"- [ testCase "Test GerritChange.json" $- assertBool "GerritChange is decoded" $- isChange $ decode $ getRaw "GerritChange.json",- testCase "Test EventPatchsetCreated.json" $- assertBool "EventPatchsetCreated is decoded" $- isEventPatchsetCreated $ decode $ getRaw "EventPatchsetCreated.json",- testCase "Test EventChangeMerged.json" $- assertBool "EventChangeMerged is decoded" $- isChangeMergedEvent $ decode $ getRaw "EventChangeMerged.json",- testCase "Test EventCommentAdded.json" $- assertBool "EventCommentAdded is decoded" $- isCommentEvent $ decode $ getRaw "EventCommentAdded.json",- testCase "Test EventChangeAbandoned.json" $- assertBool "EventChangeAbandoned is decoded" $- isAbandonedEvent $ decode $ getRaw "EventChangeAbandoned.json",- testCase "Test EventProjectCreated.json" $- assertBool "EventProjectCreated is decoded" $- isEventProjectCreated $ decode $ getRaw "EventProjectCreated.json",- testCase "Test EventRefUpdated.json" $- assertBool "EventRefUpdated is decoded" $- isEventRefUpdated $ decode $ getRaw "EventRefUpdated.json",- testCase "Test EventWipStateChanged.json" $- assertBool "EventWipStateChanged is decoded" $- isEventWIPChanged $ decode $ getRaw "EventWipStateChanged.json",- testCase "Test ReviewResult.json" $- assertBool "ReviewResult is decoded" $- isReviewResult $ decode $ getRaw "ReviewResult.json",- testCase "Test changeUrl works" $- assertEqual "Change url is correct" "http://example.com/r/18839" testGetUrl,- testCase "Test hasLabel works" $- assertBool "Label not found" testIsApproved- ],- testGroup- "toJSON"- [ testCase "Test ReviewInput.json" $- assertEqual "Review is encoded" (getRaw "ReviewInput.json") (prettyEncode reviewInput)- ]- ]+ [ testGroup+ "FromJSON"+ [ testCase "Test GerritChange.json" $+ assertBool "GerritChange is decoded" $+ isChange $+ decode $+ getRaw "GerritChange.json"+ , testCase "Test EventPatchsetCreated.json" $+ assertBool "EventPatchsetCreated is decoded" $+ isEventPatchsetCreated $+ decode $+ getRaw "EventPatchsetCreated.json"+ , testCase "Test EventChangeMerged.json" $+ assertBool "EventChangeMerged is decoded" $+ isChangeMergedEvent $+ decode $+ getRaw "EventChangeMerged.json"+ , testCase "Test EventCommentAdded.json" $+ assertBool "EventCommentAdded is decoded" $+ isCommentEvent $+ decode $+ getRaw "EventCommentAdded.json"+ , testCase "Test EventChangeAbandoned.json" $+ assertBool "EventChangeAbandoned is decoded" $+ isAbandonedEvent $+ decode $+ getRaw "EventChangeAbandoned.json"+ , testCase "Test EventProjectCreated.json" $+ assertBool "EventProjectCreated is decoded" $+ isEventProjectCreated $+ decode $+ getRaw "EventProjectCreated.json"+ , testCase "Test EventRefUpdated.json" $+ assertBool "EventRefUpdated is decoded" $+ isEventRefUpdated $+ decode $+ getRaw "EventRefUpdated.json"+ , testCase "Test EventWipStateChanged.json" $+ assertBool "EventWipStateChanged is decoded" $+ isEventWIPChanged $+ decode $+ getRaw "EventWipStateChanged.json"+ , testCase "Test ReviewResult.json" $+ assertBool "ReviewResult is decoded" $+ isReviewResult $+ decode $+ getRaw "ReviewResult.json"+ , testCase "Test changeUrl works" $+ assertEqual "Change url is correct" "http://example.com/r/18839" testGetUrl+ , testCase "Test hasLabel works" $+ assertBool "Label not found" testIsApproved+ ]+ , testGroup+ "toJSON"+ [ testCase "Test ReviewInput.json" $+ assertEqual "Review is encoded" (getRaw "ReviewInput.json") (prettyEncode reviewInput)+ ]+ ] where prettyEncode obj = encode obj <> "\n" reviewInput = ReviewInput (Just "Thanks!") Nothing@@ -90,36 +108,36 @@ getRaw fp = fromJust $ lookup fp dataFiles isReviewResult :: Maybe ReviewResult -> Bool isReviewResult = \case- Just _ -> True- Nothing -> False+ Just _ -> True+ Nothing -> False isChangeMergedEvent = \case- Just (Event.EventChangeMerged _) -> True- _ -> False+ Just (Event.EventChangeMerged _) -> True+ _ -> False isEventPatchsetCreated = \case- Just (Event.EventPatchsetCreated _) -> True- _ -> False+ Just (Event.EventPatchsetCreated _) -> True+ _ -> False isCommentEvent = \case- Just (Event.EventCommentAdded _) -> True- _ -> False+ Just (Event.EventCommentAdded _) -> True+ _ -> False isAbandonedEvent = \case- Just (Event.EventChangeAbandoned _) -> True- _ -> False+ Just (Event.EventChangeAbandoned _) -> True+ _ -> False isEventProjectCreated = \case- Just (Event.EventProjectCreated _) -> True- _ -> False+ Just (Event.EventProjectCreated _) -> True+ _ -> False isEventRefUpdated = \case- Just (Event.EventRefUpdated _) -> True- _ -> False+ Just (Event.EventRefUpdated _) -> True+ _ -> False isEventWIPChanged = \case- Just (Event.EventWorkInProgressStateChanged _) -> True- _ -> False+ Just (Event.EventWorkInProgressStateChanged _) -> True+ _ -> False isChange :: Maybe GerritChange -> Bool isChange = \case- Just _ -> True- Nothing -> False+ Just _ -> True+ Nothing -> False testIsApproved = case decode (getRaw "GerritChange.json") of- Just change -> hasLabel "Code-Review" 2 change- Nothing -> False+ Just change -> hasLabel "Code-Review" 2 change+ Nothing -> False testGetUrl = case decode (getRaw "GerritChange.json") of- Just change -> changeUrl client change- Nothing -> "decode-failed"+ Just change -> changeUrl client change+ Nothing -> "decode-failed"