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

-- |
-- Module      : Language.Github.Actions.Step.With
-- Description : Input parameters for GitHub Actions steps
-- Copyright   : (c) 2025 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
--
-- This module provides the 'StepWith' type for specifying input parameters
-- to GitHub Actions steps that use pre-built actions.
--
-- The 'with' keyword allows you to pass inputs to actions, which can be:
-- * Environment variables for the action
-- * Docker container arguments (for Docker actions)
-- * Configuration parameters specific to the action
--
-- For more information about GitHub Actions step inputs, see:
-- <https://docs.github.com/en/actions/writing-workflows/workflow-syntax-for-github-actions#jobsjob_idstepswith>
module Language.Github.Actions.Step.With
  ( StepWith (..),
    gen,
  )
where

import Data.Aeson (FromJSON, ToJSON (..), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as AesonKeyMap
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Language.Github.Actions.UnstructuredMap (UnstructuredMap)
import qualified Language.Github.Actions.UnstructuredMap as UnstructuredMap

-- | Docker container arguments for Docker actions.
--
-- Specifies the entry point and optional arguments for Docker actions.
data StepWithDockerArgsAttrs = StepWithDockerArgsAttrs
  { -- | Docker container entry point
    StepWithDockerArgsAttrs -> Text
entryPoint :: Text,
    -- | Optional arguments to pass to the entry point
    StepWithDockerArgsAttrs -> Maybe Text
args :: Maybe Text
  }
  deriving stock (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
(StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> Eq StepWithDockerArgsAttrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
== :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
$c/= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
/= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
Eq, (forall x.
 StepWithDockerArgsAttrs -> Rep StepWithDockerArgsAttrs x)
-> (forall x.
    Rep StepWithDockerArgsAttrs x -> StepWithDockerArgsAttrs)
-> Generic StepWithDockerArgsAttrs
forall x. Rep StepWithDockerArgsAttrs x -> StepWithDockerArgsAttrs
forall x. StepWithDockerArgsAttrs -> Rep StepWithDockerArgsAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StepWithDockerArgsAttrs -> Rep StepWithDockerArgsAttrs x
from :: forall x. StepWithDockerArgsAttrs -> Rep StepWithDockerArgsAttrs x
$cto :: forall x. Rep StepWithDockerArgsAttrs x -> StepWithDockerArgsAttrs
to :: forall x. Rep StepWithDockerArgsAttrs x -> StepWithDockerArgsAttrs
Generic, Eq StepWithDockerArgsAttrs
Eq StepWithDockerArgsAttrs =>
(StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Ordering)
-> (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> (StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool)
-> (StepWithDockerArgsAttrs
    -> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs)
-> (StepWithDockerArgsAttrs
    -> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs)
-> Ord StepWithDockerArgsAttrs
StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Ordering
StepWithDockerArgsAttrs
-> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Ordering
compare :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Ordering
$c< :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
< :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
$c<= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
<= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
$c> :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
> :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
$c>= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
>= :: StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs -> Bool
$cmax :: StepWithDockerArgsAttrs
-> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs
max :: StepWithDockerArgsAttrs
-> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs
$cmin :: StepWithDockerArgsAttrs
-> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs
min :: StepWithDockerArgsAttrs
-> StepWithDockerArgsAttrs -> StepWithDockerArgsAttrs
Ord, Int -> StepWithDockerArgsAttrs -> ShowS
[StepWithDockerArgsAttrs] -> ShowS
StepWithDockerArgsAttrs -> String
(Int -> StepWithDockerArgsAttrs -> ShowS)
-> (StepWithDockerArgsAttrs -> String)
-> ([StepWithDockerArgsAttrs] -> ShowS)
-> Show StepWithDockerArgsAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StepWithDockerArgsAttrs -> ShowS
showsPrec :: Int -> StepWithDockerArgsAttrs -> ShowS
$cshow :: StepWithDockerArgsAttrs -> String
show :: StepWithDockerArgsAttrs -> String
$cshowList :: [StepWithDockerArgsAttrs] -> ShowS
showList :: [StepWithDockerArgsAttrs] -> ShowS
Show)

-- | Input parameters for GitHub Actions steps.
--
-- Step inputs can be specified in two main ways:
--
-- * 'StepWithDockerArgs' - For Docker actions that need entry point and arguments
-- * 'StepWithEnv' - For actions that accept environment variables or general inputs
--
-- Most actions use the environment variable format, where inputs are passed
-- as key-value pairs.
--
-- Example usage:
--
-- @
-- import Language.Github.Actions.Step.With
-- import qualified Data.Map as Map
--
-- -- Environment inputs for actions/checkout
-- checkoutInputs :: StepWith
-- checkoutInputs = StepWithEnv $ Map.fromList
--  [ ("repository", "owner/repo")
--  , ("ref", "main")
--  , ("token", "\${{ secrets.GITHUB_TOKEN }}")
--  ]
--
-- -- Docker action inputs
-- dockerInputs :: StepWith
-- dockerInputs = StepWithDockerArgs $ StepWithDockerArgsAttrs
--  { entryPoint = "/entrypoint.sh"
--  , args = Just "arg1 arg2"
--  }
--
-- -- Action inputs for actions/upload-artifact
-- uploadInputs :: StepWith
-- uploadInputs = StepWithEnv $ Map.fromList
--  [ ("name", "build-artifacts")
--  , ("path", "dist/")
--  , ("retention-days", "30")
--  ]
-- @
--
-- For more details, see: <https://docs.github.com/en/actions/writing-workflows/workflow-syntax-for-github-actions#jobsjob_idstepswith>
data StepWith
  = -- | Docker action arguments
    StepWithDockerArgs StepWithDockerArgsAttrs
  | -- | Environment variables/general inputs
    StepWithEnv UnstructuredMap
  deriving stock (StepWith -> StepWith -> Bool
(StepWith -> StepWith -> Bool)
-> (StepWith -> StepWith -> Bool) -> Eq StepWith
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StepWith -> StepWith -> Bool
== :: StepWith -> StepWith -> Bool
$c/= :: StepWith -> StepWith -> Bool
/= :: StepWith -> StepWith -> Bool
Eq, (forall x. StepWith -> Rep StepWith x)
-> (forall x. Rep StepWith x -> StepWith) -> Generic StepWith
forall x. Rep StepWith x -> StepWith
forall x. StepWith -> Rep StepWith x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StepWith -> Rep StepWith x
from :: forall x. StepWith -> Rep StepWith x
$cto :: forall x. Rep StepWith x -> StepWith
to :: forall x. Rep StepWith x -> StepWith
Generic, Eq StepWith
Eq StepWith =>
(StepWith -> StepWith -> Ordering)
-> (StepWith -> StepWith -> Bool)
-> (StepWith -> StepWith -> Bool)
-> (StepWith -> StepWith -> Bool)
-> (StepWith -> StepWith -> Bool)
-> (StepWith -> StepWith -> StepWith)
-> (StepWith -> StepWith -> StepWith)
-> Ord StepWith
StepWith -> StepWith -> Bool
StepWith -> StepWith -> Ordering
StepWith -> StepWith -> StepWith
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StepWith -> StepWith -> Ordering
compare :: StepWith -> StepWith -> Ordering
$c< :: StepWith -> StepWith -> Bool
< :: StepWith -> StepWith -> Bool
$c<= :: StepWith -> StepWith -> Bool
<= :: StepWith -> StepWith -> Bool
$c> :: StepWith -> StepWith -> Bool
> :: StepWith -> StepWith -> Bool
$c>= :: StepWith -> StepWith -> Bool
>= :: StepWith -> StepWith -> Bool
$cmax :: StepWith -> StepWith -> StepWith
max :: StepWith -> StepWith -> StepWith
$cmin :: StepWith -> StepWith -> StepWith
min :: StepWith -> StepWith -> StepWith
Ord, Int -> StepWith -> ShowS
[StepWith] -> ShowS
StepWith -> String
(Int -> StepWith -> ShowS)
-> (StepWith -> String) -> ([StepWith] -> ShowS) -> Show StepWith
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StepWith -> ShowS
showsPrec :: Int -> StepWith -> ShowS
$cshow :: StepWith -> String
show :: StepWith -> String
$cshowList :: [StepWith] -> ShowS
showList :: [StepWith] -> ShowS
Show)

instance FromJSON StepWith where
  parseJSON :: Value -> Parser StepWith
parseJSON = String -> (Object -> Parser StepWith) -> Value -> Parser StepWith
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"StepWith" ((Object -> Parser StepWith) -> Value -> Parser StepWith)
-> (Object -> Parser StepWith) -> Value -> Parser StepWith
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    let objectKeySet :: Set Key
objectKeySet = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList (Object -> [Key]
forall v. KeyMap v -> [Key]
AesonKeyMap.keys Object
o)
        dockerKeySet :: Set Key
dockerKeySet = [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList [Key
"entryPoint", Key
"args"]
     in if Bool -> Bool
not (Set Key -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Key
objectKeySet) Bool -> Bool -> Bool
&& Set Key
objectKeySet Set Key -> Set Key -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Key
dockerKeySet
          then do
            Text
entryPoint <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"entryPoint"
            Maybe Text
args <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"args"
            StepWith -> Parser StepWith
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StepWith -> Parser StepWith)
-> (StepWithDockerArgsAttrs -> StepWith)
-> StepWithDockerArgsAttrs
-> Parser StepWith
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StepWithDockerArgsAttrs -> StepWith
StepWithDockerArgs (StepWithDockerArgsAttrs -> Parser StepWith)
-> StepWithDockerArgsAttrs -> Parser StepWith
forall a b. (a -> b) -> a -> b
$ StepWithDockerArgsAttrs {Maybe Text
Text
entryPoint :: Text
args :: Maybe Text
entryPoint :: Text
args :: Maybe Text
..}
          else UnstructuredMap -> StepWith
StepWithEnv (UnstructuredMap -> StepWith)
-> Parser UnstructuredMap -> Parser StepWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser UnstructuredMap
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)

instance ToJSON StepWith where
  toJSON :: StepWith -> Value
toJSON = \case
    StepWithDockerArgs StepWithDockerArgsAttrs {Maybe Text
Text
entryPoint :: StepWithDockerArgsAttrs -> Text
args :: StepWithDockerArgsAttrs -> Maybe Text
entryPoint :: Text
args :: Maybe Text
..} ->
      [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
          [ Pair -> Maybe Pair
forall a. a -> Maybe a
Just (Pair -> Maybe Pair) -> Pair -> Maybe Pair
forall a b. (a -> b) -> a -> b
$ Key
"entryPoint" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
entryPoint,
            (Key
"args" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
args
          ]
    StepWithEnv UnstructuredMap
env ->
      UnstructuredMap -> Value
forall a. ToJSON a => a -> Value
toJSON UnstructuredMap
env

gen :: (MonadGen m) => m StepWith
gen :: forall (m :: * -> *). MonadGen m => m StepWith
gen =
  [m StepWith] -> m StepWith
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ StepWithDockerArgsAttrs -> StepWith
StepWithDockerArgs (StepWithDockerArgsAttrs -> StepWith)
-> m StepWithDockerArgsAttrs -> m StepWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        Text
entryPoint <- m Text
genText
        Maybe Text
args <- m Text -> m (Maybe Text)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m Text
genText
        StepWithDockerArgsAttrs -> m StepWithDockerArgsAttrs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StepWithDockerArgsAttrs {Maybe Text
Text
entryPoint :: Text
args :: Maybe Text
entryPoint :: Text
args :: Maybe Text
..},
      UnstructuredMap -> StepWith
StepWithEnv (UnstructuredMap -> StepWith) -> m UnstructuredMap -> m StepWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UnstructuredMap
forall (m :: * -> *). MonadGen m => m UnstructuredMap
UnstructuredMap.gen
    ]
  where
    genText :: m Text
genText = Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum