{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
module GitHub.Types.IssueTemplate where

import           Control.Applicative ((<|>))
import           Data.Aeson          (FromJSON (..), ToJSON (toJSON),
                                      Value (..))
import qualified Data.Aeson.Key      as Key
import qualified Data.Aeson.KeyMap   as KeyMap
import           Data.Aeson.TH       (Options (..), defaultOptions, deriveJSON)
import           Data.Aeson.Types    (parseEither)
import           Data.HashMap.Strict (HashMap)
import           Data.Text           (Text)
import qualified Data.Text           as Text
import qualified Data.Vector         as V
import           GitHub.Types.Json   (removeNulls, valueIntersection)
import           Text.Casing         (kebab, quietSnake)

-- name: 🚀 Release
-- description: Build and deploy a new release
-- title: Release tracking issue
-- labels: [chore]
-- type: Task
-- body:
--   - type: textarea
--     id: release-notes
--     attributes:
--       label: Release notes
--       description: Write something nice about the new release.
--       placeholder: "Here's our latest awesome release!"
--     validations:
--       required: true
--   - type: dropdown
--     id: production
--     attributes:
--       label: Release type
--       description: Whether this is a production release or a release candidate.
--       options:
--         - Release candidate
--         - Production release
--     validations:
--       required: true

newtype BodyValidations = BodyValidations
    { BodyValidations -> Bool
bodyValidationsRequired :: Bool
    }
    deriving (Int -> BodyValidations -> ShowS
[BodyValidations] -> ShowS
BodyValidations -> String
(Int -> BodyValidations -> ShowS)
-> (BodyValidations -> String)
-> ([BodyValidations] -> ShowS)
-> Show BodyValidations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyValidations] -> ShowS
$cshowList :: [BodyValidations] -> ShowS
show :: BodyValidations -> String
$cshow :: BodyValidations -> String
showsPrec :: Int -> BodyValidations -> ShowS
$cshowsPrec :: Int -> BodyValidations -> ShowS
Show, BodyValidations -> BodyValidations -> Bool
(BodyValidations -> BodyValidations -> Bool)
-> (BodyValidations -> BodyValidations -> Bool)
-> Eq BodyValidations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyValidations -> BodyValidations -> Bool
$c/= :: BodyValidations -> BodyValidations -> Bool
== :: BodyValidations -> BodyValidations -> Bool
$c== :: BodyValidations -> BodyValidations -> Bool
Eq)
$(deriveJSON defaultOptions{fieldLabelModifier = kebab . drop (Text.length "BodyValidations")} ''BodyValidations)

data Body = Body
    { Body -> Text
bodyType        :: Text
    , Body -> Text
bodyId          :: Text
    , Body -> HashMap Text Value
bodyAttributes  :: HashMap Text Value
    , Body -> BodyValidations
bodyValidations :: BodyValidations
    }
    deriving (Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Body] -> ShowS
$cshowList :: [Body] -> ShowS
show :: Body -> String
$cshow :: Body -> String
showsPrec :: Int -> Body -> ShowS
$cshowsPrec :: Int -> Body -> ShowS
Show, Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq)
$(deriveJSON defaultOptions{fieldLabelModifier = kebab . drop (Text.length "Body")} ''Body)

data IssueTemplate = IssueTemplate
    { IssueTemplate -> Text
issueTemplateName        :: Text
    , IssueTemplate -> Text
issueTemplateDescription :: Text
    , IssueTemplate -> Text
issueTemplateTitle       :: Text
    , IssueTemplate -> [Text]
issueTemplateLabels      :: [Text]
    , IssueTemplate -> Text
issueTemplateType        :: Text
    , IssueTemplate -> [Body]
issueTemplateBody        :: [Body]
    }
    deriving (Int -> IssueTemplate -> ShowS
[IssueTemplate] -> ShowS
IssueTemplate -> String
(Int -> IssueTemplate -> ShowS)
-> (IssueTemplate -> String)
-> ([IssueTemplate] -> ShowS)
-> Show IssueTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueTemplate] -> ShowS
$cshowList :: [IssueTemplate] -> ShowS
show :: IssueTemplate -> String
$cshow :: IssueTemplate -> String
showsPrec :: Int -> IssueTemplate -> ShowS
$cshowsPrec :: Int -> IssueTemplate -> ShowS
Show, IssueTemplate -> IssueTemplate -> Bool
(IssueTemplate -> IssueTemplate -> Bool)
-> (IssueTemplate -> IssueTemplate -> Bool) -> Eq IssueTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueTemplate -> IssueTemplate -> Bool
$c/= :: IssueTemplate -> IssueTemplate -> Bool
== :: IssueTemplate -> IssueTemplate -> Bool
$c== :: IssueTemplate -> IssueTemplate -> Bool
Eq)
$(deriveJSON defaultOptions{fieldLabelModifier = kebab . drop (Text.length "IssueTemplate")} ''IssueTemplate)

parseIssueTemplate :: Value -> Either String IssueTemplate
parseIssueTemplate :: Value -> Either String IssueTemplate
parseIssueTemplate = (Value -> Parser IssueTemplate)
-> Value -> Either String IssueTemplate
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser IssueTemplate
forall a. FromJSON a => Value -> Parser a
parseJSON

issueTemplateIntersection :: IssueTemplate -> IssueTemplate -> IssueTemplate
issueTemplateIntersection :: IssueTemplate -> IssueTemplate -> IssueTemplate
issueTemplateIntersection IssueTemplate
a IssueTemplate
b =
    case Value -> Either String IssueTemplate
parseIssueTemplate (Value -> Either String IssueTemplate)
-> Value -> Either String IssueTemplate
forall a b. (a -> b) -> a -> b
$ Value -> Value -> Value
valueIntersection (Value -> Value
forall a. ToJSON a => a -> Value
removeNulls (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ IssueTemplate -> Value
forall a. ToJSON a => a -> Value
toJSON IssueTemplate
a) (Value -> Value
forall a. ToJSON a => a -> Value
removeNulls (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ IssueTemplate -> Value
forall a. ToJSON a => a -> Value
toJSON IssueTemplate
b) of
        Left  String
err -> String -> IssueTemplate
forall a. HasCallStack => String -> a
error (String -> IssueTemplate) -> String -> IssueTemplate
forall a b. (a -> b) -> a -> b
$ String
"issue template intersection is not parsable (should not happen): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
        Right IssueTemplate
ok  -> IssueTemplate
ok