Review.hs

{-# 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)