diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/gerrit.cabal b/gerrit.cabal --- a/gerrit.cabal +++ b/gerrit.cabal @@ -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 diff --git a/src/Gerrit.hs b/src/Gerrit.hs --- a/src/Gerrit.hs +++ b/src/Gerrit.hs @@ -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] diff --git a/src/Gerrit/Client.hs b/src/Gerrit/Client.hs --- a/src/Gerrit/Client.hs +++ b/src/Gerrit/Client.hs @@ -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 diff --git a/src/Gerrit/Data/Account.hs b/src/Gerrit/Data/Account.hs --- a/src/Gerrit/Data/Account.hs +++ b/src/Gerrit/Data/Account.hs @@ -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 diff --git a/src/Gerrit/Data/Change.hs b/src/Gerrit/Data/Change.hs --- a/src/Gerrit/Data/Change.hs +++ b/src/Gerrit/Data/Change.hs @@ -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 diff --git a/src/Gerrit/Data/Event.hs b/src/Gerrit/Data/Event.hs --- a/src/Gerrit/Data/Event.hs +++ b/src/Gerrit/Data/Event.hs @@ -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" diff --git a/src/Gerrit/Data/Project.hs b/src/Gerrit/Data/Project.hs --- a/src/Gerrit/Data/Project.hs +++ b/src/Gerrit/Data/Project.hs @@ -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 diff --git a/src/Gerrit/Data/Review.hs b/src/Gerrit/Data/Review.hs --- a/src/Gerrit/Data/Review.hs +++ b/src/Gerrit/Data/Review.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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"