Split data types in proper modules

Change-Id: Idea7bda38ab6f913d23205a642b7a77136162cd6

Author: morucci

.gitignore

@@ -0,0 +1 @@
+dist-newstyle/

gerrit.cabal

@@ -54,8 +54,10 @@ library
 
   hs-source-dirs:      src
   exposed-modules:     Gerrit
-                     , Gerrit.Data
-                     , Gerrit.Event
+                     , Gerrit.Data.Review
+                     , Gerrit.Data.Change
+                     , Gerrit.Data.Account
+                     , Gerrit.Data.Event
   other-modules:       Gerrit.Client
 
 test-suite gerrit-test

src/Gerrit.hs

@@ -36,7 +36,9 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Gerrit.Client
-import Gerrit.Data
+import Gerrit.Data.Account
+import Gerrit.Data.Change
+import Gerrit.Data.Review
 import Network.HTTP.Client (HttpException)
 
 -- | Return the url of a 'GerritChange'
@@ -84,8 +86,8 @@ postReview ::
 postReview change message label value' = gerritPost urlPath review
   where
     urlPath = "changes/" <> changeId <> "/revisions/" <> revHash <> "/review"
-    changeId = Gerrit.Data.id change
-    revHash = fromMaybe "" (Gerrit.Data.current_revision change)
+    changeId = Gerrit.Data.Change.id change
+    revHash = fromMaybe "" (Gerrit.Data.Change.current_revision change)
     review =
       ReviewInput
         { riMessage = Just message,
@@ -97,7 +99,7 @@ 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) (Gerrit.Data.all gerritLabel)
+      length $ filter (\vote -> fromMaybe 0 (value vote) == labelValue) (Gerrit.Data.Change.all gerritLabel)
   _ -> False
 
 -- | Get user account id

src/Gerrit/Data.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gerrit.Data.Account
+  ( GerritAccountId (..),
+    GerritAccount (..),
+    GerritAccountQuery (..),
+    userQueryText,
+  )
+where
+
+import Control.Monad (mzero)
+import Data.Aeson
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- https://gerrit-review.googlesource.com/Documentation/user-search-accounts.html#_search_operators
+data GerritAccountQuery
+  = CanSee Text
+  | Email Text
+  | Name Text
+  | Username Text
+  | IsActive
+  | IsInactive
+
+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"
+  where
+    escapeChar = T.replace "'" " "
+
+data GerritAccountId = GerritAccountId
+  { gerritAccountId' :: Int,
+    gerritAccountHasMore' :: Maybe Bool
+  }
+  deriving (Eq, Show)
+
+instance FromJSON GerritAccountId where
+  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)
+
+instance FromJSON GerritAccount where
+  parseJSON (Object v) =
+    GerritAccount
+      <$> v .: "_account_id"
+      <*> v .: "name"
+      <*> v .:? "username"
+      <*> v .:? "email"
+      <*> v .:? "_more_accounts"
+  parseJSON _ = mzero

src/Gerrit/Data/Account.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gerrit.Data.Change
+  ( GerritQuery (..),
+    GerritChangeStatus (..),
+    GerritChange (..),
+    GerritRevision (..),
+    GerritDetailedLabelVote (..),
+    GerritDetailedLabel (..),
+
+    -- * Convenient functions
+    queryText,
+  )
+where
+
+import Data.Aeson
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import GHC.Generics (Generic)
+
+aesonOptions :: Options
+aesonOptions = defaultOptions {fieldLabelModifier = recordToJson}
+  where
+    recordToJson "number" = "_number"
+    recordToJson "account_id" = "_account_id"
+    recordToJson n = n
+
+-- https://gerrit-review.googlesource.com/Documentation/user-search.html
+data GerritQuery
+  = Status GerritChangeStatus
+  | Owner Text
+  | CommitMessage Text
+  | Project Text
+  | ChangeId Text
+
+-- | Convert a GerritQuery object to the search terms
+queryText :: GerritQuery -> Text
+queryText (Status stat) = "status:" <> T.toLower (T.pack $ show stat)
+queryText (Owner owner) = "owner:" <> owner
+queryText (CommitMessage message) = "message:" <> message
+queryText (Project project') = "project:" <> project'
+queryText (ChangeId changeId) = "change:" <> changeId
+
+data GerritChangeStatus = NEW | MERGED | ABANDONED | DRAFT
+  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)
+
+data GerritRevision = GerritRevision
+  { ref :: Text,
+    kind :: GerritRevisionKind
+  }
+  deriving (Show, Generic, FromJSON)
+
+data GerritDetailedLabelVote = GerritDetailedLabelVote
+  { value :: Maybe Int,
+    account_id :: Int
+  }
+  deriving (Show, Generic)
+
+instance FromJSON GerritDetailedLabelVote where
+  parseJSON = genericParseJSON aesonOptions
+
+data GerritDetailedLabel = GerritDetailedLabel
+  { all :: [GerritDetailedLabelVote],
+    default_value :: Int
+  }
+  deriving (Show, Generic, FromJSON)
+
+data GerritChange = GerritChange
+  { id :: Text,
+    project :: Text,
+    branch :: 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
+  }
+  deriving (Show, Generic)
+
+instance FromJSON GerritChange where
+  parseJSON = genericParseJSON aesonOptions

