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

module Hercules.Agent.NixFile.GitSource where

import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Text as T
import Hercules.CNix.Expr (ToRawValue, ViaJSON (ViaJSON))
import Protolude

data GitSource = GitSource
  { GitSource -> Text
outPath :: Text,
    GitSource -> Text
ref :: Text,
    GitSource -> Text
rev :: Text,
    GitSource -> Text
shortRev :: Text,
    GitSource -> Maybe Text
branch :: Maybe Text,
    GitSource -> Maybe Text
tag :: Maybe Text
  }
  deriving ((forall x. GitSource -> Rep GitSource x)
-> (forall x. Rep GitSource x -> GitSource) -> Generic GitSource
forall x. Rep GitSource x -> GitSource
forall x. GitSource -> Rep GitSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitSource x -> GitSource
$cfrom :: forall x. GitSource -> Rep GitSource x
Generic, [GitSource] -> Encoding
[GitSource] -> Value
GitSource -> Encoding
GitSource -> Value
(GitSource -> Value)
-> (GitSource -> Encoding)
-> ([GitSource] -> Value)
-> ([GitSource] -> Encoding)
-> ToJSON GitSource
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GitSource] -> Encoding
$ctoEncodingList :: [GitSource] -> Encoding
toJSONList :: [GitSource] -> Value
$ctoJSONList :: [GitSource] -> Value
toEncoding :: GitSource -> Encoding
$ctoEncoding :: GitSource -> Encoding
toJSON :: GitSource -> Value
$ctoJSON :: GitSource -> Value
ToJSON, Value -> Parser [GitSource]
Value -> Parser GitSource
(Value -> Parser GitSource)
-> (Value -> Parser [GitSource]) -> FromJSON GitSource
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GitSource]
$cparseJSONList :: Value -> Parser [GitSource]
parseJSON :: Value -> Parser GitSource
$cparseJSON :: Value -> Parser GitSource
FromJSON, Int -> GitSource -> ShowS
[GitSource] -> ShowS
GitSource -> String
(Int -> GitSource -> ShowS)
-> (GitSource -> String)
-> ([GitSource] -> ShowS)
-> Show GitSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitSource] -> ShowS
$cshowList :: [GitSource] -> ShowS
show :: GitSource -> String
$cshow :: GitSource -> String
showsPrec :: Int -> GitSource -> ShowS
$cshowsPrec :: Int -> GitSource -> ShowS
Show, GitSource -> GitSource -> Bool
(GitSource -> GitSource -> Bool)
-> (GitSource -> GitSource -> Bool) -> Eq GitSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitSource -> GitSource -> Bool
$c/= :: GitSource -> GitSource -> Bool
== :: GitSource -> GitSource -> Bool
$c== :: GitSource -> GitSource -> Bool
Eq)
  deriving (Ptr EvalState -> GitSource -> IO RawValue
(Ptr EvalState -> GitSource -> IO RawValue) -> ToRawValue GitSource
forall a. (Ptr EvalState -> a -> IO RawValue) -> ToRawValue a
toRawValue :: Ptr EvalState -> GitSource -> IO RawValue
$ctoRawValue :: Ptr EvalState -> GitSource -> IO RawValue
ToRawValue) via (ViaJSON GitSource)

fromRefRevPath :: Text -> Text -> Text -> GitSource
fromRefRevPath :: Text -> Text -> Text -> GitSource
fromRefRevPath Text
aRef Text
aRev Text
path =
  GitSource :: Text
-> Text -> Text -> Text -> Maybe Text -> Maybe Text -> GitSource
GitSource
    { outPath :: Text
outPath = Text
path,
      ref :: Text
ref = Text
aRef,
      rev :: Text
rev = Text
aRev,
      shortRev :: Text
shortRev = Int -> Text -> Text
T.take Int
7 Text
aRev,
      branch :: Maybe Text
branch = Text -> Text -> Maybe Text
T.stripPrefix Text
"refs/heads/" Text
aRef,
      tag :: Maybe Text
tag = Text -> Text -> Maybe Text
T.stripPrefix Text
"refs/tags/" Text
aRef
    }