{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}

module Hercules.Agent.NixFile.HerculesCIArgs where

import Data.Aeson (ToJSON)
import Hercules.Agent.NixFile.GitSource (GitSource)
import Hercules.Agent.NixFile.GitSource qualified as GitSource
import Hercules.CNix.Expr (ToRawValue, ViaJSON (ViaJSON))
import Protolude

-- | Documented in @docs/modules/ROOT/pages/evaluation.adoc@.
data HerculesCIMeta = HerculesCIMeta
  { HerculesCIMeta -> Text
apiBaseUrl :: Text,
    HerculesCIMeta -> CISystems
ciSystems :: CISystems
  }
  deriving ((forall x. HerculesCIMeta -> Rep HerculesCIMeta x)
-> (forall x. Rep HerculesCIMeta x -> HerculesCIMeta)
-> Generic HerculesCIMeta
forall x. Rep HerculesCIMeta x -> HerculesCIMeta
forall x. HerculesCIMeta -> Rep HerculesCIMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HerculesCIMeta -> Rep HerculesCIMeta x
from :: forall x. HerculesCIMeta -> Rep HerculesCIMeta x
$cto :: forall x. Rep HerculesCIMeta x -> HerculesCIMeta
to :: forall x. Rep HerculesCIMeta x -> HerculesCIMeta
Generic, [HerculesCIMeta] -> Value
[HerculesCIMeta] -> Encoding
HerculesCIMeta -> Value
HerculesCIMeta -> Encoding
(HerculesCIMeta -> Value)
-> (HerculesCIMeta -> Encoding)
-> ([HerculesCIMeta] -> Value)
-> ([HerculesCIMeta] -> Encoding)
-> ToJSON HerculesCIMeta
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: HerculesCIMeta -> Value
toJSON :: HerculesCIMeta -> Value
$ctoEncoding :: HerculesCIMeta -> Encoding
toEncoding :: HerculesCIMeta -> Encoding
$ctoJSONList :: [HerculesCIMeta] -> Value
toJSONList :: [HerculesCIMeta] -> Value
$ctoEncodingList :: [HerculesCIMeta] -> Encoding
toEncodingList :: [HerculesCIMeta] -> Encoding
ToJSON)

-- | Documented in @docs/modules/ROOT/pages/evaluation.adoc@.
data HerculesCIArgs = HerculesCIArgs
  { HerculesCIArgs -> Text
rev :: Text,
    HerculesCIArgs -> Text
shortRev :: Text,
    HerculesCIArgs -> Text
ref :: Text,
    HerculesCIArgs -> Maybe Text
branch :: Maybe Text,
    HerculesCIArgs -> Maybe Text
tag :: Maybe Text,
    HerculesCIArgs -> GitSource
primaryRepo :: GitSource,
    HerculesCIArgs -> HerculesCIMeta
herculesCI :: HerculesCIMeta
  }
  deriving ((forall x. HerculesCIArgs -> Rep HerculesCIArgs x)
-> (forall x. Rep HerculesCIArgs x -> HerculesCIArgs)
-> Generic HerculesCIArgs
forall x. Rep HerculesCIArgs x -> HerculesCIArgs
forall x. HerculesCIArgs -> Rep HerculesCIArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HerculesCIArgs -> Rep HerculesCIArgs x
from :: forall x. HerculesCIArgs -> Rep HerculesCIArgs x
$cto :: forall x. Rep HerculesCIArgs x -> HerculesCIArgs
to :: forall x. Rep HerculesCIArgs x -> HerculesCIArgs
Generic, [HerculesCIArgs] -> Value
[HerculesCIArgs] -> Encoding
HerculesCIArgs -> Value
HerculesCIArgs -> Encoding
(HerculesCIArgs -> Value)
-> (HerculesCIArgs -> Encoding)
-> ([HerculesCIArgs] -> Value)
-> ([HerculesCIArgs] -> Encoding)
-> ToJSON HerculesCIArgs
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: HerculesCIArgs -> Value
toJSON :: HerculesCIArgs -> Value
$ctoEncoding :: HerculesCIArgs -> Encoding
toEncoding :: HerculesCIArgs -> Encoding
$ctoJSONList :: [HerculesCIArgs] -> Value
toJSONList :: [HerculesCIArgs] -> Value
$ctoEncodingList :: [HerculesCIArgs] -> Encoding
toEncodingList :: [HerculesCIArgs] -> Encoding
ToJSON)
  deriving (Ptr EvalState -> HerculesCIArgs -> IO RawValue
(Ptr EvalState -> HerculesCIArgs -> IO RawValue)
-> ToRawValue HerculesCIArgs
forall a. (Ptr EvalState -> a -> IO RawValue) -> ToRawValue a
$ctoRawValue :: Ptr EvalState -> HerculesCIArgs -> IO RawValue
toRawValue :: Ptr EvalState -> HerculesCIArgs -> IO RawValue
ToRawValue) via (ViaJSON HerculesCIArgs)

newtype CISystems = CISystems (Maybe (Map Text ()))
  deriving ((forall x. CISystems -> Rep CISystems x)
-> (forall x. Rep CISystems x -> CISystems) -> Generic CISystems
forall x. Rep CISystems x -> CISystems
forall x. CISystems -> Rep CISystems x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CISystems -> Rep CISystems x
from :: forall x. CISystems -> Rep CISystems x
$cto :: forall x. Rep CISystems x -> CISystems
to :: forall x. Rep CISystems x -> CISystems
Generic)
  deriving anyclass ([CISystems] -> Value
[CISystems] -> Encoding
CISystems -> Value
CISystems -> Encoding
(CISystems -> Value)
-> (CISystems -> Encoding)
-> ([CISystems] -> Value)
-> ([CISystems] -> Encoding)
-> ToJSON CISystems
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: CISystems -> Value
toJSON :: CISystems -> Value
$ctoEncoding :: CISystems -> Encoding
toEncoding :: CISystems -> Encoding
$ctoJSONList :: [CISystems] -> Value
toJSONList :: [CISystems] -> Value
$ctoEncodingList :: [CISystems] -> Encoding
toEncodingList :: [CISystems] -> Encoding
ToJSON)
  deriving (Ptr EvalState -> CISystems -> IO RawValue
(Ptr EvalState -> CISystems -> IO RawValue) -> ToRawValue CISystems
forall a. (Ptr EvalState -> a -> IO RawValue) -> ToRawValue a
$ctoRawValue :: Ptr EvalState -> CISystems -> IO RawValue
toRawValue :: Ptr EvalState -> CISystems -> IO RawValue
ToRawValue) via (ViaJSON CISystems)

fromGitSource :: GitSource -> HerculesCIMeta -> HerculesCIArgs
fromGitSource :: GitSource -> HerculesCIMeta -> HerculesCIArgs
fromGitSource GitSource
primary HerculesCIMeta
hci =
  HerculesCIArgs
    { rev :: Text
rev = GitSource -> Text
GitSource.rev GitSource
primary,
      shortRev :: Text
shortRev = GitSource -> Text
GitSource.shortRev GitSource
primary,
      ref :: Text
ref = GitSource -> Text
GitSource.ref GitSource
primary,
      branch :: Maybe Text
branch = GitSource -> Maybe Text
GitSource.branch GitSource
primary,
      tag :: Maybe Text
tag = GitSource -> Maybe Text
GitSource.tag GitSource
primary,
      primaryRepo :: GitSource
primaryRepo = GitSource
primary,
      herculesCI :: HerculesCIMeta
herculesCI = HerculesCIMeta
hci
    }