src/Gerrit/Data/Change.hs

@@ -3,7 +3,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Gerrit stream event data type
-module Gerrit.Event
+module Gerrit.Data.Event
   ( -- * Main event data types
     EventType (..),
     Event (..),

src/Gerrit/Event.hs src/Gerrit/Data/Event.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module contains the gerrit data type
+module Gerrit.Data.Review
+  ( GerritVersion (..),
+    GerritLabel (..),
+    GerritReviewAccount (..),
+    GerritLabelVote (..),
+    ReviewResult (..),
+    ReviewInput (..),
+  )
+where
+
+import Data.Aeson
+import Data.Char (isUpper, toLower)
+import qualified Data.Map as M
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+newtype GerritVersion = GerritVersion Text
+  deriving (Show, Generic)
+  deriving anyclass (FromJSON)
+
+data GerritLabelVote = REJECTED | APPROVED | DISLIKED | RECOMMENDED
+  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}
+
+instance FromJSONKey GerritLabelVote where
+  fromJSONKey = genericFromJSONKey defaultJSONKeyOptions {keyModifier = map toLower}
+
+-- | Modify record attribute to match json schema
+-- Remove the prefix and use snakecase
+customParseJSON :: String -> Options
+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
+
+-- 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)
+
+instance FromJSON ReviewResult where
+  parseJSON = genericParseJSON $ customParseJSON "rr"
+
+instance ToJSON ReviewResult where
+  toJSON = genericToJSON $ customParseJSON "rr"
+
+data ReviewInput = ReviewInput
+  { riMessage :: Maybe Text,
+    riLabels :: Maybe (M.Map Text Int)
+  }
+  deriving (Eq, Show, Ord, Generic)
+
+instance FromJSON ReviewInput where
+  parseJSON = genericParseJSON $ customParseJSON "ri"
+
+instance ToJSON ReviewInput where
+  toJSON = genericToJSON $ (customParseJSON "ri") {omitNothingFields = True}
+
+newtype GerritReviewAccount = GerritReviewAccount
+  { 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
+
+newtype GerritLabel
+  = GerritLabel (M.Map GerritLabelVote GerritReviewAccount)
+  deriving (Show, Generic)
+  deriving anyclass (FromJSON)

src/Gerrit/Data/Review.hs

@@ -8,8 +8,9 @@ import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as BSL
 import Data.Maybe (fromJust)
 import Gerrit
-import Gerrit.Data as Gerrit
-import qualified Gerrit.Event as Event
+import Gerrit.Data.Change
+import qualified Gerrit.Data.Event as Event
+import Gerrit.Data.Review
 import System.Directory (listDirectory)
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -74,7 +75,7 @@ encodingTests dataFiles client =
   ]
   where
     prettyEncode obj = encode obj <> "\n"
-    reviewInput = Gerrit.ReviewInput (Just "Thanks!") Nothing
+    reviewInput = ReviewInput (Just "Thanks!") Nothing
     getRaw :: FilePath -> ByteString
     getRaw fp = fromJust $ lookup fp dataFiles
     isReviewResult :: Maybe ReviewResult -> Bool