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

module Gerrit.Data.Project
  ( GerritProjectInfo (..),
    GerritProjectQuery (..),
    projectQS,
    GerritProjectsMessage,
  )
where

import Data.Aeson
import Data.Aeson.Casing (aesonPrefix, snakeCase)
import Data.Map
import Data.Text (Text, intercalate, pack)
import GHC.Generics (Generic)

data GerritProjectQuery = Regexp Text | Prefix Text

queryText :: GerritProjectQuery -> Text
queryText :: GerritProjectQuery -> Text
queryText (Regexp Text
re) = Text
"r=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
re
queryText (Prefix Text
prefix) = Text
"p=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix

-- >>> projectQS 10 (Regexp "test/.*|rpms/.*") Nothing
-- "r:test/.*|rpms/.*&n=10"
projectQS :: Int -> GerritProjectQuery -> Maybe Int -> Text
projectQS :: Int -> GerritProjectQuery -> Maybe Int -> Text
projectQS Int
count GerritProjectQuery
query Maybe Int
startM =
  Text -> [Text] -> Text
intercalate Text
"&" [Text
qtString, Text
countString] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startString
  where
    qtString :: Text
qtString = GerritProjectQuery -> Text
queryText GerritProjectQuery
query
    countString :: Text
countString = Text
"n=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
count)
    startString :: Text
startString = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (\Int
s -> Text
"&S=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
s)) Maybe Int
startM

newtype GerritProjectInfo = GerritProjectInfo
  {GerritProjectInfo -> Text
gerritprojectinfoId :: Text}
  deriving (GerritProjectInfo -> GerritProjectInfo -> Bool
(GerritProjectInfo -> GerritProjectInfo -> Bool)
-> (GerritProjectInfo -> GerritProjectInfo -> Bool)
-> Eq GerritProjectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GerritProjectInfo -> GerritProjectInfo -> Bool
$c/= :: GerritProjectInfo -> GerritProjectInfo -> Bool
== :: GerritProjectInfo -> GerritProjectInfo -> Bool
$c== :: GerritProjectInfo -> GerritProjectInfo -> Bool
Eq, Int -> GerritProjectInfo -> ShowS
[GerritProjectInfo] -> ShowS
GerritProjectInfo -> String
(Int -> GerritProjectInfo -> ShowS)
-> (GerritProjectInfo -> String)
-> ([GerritProjectInfo] -> ShowS)
-> Show GerritProjectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GerritProjectInfo] -> ShowS
$cshowList :: [GerritProjectInfo] -> ShowS
show :: GerritProjectInfo -> String
$cshow :: GerritProjectInfo -> String
showsPrec :: Int -> GerritProjectInfo -> ShowS
$cshowsPrec :: Int -> GerritProjectInfo -> ShowS
Show, (forall x. GerritProjectInfo -> Rep GerritProjectInfo x)
-> (forall x. Rep GerritProjectInfo x -> GerritProjectInfo)
-> Generic GerritProjectInfo
forall x. Rep GerritProjectInfo x -> GerritProjectInfo
forall x. GerritProjectInfo -> Rep GerritProjectInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GerritProjectInfo x -> GerritProjectInfo
$cfrom :: forall x. GerritProjectInfo -> Rep GerritProjectInfo x
Generic)

type GerritProjectsMessage = Map Text GerritProjectInfo

instance FromJSON GerritProjectInfo where
  parseJSON :: Value -> Parser GerritProjectInfo
parseJSON = Options -> Value -> Parser GerritProjectInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser GerritProjectInfo)
-> Options -> Value -> Parser GerritProjectInfo
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase