{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Gerrit.Data.Account
  ( GerritAccountId (..),
    GerritAccount (..),
    GerritAccountQuery (..),
    userQueryText,
    accountQs,
  )
where

import Control.Monad (mzero)
import Data.Aeson
import Data.List.NonEmpty (NonEmpty, toList)
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
  deriving (GerritAccountQuery -> GerritAccountQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritAccountQuery -> GerritAccountQuery -> Bool
$c/= :: GerritAccountQuery -> GerritAccountQuery -> Bool
== :: GerritAccountQuery -> GerritAccountQuery -> Bool
$c== :: GerritAccountQuery -> GerritAccountQuery -> Bool
Eq, Int -> GerritAccountQuery -> ShowS
[GerritAccountQuery] -> ShowS
GerritAccountQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritAccountQuery] -> ShowS
$cshowList :: [GerritAccountQuery] -> ShowS
show :: GerritAccountQuery -> String
$cshow :: GerritAccountQuery -> String
showsPrec :: Int -> GerritAccountQuery -> ShowS
$cshowsPrec :: Int -> GerritAccountQuery -> ShowS
Show)

userQueryText :: GerritAccountQuery -> Text
userQueryText :: GerritAccountQuery -> Text
userQueryText GerritAccountQuery
guq = case GerritAccountQuery
guq of
  CanSee Text
change -> Text
"cansee:" forall a. Semigroup a => a -> a -> a
<> Text
change
  Email Text
email -> Text
"email:" forall a. Semigroup a => a -> a -> a
<> Text
email
  Name Text
name -> Text
"name:" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeChar Text
name
  Username Text
username -> Text
"username:" forall a. Semigroup a => a -> a -> a
<> Text
username
  GerritAccountQuery
IsActive -> Text
"is:active"
  GerritAccountQuery
IsInactive -> Text
"is:inactive"
  where
    escapeChar :: Text -> Text
escapeChar = Text -> Text -> Text -> Text
T.replace Text
"'" Text
" "

accountQs :: Int -> NonEmpty GerritAccountQuery -> Text
accountQs :: Int -> NonEmpty GerritAccountQuery -> Text
accountQs Int
count NonEmpty GerritAccountQuery
queries = Text -> [Text] -> Text
T.intercalate Text
"&" [Text
searchString, Text
countString]
  where
    searchString :: Text
searchString = Text
"q=" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"+" (forall a b. (a -> b) -> [a] -> [b]
map GerritAccountQuery -> Text
userQueryText forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty GerritAccountQuery
queries)
    countString :: Text
countString = Text
"n=" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
count)

data GerritAccountId = GerritAccountId
  { GerritAccountId -> Int
gerritAccountId' :: Int,
    GerritAccountId -> Maybe Bool
gerritAccountHasMore' :: Maybe Bool
  }
  deriving (GerritAccountId -> GerritAccountId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritAccountId -> GerritAccountId -> Bool
$c/= :: GerritAccountId -> GerritAccountId -> Bool
== :: GerritAccountId -> GerritAccountId -> Bool
$c== :: GerritAccountId -> GerritAccountId -> Bool
Eq, Int -> GerritAccountId -> ShowS
[GerritAccountId] -> ShowS
GerritAccountId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritAccountId] -> ShowS
$cshowList :: [GerritAccountId] -> ShowS
show :: GerritAccountId -> String
$cshow :: GerritAccountId -> String
showsPrec :: Int -> GerritAccountId -> ShowS
$cshowsPrec :: Int -> GerritAccountId -> ShowS
Show)

instance FromJSON GerritAccountId where
  parseJSON :: Value -> Parser GerritAccountId
parseJSON (Object Object
v) = Int -> Maybe Bool -> GerritAccountId
GerritAccountId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_account_id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_more_accounts"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

data GerritAccount = GerritAccount
  { GerritAccount -> Int
gerritAccountId :: Int,
    GerritAccount -> Text
gerritAccountName :: Text,
    GerritAccount -> Maybe Text
gerritAccountUsername :: Maybe Text,
    GerritAccount -> Maybe Text
gerritAccountEmail :: Maybe Text,
    GerritAccount -> Maybe Bool
gerritAccountHasMore :: Maybe Bool
  }
  deriving (GerritAccount -> GerritAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritAccount -> GerritAccount -> Bool
$c/= :: GerritAccount -> GerritAccount -> Bool
== :: GerritAccount -> GerritAccount -> Bool
$c== :: GerritAccount -> GerritAccount -> Bool
Eq, Int -> GerritAccount -> ShowS
[GerritAccount] -> ShowS
GerritAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritAccount] -> ShowS
$cshowList :: [GerritAccount] -> ShowS
show :: GerritAccount -> String
$cshow :: GerritAccount -> String
showsPrec :: Int -> GerritAccount -> ShowS
$cshowsPrec :: Int -> GerritAccount -> ShowS
Show)

instance FromJSON GerritAccount where
  parseJSON :: Value -> Parser GerritAccount
parseJSON (Object Object
v) =
    Int
-> Text -> Maybe Text -> Maybe Text -> Maybe Bool -> GerritAccount
GerritAccount
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_account_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_more_accounts"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero