{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Connect.Modules
   ( Modules(..)
   , JIRAModules(..)
   , emptyJIRAModules
   , ConfluenceModules(..)
   , emptyConfluenceModules
   , JIRAWebSection(..)
   , WebItem(..)
   , WebItemContext(..)
   , WebPanel(..)
   , WebPanelLayout(..)
   , JIRAPage(..)
   , JIRAGenericTabPanel(..)
   , JIRAProjectAdminTabPanel(..)
   , JIRASearchRequestView(..)
   , JIRAIssueContent(..)
   , JIRAIssueContentTarget(..)
   , JIRAIssueField(..)
   , JiraIssueFieldExtraction(..)
   , JiraIssueFieldProperty(..)
   , JiraIssueFieldTemplate(..)
   , JiraIssueFieldType(..)
   , JiraIssueFieldPropertyType(..)
   , JIRAIssueGlance(..)
   , JIRAIssueGlanceContent(..)
   , JIRAIssueGlanceTarget(..)
   , JIRAReport(..)
   , JIRAReportCategory(..)
   , Target(..)
   , JIRAWorkflowPostFunction(..)
   , DialogOptions(..)
   , InlineDialogOptions(..)
   , JIRAEntityProperties(..)
   , EntityType(..)
   , KeyConfiguration(..)
   , Extraction(..)
   , ExtractionType(..)
   , ModuleParams
   , noParams
   , Weight
   ) where

{-
Supported JIRA Modules

webSections
webItems
webPanels

generalPages
adminPages
configurePage

jiraProfileTabPanels
jiraVersionTabPanels
jiraProjectTabPanels
jiraProjectAdminTabPanels
jiraIssueTabPanels
jiraComponentTabPanels

jiraSearchRequestViews

jiraReports

webhooks

jiraWorkflowPostFunctions

jiraEntityProperties

-}

import           Data.Aeson
import           Data.Aeson.Types
import           Data.Connect.AesonHelpers
import           Data.Connect.BaseTypes
import           Data.Connect.Conditions
import           Data.Connect.Webhooks
import qualified Data.HashMap.Strict       as HM
import qualified Data.Text                 as T
import           GHC.Generics

-- | 'Modules' are perhaps the most important part of your Atlassian Connect descriptor. They specify which parts of the
-- host application you wish to inject content into. They provide your entry point into the host application.
--
-- Atlassian Connect provides a large set of pre-defined entry points into the host application. Some of which are common
-- to every application and some of which are unique to the particular application that you are targeting:
--
-- * To see the JIRA modules: <https://developer.atlassian.com/static/connect/docs/modules/jira/index.html>
-- * To see the Confluence modules: <https://developer.atlassian.com/static/connect/docs/modules/confluence/index.html>
--
-- Note: One important point about modules: they must all have a key and that key must be unique inside the same Atlassian
-- Connect addon.
data Modules = Modules
   { Modules -> JIRAModules
jiraModules       :: JIRAModules -- ^ All of the JIRA Modules that you wish to define.
   , Modules -> ConfluenceModules
confluenceModules :: ConfluenceModules -- ^ All of the Confluence modules that you wish to define.
   } deriving (Int -> Modules -> ShowS
[Modules] -> ShowS
Modules -> String
(Int -> Modules -> ShowS)
-> (Modules -> String) -> ([Modules] -> ShowS) -> Show Modules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modules] -> ShowS
$cshowList :: [Modules] -> ShowS
show :: Modules -> String
$cshow :: Modules -> String
showsPrec :: Int -> Modules -> ShowS
$cshowsPrec :: Int -> Modules -> ShowS
Show, (forall x. Modules -> Rep Modules x)
-> (forall x. Rep Modules x -> Modules) -> Generic Modules
forall x. Rep Modules x -> Modules
forall x. Modules -> Rep Modules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Modules x -> Modules
$cfrom :: forall x. Modules -> Rep Modules x
Generic)

instance ToJSON Modules where
   toJSON :: Modules -> Value
toJSON Modules
modules = case (Value
jm, Value
cm) of
      (Object Object
jiraObject, Object Object
confluenceObject) -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union Object
jiraObject Object
confluenceObject
      (Value, Value)
_ -> Value
Null
      where
         jm :: Value
jm = JIRAModules -> Value
forall a. ToJSON a => a -> Value
toJSON (JIRAModules -> Value)
-> (Modules -> JIRAModules) -> Modules -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modules -> JIRAModules
jiraModules (Modules -> Value) -> Modules -> Value
forall a b. (a -> b) -> a -> b
$ Modules
modules
         cm :: Value
cm = ConfluenceModules -> Value
forall a. ToJSON a => a -> Value
toJSON (ConfluenceModules -> Value)
-> (Modules -> ConfluenceModules) -> Modules -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modules -> ConfluenceModules
confluenceModules (Modules -> Value) -> Modules -> Value
forall a b. (a -> b) -> a -> b
$ Modules
modules

-- TODO use Endo Modules to add modules for multiple different products to the modules list

-- | A collection of all of the JIRA Modules that you can define. For more documentation on which Modules are supported
-- the Atlassian Connect framework please see 'Modules'. You can also find more documentation on each of the modules.
data JIRAModules = JIRAModules
   { JIRAModules -> Maybe [JIRAWebSection]
jmWebSections               :: Maybe [JIRAWebSection]
   , JIRAModules -> Maybe [WebItem]
jmWebItems                  :: Maybe [WebItem]
   , JIRAModules -> Maybe [WebPanel]
jmWebPanels                 :: Maybe [WebPanel]
   , JIRAModules -> Maybe [JIRAPage]
jmGeneralPages              :: Maybe [JIRAPage]
   , JIRAModules -> Maybe [JIRAPage]
jmAdminPages                :: Maybe [JIRAPage]
   , JIRAModules -> Maybe JIRAPage
jmConfigurePage             :: Maybe JIRAPage
   , JIRAModules -> Maybe [JIRASearchRequestView]
jmJiraSearchRequestViews    :: Maybe [JIRASearchRequestView]
   , JIRAModules -> Maybe [JIRAGenericTabPanel]
jmJiraProfileTabPanels      :: Maybe [JIRAGenericTabPanel]
   , JIRAModules -> Maybe [JIRAGenericTabPanel]
jmJiraVersionTabPanels      :: Maybe [JIRAGenericTabPanel]
   , JIRAModules -> Maybe [JIRAGenericTabPanel]
jmJiraProjectTabPanels      :: Maybe [JIRAGenericTabPanel]
   , JIRAModules -> Maybe [JIRAProjectAdminTabPanel]
jmJiraProjectAdminTabPanels :: Maybe [JIRAProjectAdminTabPanel]
   , JIRAModules -> Maybe [JIRAGenericTabPanel]
jmJiraIssueTabPanels        :: Maybe [JIRAGenericTabPanel]
   , JIRAModules -> Maybe [JIRAGenericTabPanel]
jmJiraComponentTabPanels    :: Maybe [JIRAGenericTabPanel]
   , JIRAModules -> Maybe [JIRAIssueContent]
jmJiraIssueContents         :: Maybe [JIRAIssueContent]
   , JIRAModules -> Maybe [JIRAIssueField]
jmJiraIssueFields           :: Maybe [JIRAIssueField]
   , JIRAModules -> Maybe [JIRAIssueGlance]
jmJiraIssueGlances          :: Maybe [JIRAIssueGlance]
   , JIRAModules -> Maybe [JIRAReport]
jmJiraReports               :: Maybe [JIRAReport]
   , JIRAModules -> Maybe [Webhook]
jmWebhooks                  :: Maybe [Webhook]
   , JIRAModules -> Maybe [JIRAWorkflowPostFunction]
jmJiraWorkflowPostFunctions :: Maybe [JIRAWorkflowPostFunction]
   , JIRAModules -> Maybe [JIRAEntityProperties]
jmJiraEntityProperties      :: Maybe [JIRAEntityProperties]
   } deriving (Int -> JIRAModules -> ShowS
[JIRAModules] -> ShowS
JIRAModules -> String
(Int -> JIRAModules -> ShowS)
-> (JIRAModules -> String)
-> ([JIRAModules] -> ShowS)
-> Show JIRAModules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAModules] -> ShowS
$cshowList :: [JIRAModules] -> ShowS
show :: JIRAModules -> String
$cshow :: JIRAModules -> String
showsPrec :: Int -> JIRAModules -> ShowS
$cshowsPrec :: Int -> JIRAModules -> ShowS
Show, (forall x. JIRAModules -> Rep JIRAModules x)
-> (forall x. Rep JIRAModules x -> JIRAModules)
-> Generic JIRAModules
forall x. Rep JIRAModules x -> JIRAModules
forall x. JIRAModules -> Rep JIRAModules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAModules x -> JIRAModules
$cfrom :: forall x. JIRAModules -> Rep JIRAModules x
Generic)

instance ToJSON JIRAModules where
   toJSON :: JIRAModules -> Value
toJSON = Options -> JIRAModules -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jm"
      }

-- | A collection of all of the Confluence Modules that you can define. For more documentation on which Modules are supported
-- the Atlassian Connect framework please see 'Modules'. You can also find more documentation on each of the modules.
data ConfluenceModules = ConfluenceModules
   { ConfluenceModules -> Maybe [WebPanel]
confluenceWebPanels :: Maybe [WebPanel]
   , ConfluenceModules -> Maybe [WebItem]
confluenceWebItems  :: Maybe [WebItem]
   } deriving (Int -> ConfluenceModules -> ShowS
[ConfluenceModules] -> ShowS
ConfluenceModules -> String
(Int -> ConfluenceModules -> ShowS)
-> (ConfluenceModules -> String)
-> ([ConfluenceModules] -> ShowS)
-> Show ConfluenceModules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfluenceModules] -> ShowS
$cshowList :: [ConfluenceModules] -> ShowS
show :: ConfluenceModules -> String
$cshow :: ConfluenceModules -> String
showsPrec :: Int -> ConfluenceModules -> ShowS
$cshowsPrec :: Int -> ConfluenceModules -> ShowS
Show, (forall x. ConfluenceModules -> Rep ConfluenceModules x)
-> (forall x. Rep ConfluenceModules x -> ConfluenceModules)
-> Generic ConfluenceModules
forall x. Rep ConfluenceModules x -> ConfluenceModules
forall x. ConfluenceModules -> Rep ConfluenceModules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfluenceModules x -> ConfluenceModules
$cfrom :: forall x. ConfluenceModules -> Rep ConfluenceModules x
Generic)

instance ToJSON ConfluenceModules where
   toJSON :: ConfluenceModules -> Value
toJSON = Options -> ConfluenceModules -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"confluence"
      }

-- | Empty JIRA Modules; useful when you only want to define a few modules via Haskell record syntax.
emptyJIRAModules :: JIRAModules
emptyJIRAModules :: JIRAModules
emptyJIRAModules
   = Maybe [JIRAWebSection]
-> Maybe [WebItem]
-> Maybe [WebPanel]
-> Maybe [JIRAPage]
-> Maybe [JIRAPage]
-> Maybe JIRAPage
-> Maybe [JIRASearchRequestView]
-> Maybe [JIRAGenericTabPanel]
-> Maybe [JIRAGenericTabPanel]
-> Maybe [JIRAGenericTabPanel]
-> Maybe [JIRAProjectAdminTabPanel]
-> Maybe [JIRAGenericTabPanel]
-> Maybe [JIRAGenericTabPanel]
-> Maybe [JIRAIssueContent]
-> Maybe [JIRAIssueField]
-> Maybe [JIRAIssueGlance]
-> Maybe [JIRAReport]
-> Maybe [Webhook]
-> Maybe [JIRAWorkflowPostFunction]
-> Maybe [JIRAEntityProperties]
-> JIRAModules
JIRAModules
      Maybe [JIRAWebSection]
forall a. Maybe a
Nothing
      Maybe [WebItem]
forall a. Maybe a
Nothing
      Maybe [WebPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAPage]
forall a. Maybe a
Nothing
      Maybe [JIRAPage]
forall a. Maybe a
Nothing
      Maybe JIRAPage
forall a. Maybe a
Nothing
      Maybe [JIRASearchRequestView]
forall a. Maybe a
Nothing
      Maybe [JIRAGenericTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAGenericTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAGenericTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAProjectAdminTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAGenericTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAGenericTabPanel]
forall a. Maybe a
Nothing
      Maybe [JIRAIssueContent]
forall a. Maybe a
Nothing
      Maybe [JIRAIssueField]
forall a. Maybe a
Nothing
      Maybe [JIRAIssueGlance]
forall a. Maybe a
Nothing
      Maybe [JIRAReport]
forall a. Maybe a
Nothing
      Maybe [Webhook]
forall a. Maybe a
Nothing
      Maybe [JIRAWorkflowPostFunction]
forall a. Maybe a
Nothing
      Maybe [JIRAEntityProperties]
forall a. Maybe a
Nothing

-- | Empty Confluence Modules; useful when you only want to define a few modules via Haskell record syntax.
emptyConfluenceModules :: ConfluenceModules
emptyConfluenceModules :: ConfluenceModules
emptyConfluenceModules = Maybe [WebPanel] -> Maybe [WebItem] -> ConfluenceModules
ConfluenceModules Maybe [WebPanel]
forall a. Maybe a
Nothing Maybe [WebItem]
forall a. Maybe a
Nothing

-- | Represents the weight of an element in a menu.
type Weight = Integer

-- | The standard representation for module parameters.
type ModuleParams = HM.HashMap T.Text T.Text

-- | No parameters. A useful helper when you don't want to pass any parameters to a module.
noParams :: ModuleParams
noParams :: ModuleParams
noParams = ModuleParams
forall k v. HashMap k v
HM.empty

-- | A 'JIRAWebSection' represents a location in the host application that you can add 'WebItem's to. In this way you
-- can give your add-on sections to inject content into.
--
-- For more information read the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/jira/web-section.html>
data JIRAWebSection = JIRAWebSection
   { JIRAWebSection -> Text
jwsKey        :: T.Text -- ^ The add-on unique key for this module.
   , JIRAWebSection -> I18nText
jwsName       :: I18nText -- ^ The name of this section, likely to appear in the User Interface.
   , JIRAWebSection -> Text
jwsLocation   :: T.Text -- ^ The location in the application interface where the web section should appear.
   , JIRAWebSection -> Maybe I18nText
jwsTooltip    :: Maybe I18nText -- ^ The internationalised text to be used in the link's tooltip.
   , JIRAWebSection -> [Condition]
jwsConditions :: [Condition] -- ^ The conditions under which to show this web section.
   , JIRAWebSection -> Maybe Weight
jwsWeight     :: Maybe Weight -- ^ The higher the weight the lower down the menu it will appear.
   , JIRAWebSection -> ModuleParams
jwsParams     :: ModuleParams -- ^ Optional parameters to pass to the web section.
   } deriving (Int -> JIRAWebSection -> ShowS
[JIRAWebSection] -> ShowS
JIRAWebSection -> String
(Int -> JIRAWebSection -> ShowS)
-> (JIRAWebSection -> String)
-> ([JIRAWebSection] -> ShowS)
-> Show JIRAWebSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAWebSection] -> ShowS
$cshowList :: [JIRAWebSection] -> ShowS
show :: JIRAWebSection -> String
$cshow :: JIRAWebSection -> String
showsPrec :: Int -> JIRAWebSection -> ShowS
$cshowsPrec :: Int -> JIRAWebSection -> ShowS
Show, (forall x. JIRAWebSection -> Rep JIRAWebSection x)
-> (forall x. Rep JIRAWebSection x -> JIRAWebSection)
-> Generic JIRAWebSection
forall x. Rep JIRAWebSection x -> JIRAWebSection
forall x. JIRAWebSection -> Rep JIRAWebSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAWebSection x -> JIRAWebSection
$cfrom :: forall x. JIRAWebSection -> Rep JIRAWebSection x
Generic)

instance ToJSON JIRAWebSection where
   toJSON :: JIRAWebSection -> Value
toJSON = Options -> JIRAWebSection -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jws"
      }

-- | A 'WebPanel' is an injectable segment of the host application that you can place content inside. Currently the
-- WebPanel has the same structure for both JIRA and Confluence but, potentially, that could change in the future.
-- You can read their Atlassian Connect documentation here:
--
-- * JIRA Web panels: <https://developer.atlassian.com/static/connect/docs/modules/jira/web-panel.html>
-- * Confluence Web panels: <https://developer.atlassian.com/static/connect/docs/modules/confluence/web-panel.html>
--
-- Here is what an example Hello World web panel might look like:
--
-- > helloWorldWebPanel = WebPanel
-- >    { wpKey = "hello-world"
-- >    , wpName = Name "Hello world!"
-- >    , wpUrl = "/panel/show-hello-world"
-- >    , wpLocation = "atl.jira.view.issue.right.context"
-- >    , wpConditions = [staticJiraCondition UserIsLoggedInJiraCondition]
-- >    }
-- >    where
-- >       toURI = fromJust . parseRelativeReference
--
-- WebPanels are a great way to inject your add-on's content into the host application.
data WebPanel = WebPanel
   { WebPanel -> Text
wpKey        :: T.Text -- ^ The add-on unique key for this module.
   , WebPanel -> I18nText
wpName       :: I18nText -- ^ The name of this panel, likely to appear in the User Interface.
   , WebPanel -> Text
wpUrl        :: T.Text -- ^ The relative URI that the host product will hit to get HTML content.
   , WebPanel -> Text
wpLocation   :: T.Text -- ^ The location that this content should be injected in the host product.
   , WebPanel -> [Condition]
wpConditions :: [Condition] -- ^ The 'Condition's that need to be met for this module to be displayed.
   , WebPanel -> Maybe I18nText
wpTooltip    :: Maybe I18nText -- ^ A tooltip that explains what this is for.
   , WebPanel -> Maybe Weight
wpWeight     :: Maybe Weight -- ^ Web panels can be ordered and a higher weight makes you appear lower down the page.
   , WebPanel -> Maybe WebPanelLayout
wpLayout     :: Maybe WebPanelLayout -- ^ You can specify the dimensions of this panel. This will only be considered in certain locations.
   , WebPanel -> ModuleParams
wpParams     :: ModuleParams -- ^ You can pass parameters to the web panel.
   } deriving (Int -> WebPanel -> ShowS
[WebPanel] -> ShowS
WebPanel -> String
(Int -> WebPanel -> ShowS)
-> (WebPanel -> String) -> ([WebPanel] -> ShowS) -> Show WebPanel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebPanel] -> ShowS
$cshowList :: [WebPanel] -> ShowS
show :: WebPanel -> String
$cshow :: WebPanel -> String
showsPrec :: Int -> WebPanel -> ShowS
$cshowsPrec :: Int -> WebPanel -> ShowS
Show, (forall x. WebPanel -> Rep WebPanel x)
-> (forall x. Rep WebPanel x -> WebPanel) -> Generic WebPanel
forall x. Rep WebPanel x -> WebPanel
forall x. WebPanel -> Rep WebPanel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebPanel x -> WebPanel
$cfrom :: forall x. WebPanel -> Rep WebPanel x
Generic)

instance ToJSON WebPanel where
   toJSON :: WebPanel -> Value
toJSON = Options -> WebPanel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"wp"
      }

-- | A 'WebPanelLayout' allows you to specify the dimensions of your Web Panel if that is required.
data WebPanelLayout = WebPanelLayout
   { WebPanelLayout -> Length
wplWidth  :: Length
   , WebPanelLayout -> Length
wplHeight :: Length
   } deriving (Int -> WebPanelLayout -> ShowS
[WebPanelLayout] -> ShowS
WebPanelLayout -> String
(Int -> WebPanelLayout -> ShowS)
-> (WebPanelLayout -> String)
-> ([WebPanelLayout] -> ShowS)
-> Show WebPanelLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebPanelLayout] -> ShowS
$cshowList :: [WebPanelLayout] -> ShowS
show :: WebPanelLayout -> String
$cshow :: WebPanelLayout -> String
showsPrec :: Int -> WebPanelLayout -> ShowS
$cshowsPrec :: Int -> WebPanelLayout -> ShowS
Show, (forall x. WebPanelLayout -> Rep WebPanelLayout x)
-> (forall x. Rep WebPanelLayout x -> WebPanelLayout)
-> Generic WebPanelLayout
forall x. Rep WebPanelLayout x -> WebPanelLayout
forall x. WebPanelLayout -> Rep WebPanelLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebPanelLayout x -> WebPanelLayout
$cfrom :: forall x. WebPanelLayout -> Rep WebPanelLayout x
Generic)

instance ToJSON WebPanelLayout where
   toJSON :: WebPanelLayout -> Value
toJSON = Options -> WebPanelLayout -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"wpl"
      }

-- | A 'WebItem' is a like that can be placed in one of an Atlassian Products many menus. Currently the WebItem has the
-- same structure for both JIRA and Confluence. You can read their documentation here:
--
-- * JIRA Web Items: <https://developer.atlassian.com/static/connect/docs/modules/jira/web-item.html>
-- * Confluence Web Items: <https://developer.atlassian.com/static/connect/docs/modules/confluence/web-item.html>
--
-- Web items are very useful for providing links to your Atlassian Connect pages. See 'GeneralPage' or 'AdminPage' for
-- more information.
data WebItem = WebItem
   { WebItem -> Text
wiKey          :: T.Text -- ^ The add-on unique key for this module.
   , WebItem -> I18nText
wiName         :: I18nText -- ^ The name of this web item. It will appear as the text of the link.
   , WebItem -> Text
wiLocation     :: T.Text -- ^ Where in the product UI this web item will appear.
   , WebItem -> Text
wiUrl          :: T.Text -- ^ The URL to direct the user to. May be relative to the host Product or the Addon depending on the context.
   , WebItem -> Maybe I18nText
wiTooltip      :: Maybe I18nText -- ^ An optional tooltip for the link.
   , WebItem -> Maybe IconDetails
wiIcon         :: Maybe IconDetails -- ^ An optional icon to display with the link text or as the link
   , WebItem -> Maybe Weight
wiWeight       :: Maybe Weight -- ^ The higher the weight the lower down in the location menu this web item will appear.
   , WebItem -> Maybe Target
wiTarget       :: Maybe Target -- ^ Determines the way the link is opened. In the page, in a dialog or in an inline dialog.
   , WebItem -> [Text]
wiStyleClasses :: [T.Text] -- ^ Specifies custom styles for the web item target page
   , WebItem -> Maybe WebItemContext
wiContext      :: Maybe WebItemContext -- ^ Determines if the url is relative to the page, product or connect addon.
   , WebItem -> [Condition]
wiConditions   :: [Condition] -- ^ Determines the conditions under which to show this link.
   , WebItem -> ModuleParams
wiParams       :: ModuleParams -- ^ Optional parameters that you can pass to the web item.
   } deriving (Int -> WebItem -> ShowS
[WebItem] -> ShowS
WebItem -> String
(Int -> WebItem -> ShowS)
-> (WebItem -> String) -> ([WebItem] -> ShowS) -> Show WebItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebItem] -> ShowS
$cshowList :: [WebItem] -> ShowS
show :: WebItem -> String
$cshow :: WebItem -> String
showsPrec :: Int -> WebItem -> ShowS
$cshowsPrec :: Int -> WebItem -> ShowS
Show, (forall x. WebItem -> Rep WebItem x)
-> (forall x. Rep WebItem x -> WebItem) -> Generic WebItem
forall x. Rep WebItem x -> WebItem
forall x. WebItem -> Rep WebItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebItem x -> WebItem
$cfrom :: forall x. WebItem -> Rep WebItem x
Generic)

instance ToJSON WebItem where
   toJSON :: WebItem -> Value
toJSON = Options -> WebItem -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
         { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
lowerAll ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
stripFieldNamePrefix String
"wi"
         }

-- | A 'Target' represents the location that a link will be opened into.
data Target
   = TargetPage -- ^ Open the link into the current page.
   | TargetDialog (Maybe DialogOptions) -- ^ Open the link into a dialog on the page with the given options.
   | TargetInlineDialog (Maybe InlineDialogOptions) -- ^ Open the link into an inline dialog with the given options.
   deriving (Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show)

tp :: String -> T.Text
tp :: String -> Text
tp = String -> Text
T.pack

instance ToJSON Target where
   toJSON :: Target -> Value
toJSON (Target
TargetPage) = [Pair] -> Value
object [String -> Text
tp String
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
tp String
"page"]
   toJSON (TargetDialog Maybe DialogOptions
potentialOptions) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
tp String
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
tp String
"dialog" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:
      case Maybe DialogOptions
potentialOptions of
         Just DialogOptions
options -> [String -> Text
tp String
"options" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DialogOptions -> Value
forall a. ToJSON a => a -> Value
toJSON DialogOptions
options]
         Maybe DialogOptions
Nothing -> []
   toJSON (TargetInlineDialog Maybe InlineDialogOptions
potentialOptions) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
tp String
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
tp String
"inlinedialog" Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:
      case Maybe InlineDialogOptions
potentialOptions of
               Just InlineDialogOptions
options -> [String -> Text
tp String
"options" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= InlineDialogOptions -> Value
forall a. ToJSON a => a -> Value
toJSON InlineDialogOptions
options]
               Maybe InlineDialogOptions
Nothing -> []

-- | Options for a dialog that a link may be opened into.
data DialogOptions = DialogOptions
   { DialogOptions -> Maybe Weight
doHeight :: Maybe Integer -- ^ The height of the dialog on the page.
   , DialogOptions -> Maybe Weight
doWidth  :: Maybe Integer -- ^ The width of the dialog on the page.
   , DialogOptions -> Maybe Bool
doChrome :: Maybe Bool -- ^ Whether the dialog should contain the AUI header and buttons. Default is true
   } deriving (Int -> DialogOptions -> ShowS
[DialogOptions] -> ShowS
DialogOptions -> String
(Int -> DialogOptions -> ShowS)
-> (DialogOptions -> String)
-> ([DialogOptions] -> ShowS)
-> Show DialogOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DialogOptions] -> ShowS
$cshowList :: [DialogOptions] -> ShowS
show :: DialogOptions -> String
$cshow :: DialogOptions -> String
showsPrec :: Int -> DialogOptions -> ShowS
$cshowsPrec :: Int -> DialogOptions -> ShowS
Show, (forall x. DialogOptions -> Rep DialogOptions x)
-> (forall x. Rep DialogOptions x -> DialogOptions)
-> Generic DialogOptions
forall x. Rep DialogOptions x -> DialogOptions
forall x. DialogOptions -> Rep DialogOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DialogOptions x -> DialogOptions
$cfrom :: forall x. DialogOptions -> Rep DialogOptions x
Generic)

instance ToJSON DialogOptions where
   toJSON :: DialogOptions -> Value
toJSON = Options -> DialogOptions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
         { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
lowerAll ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
stripFieldNamePrefix String
"do"
         }

-- | Options for an inline dialog that a link may be opened into.
data InlineDialogOptions = InlineDialogOptions
   { InlineDialogOptions -> Maybe Text
idoWidth             :: Maybe T.Text -- ^ Sets how wide the inline-dialog is in pixels
   , InlineDialogOptions -> Maybe Bool
idoOnTop             :: Maybe Bool -- ^ Determines if the dialog should be shown above the trigger or not
   , InlineDialogOptions -> Maybe Bool
idoIsRelativeToMouse :: Maybe Bool -- ^ Determines if the dialog should be shown relative to where the mouse is at the time of the event trigger
   , InlineDialogOptions -> Maybe Weight
idoShowDelay         :: Maybe Integer -- ^ Determines how long in milliseconds after a show trigger is fired until the dialog is shown
   , InlineDialogOptions -> Maybe Bool
idoOnHover           :: Maybe Bool -- ^ Determines whether the inline-Dialog will show on a mouseOver or mouseClick of the trigger
   , InlineDialogOptions -> Maybe Text
idoOffsetX           :: Maybe T.Text -- ^ Sets an offset distance of the inline-dialog from the trigger element along the x-axis in pixels
   , InlineDialogOptions -> Maybe Text
idoOffsetY           :: Maybe T.Text -- ^ Sets an offset distance of the inline-dialog from the trigger element along the y-axis in pixels
   , InlineDialogOptions -> Maybe Bool
idoPersistent        :: Maybe Bool -- ^ This option, ignores the 'closeOthers' option
   , InlineDialogOptions -> Maybe Bool
idoCloseOthers       :: Maybe Bool -- ^ Cetermines if all other dialogs on the screen are closed when this one is opened
   } deriving (Int -> InlineDialogOptions -> ShowS
[InlineDialogOptions] -> ShowS
InlineDialogOptions -> String
(Int -> InlineDialogOptions -> ShowS)
-> (InlineDialogOptions -> String)
-> ([InlineDialogOptions] -> ShowS)
-> Show InlineDialogOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineDialogOptions] -> ShowS
$cshowList :: [InlineDialogOptions] -> ShowS
show :: InlineDialogOptions -> String
$cshow :: InlineDialogOptions -> String
showsPrec :: Int -> InlineDialogOptions -> ShowS
$cshowsPrec :: Int -> InlineDialogOptions -> ShowS
Show, (forall x. InlineDialogOptions -> Rep InlineDialogOptions x)
-> (forall x. Rep InlineDialogOptions x -> InlineDialogOptions)
-> Generic InlineDialogOptions
forall x. Rep InlineDialogOptions x -> InlineDialogOptions
forall x. InlineDialogOptions -> Rep InlineDialogOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineDialogOptions x -> InlineDialogOptions
$cfrom :: forall x. InlineDialogOptions -> Rep InlineDialogOptions x
Generic)

instance ToJSON InlineDialogOptions where
   toJSON :: InlineDialogOptions -> Value
toJSON = Options -> InlineDialogOptions -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
         { fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
lowerAll ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
stripFieldNamePrefix String
"ido"
         }

-- TODO this cannot have a generic implimentation

-- | Wether to open the url relative to the current page, the current addon or the current product. This lets you control
-- where Atlassian Connect web items point to.
data WebItemContext = PageContext | AddonContext | ProductContext
   deriving(Int -> WebItemContext -> ShowS
[WebItemContext] -> ShowS
WebItemContext -> String
(Int -> WebItemContext -> ShowS)
-> (WebItemContext -> String)
-> ([WebItemContext] -> ShowS)
-> Show WebItemContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebItemContext] -> ShowS
$cshowList :: [WebItemContext] -> ShowS
show :: WebItemContext -> String
$cshow :: WebItemContext -> String
showsPrec :: Int -> WebItemContext -> ShowS
$cshowsPrec :: Int -> WebItemContext -> ShowS
Show, (forall x. WebItemContext -> Rep WebItemContext x)
-> (forall x. Rep WebItemContext x -> WebItemContext)
-> Generic WebItemContext
forall x. Rep WebItemContext x -> WebItemContext
forall x. WebItemContext -> Rep WebItemContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebItemContext x -> WebItemContext
$cfrom :: forall x. WebItemContext -> Rep WebItemContext x
Generic)

instance ToJSON WebItemContext where
   toJSON :: WebItemContext -> Value
toJSON WebItemContext
PageContext = String -> Value
stj String
"page"
   toJSON WebItemContext
AddonContext = String -> Value
stj String
"addon"
   toJSON WebItemContext
ProductContext = String -> Value
stj String
"product"

stj :: String -> Value
stj :: String -> Value
stj = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | JIRA has the concept of a TabPanel which is a panel where you can inject content along with a 'WebItem' that is
-- automatically created for you so that you can navigate to the tab panel in question. Tab panels often have a common format
-- and this 'JIRAGenericTabPanel' encapsulates that common format and allows you to apply it to many different scenarios.
data JIRAGenericTabPanel = JIRAGenericTabPanel
   { JIRAGenericTabPanel -> Text
jtpKey        :: T.Text -- ^ The add-on unique key for this module.
   , JIRAGenericTabPanel -> I18nText
jtpName       :: I18nText -- ^ The user facing name of this panel. Likely to appear as the name of the link to the tab panel.
   , JIRAGenericTabPanel -> Text
jtpUrl        :: T.Text -- ^ The URL to your addon where you will provide the content for the panel.
   , JIRAGenericTabPanel -> [Condition]
jtpConditions :: [Condition] -- ^ The conditions under which this tapb panel should be displayed.
   , JIRAGenericTabPanel -> Maybe Weight
jtpWeight     :: Maybe Weight -- ^ The higher the weight the lower down in the list of tabs the link to this tab panel will be displayed.
   , JIRAGenericTabPanel -> ModuleParams
jtpParams     :: ModuleParams -- ^ Optional parameters for the tab panel.
   } deriving (Int -> JIRAGenericTabPanel -> ShowS
[JIRAGenericTabPanel] -> ShowS
JIRAGenericTabPanel -> String
(Int -> JIRAGenericTabPanel -> ShowS)
-> (JIRAGenericTabPanel -> String)
-> ([JIRAGenericTabPanel] -> ShowS)
-> Show JIRAGenericTabPanel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAGenericTabPanel] -> ShowS
$cshowList :: [JIRAGenericTabPanel] -> ShowS
show :: JIRAGenericTabPanel -> String
$cshow :: JIRAGenericTabPanel -> String
showsPrec :: Int -> JIRAGenericTabPanel -> ShowS
$cshowsPrec :: Int -> JIRAGenericTabPanel -> ShowS
Show, (forall x. JIRAGenericTabPanel -> Rep JIRAGenericTabPanel x)
-> (forall x. Rep JIRAGenericTabPanel x -> JIRAGenericTabPanel)
-> Generic JIRAGenericTabPanel
forall x. Rep JIRAGenericTabPanel x -> JIRAGenericTabPanel
forall x. JIRAGenericTabPanel -> Rep JIRAGenericTabPanel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAGenericTabPanel x -> JIRAGenericTabPanel
$cfrom :: forall x. JIRAGenericTabPanel -> Rep JIRAGenericTabPanel x
Generic)

instance ToJSON JIRAGenericTabPanel where
   toJSON :: JIRAGenericTabPanel -> Value
toJSON = Options -> JIRAGenericTabPanel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jtp"
      }

-- TODO update the docs for the JIRAProjectAdminTabPanel based on this question: http://goo.gl/c6QUdd

-- | A 'JIRAProjectAdminTabPanel' is useful for when you want to add a page to the administration screens of a project.
-- This module will create a web item in the sidebar of every project for you and provide a web panel in the JIRA Project
-- Admin section.
data JIRAProjectAdminTabPanel = JIRAProjectAdminTabPanel
   { JIRAProjectAdminTabPanel -> Text
jpatpKey        :: T.Text -- ^ The add-on unique key for this module.
   , JIRAProjectAdminTabPanel -> I18nText
jpatpName       :: I18nText -- ^ The user facing name of this panel. Likely to appear as the name of the link to the tab panel.
   , JIRAProjectAdminTabPanel -> Text
jpatpUrl        :: T.Text -- ^ The URL to your addon where you will provide the content for the panel.
   , JIRAProjectAdminTabPanel -> Text
jpatpLocation   :: T.Text -- ^ The location in JIRA Admin that you wish the link to this panel to appear.
   , JIRAProjectAdminTabPanel -> [Condition]
jpatpConditions :: [Condition] -- ^ The conditions under which this panel should be displayed. UserIsAdminCondition is redundant.
   , JIRAProjectAdminTabPanel -> Maybe Weight
jpatpWeight     :: Maybe Weight -- ^ The higher the weight the lower down in the list of tabs the link to this tab panel will be displayed.
   , JIRAProjectAdminTabPanel -> ModuleParams
jpatpParams     :: ModuleParams -- ^ Optional parameters for the tab panel.
   } deriving (Int -> JIRAProjectAdminTabPanel -> ShowS
[JIRAProjectAdminTabPanel] -> ShowS
JIRAProjectAdminTabPanel -> String
(Int -> JIRAProjectAdminTabPanel -> ShowS)
-> (JIRAProjectAdminTabPanel -> String)
-> ([JIRAProjectAdminTabPanel] -> ShowS)
-> Show JIRAProjectAdminTabPanel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAProjectAdminTabPanel] -> ShowS
$cshowList :: [JIRAProjectAdminTabPanel] -> ShowS
show :: JIRAProjectAdminTabPanel -> String
$cshow :: JIRAProjectAdminTabPanel -> String
showsPrec :: Int -> JIRAProjectAdminTabPanel -> ShowS
$cshowsPrec :: Int -> JIRAProjectAdminTabPanel -> ShowS
Show, (forall x.
 JIRAProjectAdminTabPanel -> Rep JIRAProjectAdminTabPanel x)
-> (forall x.
    Rep JIRAProjectAdminTabPanel x -> JIRAProjectAdminTabPanel)
-> Generic JIRAProjectAdminTabPanel
forall x.
Rep JIRAProjectAdminTabPanel x -> JIRAProjectAdminTabPanel
forall x.
JIRAProjectAdminTabPanel -> Rep JIRAProjectAdminTabPanel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep JIRAProjectAdminTabPanel x -> JIRAProjectAdminTabPanel
$cfrom :: forall x.
JIRAProjectAdminTabPanel -> Rep JIRAProjectAdminTabPanel x
Generic)

instance ToJSON JIRAProjectAdminTabPanel where
   toJSON :: JIRAProjectAdminTabPanel -> Value
toJSON = Options -> JIRAProjectAdminTabPanel -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jpatp"
      }

-- | A 'JIRAPage' is gives you a location in the host product that you addon can present content and behave just like any
-- other host product page. The main types of pages in JIRA are:
--
-- * General pages: for just getting a geniric chunk of realestate to display your content.
-- * Admin pages: for getting a page in the admin seciton of JIRA to display your content.
-- * Configuration page: Every Atlassian Connect plugin can have a configuration page to configure the plugin when installed.
--
-- This is very useful for pages like Configuration screens or Statistics pages where you really want the user to be
-- immersed in working with your add-on inside the host product.
--
-- General pages, like Web Panels, are common to JIRA and Confluence and share the same json format. However they have
-- separate documentation:
--
-- * JIRA General Page: <https://developer.atlassian.com/static/connect/docs/modules/jira/general-page.html>
-- * Confluence General Page: <https://developer.atlassian.com/static/connect/docs/modules/confluence/general-page.html>
--
-- Even though, at this point in time, the documentation looks identical. You can find the Admin page and Configure page
-- documentation in the official Atlassian Connect documentation too.
data JIRAPage = JIRAPage
   { JIRAPage -> Text
jiraPageKey        :: T.Text -- ^ The add-on unique key for this module.
   , JIRAPage -> I18nText
jiraPageName       :: I18nText -- ^ The name of this JIRA page. Likely to be used in the page title.
   , JIRAPage -> Text
jiraPageUrl        :: T.Text -- ^ The relative URI that the host product will hit to get the HTML content for the page.
   , JIRAPage -> Maybe Text
jiraPageLocation   :: Maybe T.Text -- ^ The location for this General Page to display; see the docs for your options.
   , JIRAPage -> Maybe Weight
jiraPageWeight     :: Maybe Weight -- ^ Determines the order that this item appears in any menu or list.
                                        -- Lower numbers mean that it will appear higher in the list.
   , JIRAPage -> Maybe IconDetails
jiraPageIcon       :: Maybe IconDetails -- ^ The optional icon to use for this JIRA page.
   , JIRAPage -> [Condition]
jiraPageConditions :: [Condition] -- ^ The 'Condition's that need to be met for this page to be displayed.
   , JIRAPage -> ModuleParams
jiraPageParams     :: ModuleParams -- ^ Optional parameters for the page.
   } deriving (Int -> JIRAPage -> ShowS
[JIRAPage] -> ShowS
JIRAPage -> String
(Int -> JIRAPage -> ShowS)
-> (JIRAPage -> String) -> ([JIRAPage] -> ShowS) -> Show JIRAPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAPage] -> ShowS
$cshowList :: [JIRAPage] -> ShowS
show :: JIRAPage -> String
$cshow :: JIRAPage -> String
showsPrec :: Int -> JIRAPage -> ShowS
$cshowsPrec :: Int -> JIRAPage -> ShowS
Show, (forall x. JIRAPage -> Rep JIRAPage x)
-> (forall x. Rep JIRAPage x -> JIRAPage) -> Generic JIRAPage
forall x. Rep JIRAPage x -> JIRAPage
forall x. JIRAPage -> Rep JIRAPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAPage x -> JIRAPage
$cfrom :: forall x. JIRAPage -> Rep JIRAPage x
Generic)

instance ToJSON JIRAPage where
   toJSON :: JIRAPage -> Value
toJSON = Options -> JIRAPage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jiraPage"
      }

-- | This module allows the app to add a new issue field to Jira.
--
-- The key of the field, that can be used to reference the field in the REST API, is: `$(app-key)__$(module-key)`.
--
-- Available options for fields of the `single_select` or `multi-select` type are managed with the REST API for issue field options.
data JIRAIssueField = JiraIssueField
   { JIRAIssueField -> Text
jifKey :: T.Text
   , JIRAIssueField -> I18nText
jifName :: I18nText
   , JIRAIssueField -> I18nText
jifDescription :: I18nText
   , JIRAIssueField -> JiraIssueFieldType
jifType :: JiraIssueFieldType
   , JIRAIssueField -> Maybe [JiraIssueFieldExtraction]
jifExtractions :: Maybe [JiraIssueFieldExtraction]
   , JIRAIssueField -> Maybe JiraIssueFieldProperty
jifProperty :: Maybe JiraIssueFieldProperty
   , JIRAIssueField -> Maybe JiraIssueFieldTemplate
jifTemplate :: Maybe JiraIssueFieldTemplate
   } deriving (Int -> JIRAIssueField -> ShowS
[JIRAIssueField] -> ShowS
JIRAIssueField -> String
(Int -> JIRAIssueField -> ShowS)
-> (JIRAIssueField -> String)
-> ([JIRAIssueField] -> ShowS)
-> Show JIRAIssueField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueField] -> ShowS
$cshowList :: [JIRAIssueField] -> ShowS
show :: JIRAIssueField -> String
$cshow :: JIRAIssueField -> String
showsPrec :: Int -> JIRAIssueField -> ShowS
$cshowsPrec :: Int -> JIRAIssueField -> ShowS
Show, (forall x. JIRAIssueField -> Rep JIRAIssueField x)
-> (forall x. Rep JIRAIssueField x -> JIRAIssueField)
-> Generic JIRAIssueField
forall x. Rep JIRAIssueField x -> JIRAIssueField
forall x. JIRAIssueField -> Rep JIRAIssueField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAIssueField x -> JIRAIssueField
$cfrom :: forall x. JIRAIssueField -> Rep JIRAIssueField x
Generic)

instance ToJSON JIRAIssueField where
   toJSON :: JIRAIssueField -> Value
toJSON = Options -> JIRAIssueField -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jif"
      }

-- | Extractions used for JQL search. This is valid only when the type is single_select or multi_select.
data JiraIssueFieldExtraction = JiraIssueFieldExtraction
   { JiraIssueFieldExtraction -> Text
jifePath :: T.Text
   , JiraIssueFieldExtraction -> ExtractionType
jifeType :: ExtractionType
   , JiraIssueFieldExtraction -> Maybe Text
jifeName :: Maybe T.Text
   } deriving (Int -> JiraIssueFieldExtraction -> ShowS
[JiraIssueFieldExtraction] -> ShowS
JiraIssueFieldExtraction -> String
(Int -> JiraIssueFieldExtraction -> ShowS)
-> (JiraIssueFieldExtraction -> String)
-> ([JiraIssueFieldExtraction] -> ShowS)
-> Show JiraIssueFieldExtraction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JiraIssueFieldExtraction] -> ShowS
$cshowList :: [JiraIssueFieldExtraction] -> ShowS
show :: JiraIssueFieldExtraction -> String
$cshow :: JiraIssueFieldExtraction -> String
showsPrec :: Int -> JiraIssueFieldExtraction -> ShowS
$cshowsPrec :: Int -> JiraIssueFieldExtraction -> ShowS
Show, (forall x.
 JiraIssueFieldExtraction -> Rep JiraIssueFieldExtraction x)
-> (forall x.
    Rep JiraIssueFieldExtraction x -> JiraIssueFieldExtraction)
-> Generic JiraIssueFieldExtraction
forall x.
Rep JiraIssueFieldExtraction x -> JiraIssueFieldExtraction
forall x.
JiraIssueFieldExtraction -> Rep JiraIssueFieldExtraction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep JiraIssueFieldExtraction x -> JiraIssueFieldExtraction
$cfrom :: forall x.
JiraIssueFieldExtraction -> Rep JiraIssueFieldExtraction x
Generic)

instance ToJSON JiraIssueFieldExtraction where
   toJSON :: JiraIssueFieldExtraction -> Value
toJSON = Options -> JiraIssueFieldExtraction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jife"
      }

-- | The property that stores the field value.
--
-- Required when the type is read_only, otherwise not used.
--
-- Defines an issue property that will store the value for the issue field of the read_only type.
data JiraIssueFieldProperty = JiraIssueFieldProperty
   { JiraIssueFieldProperty -> Text
jifpPath :: T.Text
   , JiraIssueFieldProperty -> Text
jifpKey :: T.Text
   , JiraIssueFieldProperty -> JiraIssueFieldPropertyType
jifpType :: JiraIssueFieldPropertyType
   } deriving (Int -> JiraIssueFieldProperty -> ShowS
[JiraIssueFieldProperty] -> ShowS
JiraIssueFieldProperty -> String
(Int -> JiraIssueFieldProperty -> ShowS)
-> (JiraIssueFieldProperty -> String)
-> ([JiraIssueFieldProperty] -> ShowS)
-> Show JiraIssueFieldProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JiraIssueFieldProperty] -> ShowS
$cshowList :: [JiraIssueFieldProperty] -> ShowS
show :: JiraIssueFieldProperty -> String
$cshow :: JiraIssueFieldProperty -> String
showsPrec :: Int -> JiraIssueFieldProperty -> ShowS
$cshowsPrec :: Int -> JiraIssueFieldProperty -> ShowS
Show, (forall x. JiraIssueFieldProperty -> Rep JiraIssueFieldProperty x)
-> (forall x.
    Rep JiraIssueFieldProperty x -> JiraIssueFieldProperty)
-> Generic JiraIssueFieldProperty
forall x. Rep JiraIssueFieldProperty x -> JiraIssueFieldProperty
forall x. JiraIssueFieldProperty -> Rep JiraIssueFieldProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JiraIssueFieldProperty x -> JiraIssueFieldProperty
$cfrom :: forall x. JiraIssueFieldProperty -> Rep JiraIssueFieldProperty x
Generic)

instance ToJSON JiraIssueFieldProperty where
   toJSON :: JiraIssueFieldProperty -> Value
toJSON = Options -> JiraIssueFieldProperty -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jifp"
      }

-- | The template used to render options. This is only valid when the type is single_select or multi_select.
--
-- Defines the template used to render issue field options in the UI view.
data JiraIssueFieldTemplate = JiraIssueFieldTemplate
   { JiraIssueFieldTemplate -> Text
jiftType :: T.Text
   , JiraIssueFieldTemplate -> Text
jiftUrl :: T.Text
   } deriving (Int -> JiraIssueFieldTemplate -> ShowS
[JiraIssueFieldTemplate] -> ShowS
JiraIssueFieldTemplate -> String
(Int -> JiraIssueFieldTemplate -> ShowS)
-> (JiraIssueFieldTemplate -> String)
-> ([JiraIssueFieldTemplate] -> ShowS)
-> Show JiraIssueFieldTemplate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JiraIssueFieldTemplate] -> ShowS
$cshowList :: [JiraIssueFieldTemplate] -> ShowS
show :: JiraIssueFieldTemplate -> String
$cshow :: JiraIssueFieldTemplate -> String
showsPrec :: Int -> JiraIssueFieldTemplate -> ShowS
$cshowsPrec :: Int -> JiraIssueFieldTemplate -> ShowS
Show, (forall x. JiraIssueFieldTemplate -> Rep JiraIssueFieldTemplate x)
-> (forall x.
    Rep JiraIssueFieldTemplate x -> JiraIssueFieldTemplate)
-> Generic JiraIssueFieldTemplate
forall x. Rep JiraIssueFieldTemplate x -> JiraIssueFieldTemplate
forall x. JiraIssueFieldTemplate -> Rep JiraIssueFieldTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JiraIssueFieldTemplate x -> JiraIssueFieldTemplate
$cfrom :: forall x. JiraIssueFieldTemplate -> Rep JiraIssueFieldTemplate x
Generic)

instance ToJSON JiraIssueFieldTemplate where
   toJSON :: JiraIssueFieldTemplate -> Value
toJSON = Options -> JiraIssueFieldTemplate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jift"
      }

-- | This module adds a content button to the context area of the new Jira issue view.
-- Content can have an icon, tooltip, and target.
data JIRAIssueContent = JIRAIssueContent
   { JIRAIssueContent -> Text
jicKey                      :: T.Text -- ^ The add-on unique key for this module.
   , JIRAIssueContent -> I18nText
jicName                     :: I18nText -- ^ The name of this JIRA Issue Content.
   , JIRAIssueContent -> I18nText
jicTooltip                  :: I18nText -- ^ The tooltip for this JIRA Issue Content.
   , JIRAIssueContent -> IconDetails
jicIcon                     :: IconDetails -- ^ The icon for this JIRA Issue Content.
   , JIRAIssueContent -> JIRAIssueContentTarget
jicTarget                   :: JIRAIssueContentTarget -- ^ Specifies the target action when clicking on the content.
   , JIRAIssueContent -> [Condition]
jicConditions               :: [Condition] -- ^ The conditions under which the content could be shown.
   , JIRAIssueContent -> [Condition]
jicContentPresentConditions :: [Condition] -- ^ The conditions under which the content will always be shown.
   } deriving (Int -> JIRAIssueContent -> ShowS
[JIRAIssueContent] -> ShowS
JIRAIssueContent -> String
(Int -> JIRAIssueContent -> ShowS)
-> (JIRAIssueContent -> String)
-> ([JIRAIssueContent] -> ShowS)
-> Show JIRAIssueContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueContent] -> ShowS
$cshowList :: [JIRAIssueContent] -> ShowS
show :: JIRAIssueContent -> String
$cshow :: JIRAIssueContent -> String
showsPrec :: Int -> JIRAIssueContent -> ShowS
$cshowsPrec :: Int -> JIRAIssueContent -> ShowS
Show, (forall x. JIRAIssueContent -> Rep JIRAIssueContent x)
-> (forall x. Rep JIRAIssueContent x -> JIRAIssueContent)
-> Generic JIRAIssueContent
forall x. Rep JIRAIssueContent x -> JIRAIssueContent
forall x. JIRAIssueContent -> Rep JIRAIssueContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAIssueContent x -> JIRAIssueContent
$cfrom :: forall x. JIRAIssueContent -> Rep JIRAIssueContent x
Generic)

instance ToJSON JIRAIssueContent where
   toJSON :: JIRAIssueContent -> Value
toJSON = Options -> JIRAIssueContent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jic"
      }

data JIRAIssueContentTarget = JIRAIssueContentTargetWebPanel
   { JIRAIssueContentTarget -> Text
jictwpUrl :: T.Text -- ^ The url to the content that will be loaded in the glance iframe.
   } deriving (Int -> JIRAIssueContentTarget -> ShowS
[JIRAIssueContentTarget] -> ShowS
JIRAIssueContentTarget -> String
(Int -> JIRAIssueContentTarget -> ShowS)
-> (JIRAIssueContentTarget -> String)
-> ([JIRAIssueContentTarget] -> ShowS)
-> Show JIRAIssueContentTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueContentTarget] -> ShowS
$cshowList :: [JIRAIssueContentTarget] -> ShowS
show :: JIRAIssueContentTarget -> String
$cshow :: JIRAIssueContentTarget -> String
showsPrec :: Int -> JIRAIssueContentTarget -> ShowS
$cshowsPrec :: Int -> JIRAIssueContentTarget -> ShowS
Show)

instance ToJSON JIRAIssueContentTarget where
   toJSON :: JIRAIssueContentTarget -> Value
toJSON wp :: JIRAIssueContentTarget
wp@(JIRAIssueContentTargetWebPanel {}) = [Pair] -> Value
object
      [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
"web_panel"
      , Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (JIRAIssueContentTarget -> Text
jictwpUrl JIRAIssueContentTarget
wp)
      ]

-- | This module adds a glance to the context area of the new Jira issue view.
-- Glances can have an icon, content, and status.
data JIRAIssueGlance = JIRAIssueGlance
   { JIRAIssueGlance -> Text
jigKey             :: T.Text -- ^ The add-on unique key for this module.
   , JIRAIssueGlance -> I18nText
jigName            :: I18nText -- ^ The name of this JIRA Glance.
   , JIRAIssueGlance -> JIRAIssueGlanceContent
jigContent         :: JIRAIssueGlanceContent -- ^ This content becomes the label next to the icon. It's handy for communicating a small amount of information.
   , JIRAIssueGlance -> IconDetails
jigIcon            :: IconDetails -- ^ Specifies an icon to display at the left of the glance view control. The icon resource provided in this field should be 24x24 pixels or larger, preferably in .SVG format.
   , JIRAIssueGlance -> JIRAIssueGlanceTarget
jigTarget          :: JIRAIssueGlanceTarget -- ^ Specifies the target action when clicking on the glance.
   , JIRAIssueGlance -> [Condition]
jigConditions      :: [Condition] -- ^ The conditions under which the glance will be shown.
   } deriving (Int -> JIRAIssueGlance -> ShowS
[JIRAIssueGlance] -> ShowS
JIRAIssueGlance -> String
(Int -> JIRAIssueGlance -> ShowS)
-> (JIRAIssueGlance -> String)
-> ([JIRAIssueGlance] -> ShowS)
-> Show JIRAIssueGlance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueGlance] -> ShowS
$cshowList :: [JIRAIssueGlance] -> ShowS
show :: JIRAIssueGlance -> String
$cshow :: JIRAIssueGlance -> String
showsPrec :: Int -> JIRAIssueGlance -> ShowS
$cshowsPrec :: Int -> JIRAIssueGlance -> ShowS
Show, (forall x. JIRAIssueGlance -> Rep JIRAIssueGlance x)
-> (forall x. Rep JIRAIssueGlance x -> JIRAIssueGlance)
-> Generic JIRAIssueGlance
forall x. Rep JIRAIssueGlance x -> JIRAIssueGlance
forall x. JIRAIssueGlance -> Rep JIRAIssueGlance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAIssueGlance x -> JIRAIssueGlance
$cfrom :: forall x. JIRAIssueGlance -> Rep JIRAIssueGlance x
Generic)

instance ToJSON JIRAIssueGlance where
   toJSON :: JIRAIssueGlance -> Value
toJSON = Options -> JIRAIssueGlance -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jig"
      }

data JIRAIssueGlanceContent = JIRAIssueGlanceContentLabel
   { JIRAIssueGlanceContent -> I18nText
jigclLabel :: I18nText
   } deriving (Int -> JIRAIssueGlanceContent -> ShowS
[JIRAIssueGlanceContent] -> ShowS
JIRAIssueGlanceContent -> String
(Int -> JIRAIssueGlanceContent -> ShowS)
-> (JIRAIssueGlanceContent -> String)
-> ([JIRAIssueGlanceContent] -> ShowS)
-> Show JIRAIssueGlanceContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueGlanceContent] -> ShowS
$cshowList :: [JIRAIssueGlanceContent] -> ShowS
show :: JIRAIssueGlanceContent -> String
$cshow :: JIRAIssueGlanceContent -> String
showsPrec :: Int -> JIRAIssueGlanceContent -> ShowS
$cshowsPrec :: Int -> JIRAIssueGlanceContent -> ShowS
Show)

instance ToJSON JIRAIssueGlanceContent where
   toJSON :: JIRAIssueGlanceContent -> Value
toJSON label :: JIRAIssueGlanceContent
label@(JIRAIssueGlanceContentLabel {}) = [Pair] -> Value
object
      [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
"label"
      , Text
"label" Text -> I18nText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (JIRAIssueGlanceContent -> I18nText
jigclLabel JIRAIssueGlanceContent
label)
      ]

data JIRAIssueGlanceTarget = JIRAIssueGlanceTargetWebPanel
   { JIRAIssueGlanceTarget -> Text
jigtwpUrl :: T.Text -- ^ The url to the content that will be loaded in the glance iframe.
   } deriving (Int -> JIRAIssueGlanceTarget -> ShowS
[JIRAIssueGlanceTarget] -> ShowS
JIRAIssueGlanceTarget -> String
(Int -> JIRAIssueGlanceTarget -> ShowS)
-> (JIRAIssueGlanceTarget -> String)
-> ([JIRAIssueGlanceTarget] -> ShowS)
-> Show JIRAIssueGlanceTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAIssueGlanceTarget] -> ShowS
$cshowList :: [JIRAIssueGlanceTarget] -> ShowS
show :: JIRAIssueGlanceTarget -> String
$cshow :: JIRAIssueGlanceTarget -> String
showsPrec :: Int -> JIRAIssueGlanceTarget -> ShowS
$cshowsPrec :: Int -> JIRAIssueGlanceTarget -> ShowS
Show)

instance ToJSON JIRAIssueGlanceTarget where
   toJSON :: JIRAIssueGlanceTarget -> Value
toJSON wp :: JIRAIssueGlanceTarget
wp@(JIRAIssueGlanceTargetWebPanel {}) = [Pair] -> Value
object
      [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
T.pack String
"web_panel"
      , Text
"url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (JIRAIssueGlanceTarget -> Text
jigtwpUrl JIRAIssueGlanceTarget
wp)
      ]

-- |  A Search Request View allows you to render a custom representation of a search result. Rendering a custom XML
-- format is a common example.
--
-- For more information read the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/jira/search-request-view.html>
data JIRASearchRequestView = JIRASearchRequestView
   { JIRASearchRequestView -> Text
jsrvKey         :: T.Text -- ^ The add-on unique key for this module.
   , JIRASearchRequestView -> I18nText
jsrvName        :: I18nText -- ^ The name of this Search Request View. Will appear in the Export menu.
   , JIRASearchRequestView -> Text
jsrvUrl         :: T.Text -- ^ This URL will render the search results.
   , JIRASearchRequestView -> Maybe I18nText
jsrvDescription :: Maybe I18nText -- ^ The description of this view.
   , JIRASearchRequestView -> Maybe Weight
jsrvWeight      :: Maybe Weight -- ^ A higher weight puts the link further down the export menu.
   , JIRASearchRequestView -> [Condition]
jsrvConditions  :: [Condition] -- ^ The conditions under which this option should show.
   , JIRASearchRequestView -> ModuleParams
jsrvParams      :: ModuleParams -- ^ The optional parameters to this search request view.
   } deriving (Int -> JIRASearchRequestView -> ShowS
[JIRASearchRequestView] -> ShowS
JIRASearchRequestView -> String
(Int -> JIRASearchRequestView -> ShowS)
-> (JIRASearchRequestView -> String)
-> ([JIRASearchRequestView] -> ShowS)
-> Show JIRASearchRequestView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRASearchRequestView] -> ShowS
$cshowList :: [JIRASearchRequestView] -> ShowS
show :: JIRASearchRequestView -> String
$cshow :: JIRASearchRequestView -> String
showsPrec :: Int -> JIRASearchRequestView -> ShowS
$cshowsPrec :: Int -> JIRASearchRequestView -> ShowS
Show, (forall x. JIRASearchRequestView -> Rep JIRASearchRequestView x)
-> (forall x. Rep JIRASearchRequestView x -> JIRASearchRequestView)
-> Generic JIRASearchRequestView
forall x. Rep JIRASearchRequestView x -> JIRASearchRequestView
forall x. JIRASearchRequestView -> Rep JIRASearchRequestView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRASearchRequestView x -> JIRASearchRequestView
$cfrom :: forall x. JIRASearchRequestView -> Rep JIRASearchRequestView x
Generic)

instance ToJSON JIRASearchRequestView where
   toJSON :: JIRASearchRequestView -> Value
toJSON = Options -> JIRASearchRequestView -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jsrv"
      }

-- | A 'JIRAReport' will provide a report on the JIRA issues in the project. It allows you to write custom reporting
-- for JIRA.
--
-- For more information read the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/jira/report.html>
data JIRAReport = JIRAReport
   { JIRAReport -> Text
jrKey            :: T.Text -- ^ The add-on unique key for this module.
   , JIRAReport -> I18nText
jrName           :: I18nText -- ^ The user facing name of this report.
   , JIRAReport -> Text
jrUrl            :: T.Text -- ^ The URL that will render the report back to the user.
   , JIRAReport -> I18nText
jrDescription    :: I18nText -- ^ The required user facing description of this report.
   , JIRAReport -> Maybe JIRAReportCategory
jrReportCategory :: Maybe JIRAReportCategory -- ^ The category that this report should be placed inside.
   , JIRAReport -> Maybe Weight
jrWeight         :: Maybe Weight -- ^ A higher weight will push this report further down the list of reports.
   , JIRAReport -> Maybe Text
jrThumbnailUrl   :: Maybe T.Text -- ^ A thumbnail that gives a gist of what this report is supposed to accomplish.
   } deriving (Int -> JIRAReport -> ShowS
[JIRAReport] -> ShowS
JIRAReport -> String
(Int -> JIRAReport -> ShowS)
-> (JIRAReport -> String)
-> ([JIRAReport] -> ShowS)
-> Show JIRAReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAReport] -> ShowS
$cshowList :: [JIRAReport] -> ShowS
show :: JIRAReport -> String
$cshow :: JIRAReport -> String
showsPrec :: Int -> JIRAReport -> ShowS
$cshowsPrec :: Int -> JIRAReport -> ShowS
Show, (forall x. JIRAReport -> Rep JIRAReport x)
-> (forall x. Rep JIRAReport x -> JIRAReport) -> Generic JIRAReport
forall x. Rep JIRAReport x -> JIRAReport
forall x. JIRAReport -> Rep JIRAReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAReport x -> JIRAReport
$cfrom :: forall x. JIRAReport -> Rep JIRAReport x
Generic)

instance ToJSON JIRAReport where
   toJSON :: JIRAReport -> Value
toJSON = Options -> JIRAReport -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jr"
      }

-- | The report category for a 'JIRAReport'. Useful in organising the different types of reports.
data JIRAReportCategory
   = AgileRC -- ^ This report is visible to agile customers.
   | IssueAnalysisRC -- ^ This report does issue analysis.
   | ForecastManagementRC -- ^ This report considers future of the project state.
   | OtherRC -- ^ Any report that does not fit into the other categories goes here.
   deriving (Int -> JIRAReportCategory -> ShowS
[JIRAReportCategory] -> ShowS
JIRAReportCategory -> String
(Int -> JIRAReportCategory -> ShowS)
-> (JIRAReportCategory -> String)
-> ([JIRAReportCategory] -> ShowS)
-> Show JIRAReportCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAReportCategory] -> ShowS
$cshowList :: [JIRAReportCategory] -> ShowS
show :: JIRAReportCategory -> String
$cshow :: JIRAReportCategory -> String
showsPrec :: Int -> JIRAReportCategory -> ShowS
$cshowsPrec :: Int -> JIRAReportCategory -> ShowS
Show)

instance ToJSON JIRAReportCategory where
   toJSON :: JIRAReportCategory -> Value
toJSON JIRAReportCategory
AgileRC = String -> Value
stj String
"agile"
   toJSON JIRAReportCategory
IssueAnalysisRC = String -> Value
stj String
"issue_analysis"
   toJSON JIRAReportCategory
ForecastManagementRC = String -> Value
stj String
"forecast_management"
   toJSON JIRAReportCategory
OtherRC = String -> Value
stj String
"other"

-- | A 'JIRAWorkflowPostFunction' carries out any additional processing required after a JIRA workflow transition is executed.
--
-- For more information read the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/jira/workflow-post-function.html>
--
-- Or you could read the JIRA documentation on Workflow Post Functions to learn more:
-- <https://confluence.atlassian.com/display/Cloud/Advanced+Workflow+Configuration#AdvancedWorkflowConfiguration-postfunctions>
data JIRAWorkflowPostFunction = JIRAWorkflowPostFunction
   { JIRAWorkflowPostFunction -> Text
jwpfKey         :: T.Text -- ^ The add-on unique key for this module.
   , JIRAWorkflowPostFunction -> I18nText
jwpfName        :: I18nText -- ^ The user facing name of this workflow post function.
   , JIRAWorkflowPostFunction -> URLBean
jwpfTriggered   :: URLBean -- ^ The add-on URL to hit when the post function is triggered. The URL will be POST'ed
                                -- to and you should read the Atlassian Connect docs for more details.
   , JIRAWorkflowPostFunction -> Maybe I18nText
jwpfDescription :: Maybe I18nText -- ^ The user facing description of this post function.
   , JIRAWorkflowPostFunction -> Maybe URLBean
jwpfCreate      :: Maybe URLBean -- ^ The add-on URL to the configuration page for the post function when it is created.
   , JIRAWorkflowPostFunction -> Maybe URLBean
jwpfEdit        :: Maybe URLBean -- ^ The add-on URL to the configuration edit page of the post function.
   , JIRAWorkflowPostFunction -> Maybe URLBean
jwpfView        :: Maybe URLBean -- ^ The add-on URL to the view page for the read-only view of the configuration.
   } deriving (Int -> JIRAWorkflowPostFunction -> ShowS
[JIRAWorkflowPostFunction] -> ShowS
JIRAWorkflowPostFunction -> String
(Int -> JIRAWorkflowPostFunction -> ShowS)
-> (JIRAWorkflowPostFunction -> String)
-> ([JIRAWorkflowPostFunction] -> ShowS)
-> Show JIRAWorkflowPostFunction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAWorkflowPostFunction] -> ShowS
$cshowList :: [JIRAWorkflowPostFunction] -> ShowS
show :: JIRAWorkflowPostFunction -> String
$cshow :: JIRAWorkflowPostFunction -> String
showsPrec :: Int -> JIRAWorkflowPostFunction -> ShowS
$cshowsPrec :: Int -> JIRAWorkflowPostFunction -> ShowS
Show, (forall x.
 JIRAWorkflowPostFunction -> Rep JIRAWorkflowPostFunction x)
-> (forall x.
    Rep JIRAWorkflowPostFunction x -> JIRAWorkflowPostFunction)
-> Generic JIRAWorkflowPostFunction
forall x.
Rep JIRAWorkflowPostFunction x -> JIRAWorkflowPostFunction
forall x.
JIRAWorkflowPostFunction -> Rep JIRAWorkflowPostFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep JIRAWorkflowPostFunction x -> JIRAWorkflowPostFunction
$cfrom :: forall x.
JIRAWorkflowPostFunction -> Rep JIRAWorkflowPostFunction x
Generic)

instance ToJSON JIRAWorkflowPostFunction where
   toJSON :: JIRAWorkflowPostFunction -> Value
toJSON = Options -> JIRAWorkflowPostFunction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jwpf"
      }

-- | 'JIRAEntityProperties' are used to set Key / Value pair information on JIRA Issues that can be searched via JQL and
-- are indexed by JIRA. The can also be accessed directly via rest api so they allow you to store data in client-only
-- Atlassian Connect plugins. Very handy!
--
-- The data stored as entity properties is in the JSON data format so multiple values can be stored against the one property.
--
-- For more information read the JIRA Documentation on the topic:
-- <https://developer.atlassian.com/display/JIRADEV/JIRA+Entity+Properties+Overview>
--
-- Or read the Atlassian Connect documentation on the topic:
-- <https://developer.atlassian.com/static/connect/docs/modules/jira/entity-property.html>
data JIRAEntityProperties = JIRAEntityProperties
   { JIRAEntityProperties -> Text
jepKey               :: T.Text -- ^ The add-on unique key for this module.
   , JIRAEntityProperties -> I18nText
jepName              :: I18nText -- ^ The user facing name of this entity property.
   , JIRAEntityProperties -> Maybe EntityType
jepEntityType        :: Maybe EntityType -- ^ The entity type that you want to attach this property to. Issue by default.
   , JIRAEntityProperties -> [KeyConfiguration]
jepKeyConfigurations :: [KeyConfiguration] -- ^ The list of key configurations that you wish to define.
   } deriving (Int -> JIRAEntityProperties -> ShowS
[JIRAEntityProperties] -> ShowS
JIRAEntityProperties -> String
(Int -> JIRAEntityProperties -> ShowS)
-> (JIRAEntityProperties -> String)
-> ([JIRAEntityProperties] -> ShowS)
-> Show JIRAEntityProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRAEntityProperties] -> ShowS
$cshowList :: [JIRAEntityProperties] -> ShowS
show :: JIRAEntityProperties -> String
$cshow :: JIRAEntityProperties -> String
showsPrec :: Int -> JIRAEntityProperties -> ShowS
$cshowsPrec :: Int -> JIRAEntityProperties -> ShowS
Show, (forall x. JIRAEntityProperties -> Rep JIRAEntityProperties x)
-> (forall x. Rep JIRAEntityProperties x -> JIRAEntityProperties)
-> Generic JIRAEntityProperties
forall x. Rep JIRAEntityProperties x -> JIRAEntityProperties
forall x. JIRAEntityProperties -> Rep JIRAEntityProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRAEntityProperties x -> JIRAEntityProperties
$cfrom :: forall x. JIRAEntityProperties -> Rep JIRAEntityProperties x
Generic)

instance ToJSON JIRAEntityProperties where
   toJSON :: JIRAEntityProperties -> Value
toJSON = Options -> JIRAEntityProperties -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"jep"
      }

-- | An 'EntityType' represents the type of entity that the JIRA Entity Property should be attatched to. By default
-- entity types are attatched to issues.
data EntityType = IssueEntityType
   deriving (Int -> EntityType -> ShowS
[EntityType] -> ShowS
EntityType -> String
(Int -> EntityType -> ShowS)
-> (EntityType -> String)
-> ([EntityType] -> ShowS)
-> Show EntityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityType] -> ShowS
$cshowList :: [EntityType] -> ShowS
show :: EntityType -> String
$cshow :: EntityType -> String
showsPrec :: Int -> EntityType -> ShowS
$cshowsPrec :: Int -> EntityType -> ShowS
Show)

instance ToJSON EntityType where
   toJSON :: EntityType -> Value
toJSON EntityType
IssueEntityType = String -> Value
stj String
"issue"

-- | A 'KeyConfiguration' is the key for this particular property and the JSON flattened paths to the elements that
-- should be extracted from this property. For more information see the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/fragment/index-key-configuration.html>
data KeyConfiguration = KeyConfiguration
   { KeyConfiguration -> Text
kcPropertyKey :: T.Text -- ^ The name of the JIRA Entity Property
   , KeyConfiguration -> [Extraction]
kcExtractions :: [Extraction] -- ^ All of the data extractions from the property that should be indexed.
   } deriving (Int -> KeyConfiguration -> ShowS
[KeyConfiguration] -> ShowS
KeyConfiguration -> String
(Int -> KeyConfiguration -> ShowS)
-> (KeyConfiguration -> String)
-> ([KeyConfiguration] -> ShowS)
-> Show KeyConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyConfiguration] -> ShowS
$cshowList :: [KeyConfiguration] -> ShowS
show :: KeyConfiguration -> String
$cshow :: KeyConfiguration -> String
showsPrec :: Int -> KeyConfiguration -> ShowS
$cshowsPrec :: Int -> KeyConfiguration -> ShowS
Show, (forall x. KeyConfiguration -> Rep KeyConfiguration x)
-> (forall x. Rep KeyConfiguration x -> KeyConfiguration)
-> Generic KeyConfiguration
forall x. Rep KeyConfiguration x -> KeyConfiguration
forall x. KeyConfiguration -> Rep KeyConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyConfiguration x -> KeyConfiguration
$cfrom :: forall x. KeyConfiguration -> Rep KeyConfiguration x
Generic)

instance ToJSON KeyConfiguration where
   toJSON :: KeyConfiguration -> Value
toJSON = Options -> KeyConfiguration -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"kc"
      }

-- | An 'Extraction' represents a snippet of data that should be extracted from a 'KeyConfiguration' such that it is
-- Indexed by JIRA and capable of being searched in JQL.
data Extraction = Extraction
   { Extraction -> Text
extractionObjectName :: T.Text -- ^ The json path to the data in the json data stored in this property.
   , Extraction -> ExtractionType
extractionType       :: ExtractionType -- ^ The type of data contained in this extraction. Arrays are automatically handled.
   , Extraction -> Maybe Text
extractionAlias      :: Maybe T.Text -- ^ The alias for this extraction to use in JQL queries.
   } deriving (Int -> Extraction -> ShowS
[Extraction] -> ShowS
Extraction -> String
(Int -> Extraction -> ShowS)
-> (Extraction -> String)
-> ([Extraction] -> ShowS)
-> Show Extraction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extraction] -> ShowS
$cshowList :: [Extraction] -> ShowS
show :: Extraction -> String
$cshow :: Extraction -> String
showsPrec :: Int -> Extraction -> ShowS
$cshowsPrec :: Int -> Extraction -> ShowS
Show, (forall x. Extraction -> Rep Extraction x)
-> (forall x. Rep Extraction x -> Extraction) -> Generic Extraction
forall x. Rep Extraction x -> Extraction
forall x. Extraction -> Rep Extraction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Extraction x -> Extraction
$cfrom :: forall x. Extraction -> Rep Extraction x
Generic)

instance ToJSON Extraction where
   toJSON :: Extraction -> Value
toJSON = Options -> Extraction -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions
      { fieldLabelModifier :: ShowS
fieldLabelModifier = String -> ShowS
stripFieldNamePrefix String
"extraction"
      }

data JiraIssueFieldType
   = JiraIssueFieldTypeString
   | JiraIssueFieldTypeText
   | JiraIssueFieldTypeRichText
   | JiraIssueFieldTypeSingleSelect
   | JiraIssueFieldTypeMultiSelect
   | JiraIssueFieldTypeNumber
   | JiraIssueFieldTypeReadOnly
   deriving (Int -> JiraIssueFieldType -> ShowS
[JiraIssueFieldType] -> ShowS
JiraIssueFieldType -> String
(Int -> JiraIssueFieldType -> ShowS)
-> (JiraIssueFieldType -> String)
-> ([JiraIssueFieldType] -> ShowS)
-> Show JiraIssueFieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JiraIssueFieldType] -> ShowS
$cshowList :: [JiraIssueFieldType] -> ShowS
show :: JiraIssueFieldType -> String
$cshow :: JiraIssueFieldType -> String
showsPrec :: Int -> JiraIssueFieldType -> ShowS
$cshowsPrec :: Int -> JiraIssueFieldType -> ShowS
Show)

instance ToJSON JiraIssueFieldType where
   toJSON :: JiraIssueFieldType -> Value
toJSON JiraIssueFieldType
JiraIssueFieldTypeString = String -> Value
stj String
"string"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeText = String -> Value
stj String
"text"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeRichText = String -> Value
stj String
"rich_text"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeSingleSelect = String -> Value
stj String
"single_select"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeMultiSelect = String -> Value
stj String
"multi_select"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeNumber = String -> Value
stj String
"number"
   toJSON JiraIssueFieldType
JiraIssueFieldTypeReadOnly = String -> Value
stj String
"read_only"

-- | The style in which the data should be extracted and indexed. For example, you may want the data to be treated as a
-- Date or as a Number.
data JiraIssueFieldPropertyType
   = JiraIssueFieldPropertyTypeNumber -- ^ Index the data as a numeric type.
   | JiraIssueFieldPropertyTypeString -- ^ Index the data as an exact string.
   | JiraIssueFieldPropertyTypeDate -- ^ Index the data as a Date.
   deriving(Int -> JiraIssueFieldPropertyType -> ShowS
[JiraIssueFieldPropertyType] -> ShowS
JiraIssueFieldPropertyType -> String
(Int -> JiraIssueFieldPropertyType -> ShowS)
-> (JiraIssueFieldPropertyType -> String)
-> ([JiraIssueFieldPropertyType] -> ShowS)
-> Show JiraIssueFieldPropertyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JiraIssueFieldPropertyType] -> ShowS
$cshowList :: [JiraIssueFieldPropertyType] -> ShowS
show :: JiraIssueFieldPropertyType -> String
$cshow :: JiraIssueFieldPropertyType -> String
showsPrec :: Int -> JiraIssueFieldPropertyType -> ShowS
$cshowsPrec :: Int -> JiraIssueFieldPropertyType -> ShowS
Show)

instance ToJSON JiraIssueFieldPropertyType where
   toJSON :: JiraIssueFieldPropertyType -> Value
toJSON JiraIssueFieldPropertyType
JiraIssueFieldPropertyTypeNumber = String -> Value
stj String
"number"
   toJSON JiraIssueFieldPropertyType
JiraIssueFieldPropertyTypeString = String -> Value
stj String
"string"
   toJSON JiraIssueFieldPropertyType
JiraIssueFieldPropertyTypeDate = String -> Value
stj String
"date"

-- | The style in which the data should be extracted and indexed. For example, you may want the data to be treated as a
-- Date or as a Number.
data ExtractionType
   = ExtractionTypeNumber -- ^ Index the data as a numeric type.
   | ExtractionTypeText -- ^ Index the data as a text based type, with words.
   | ExtractionTypeString -- ^ Index the data as an exact string.
   | ExtractionTypeDate -- ^ Index the data as a Date.
   | ExtractionTypeUser -- ^ Index the data as Atlassian Account IDs.
   deriving(Int -> ExtractionType -> ShowS
[ExtractionType] -> ShowS
ExtractionType -> String
(Int -> ExtractionType -> ShowS)
-> (ExtractionType -> String)
-> ([ExtractionType] -> ShowS)
-> Show ExtractionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtractionType] -> ShowS
$cshowList :: [ExtractionType] -> ShowS
show :: ExtractionType -> String
$cshow :: ExtractionType -> String
showsPrec :: Int -> ExtractionType -> ShowS
$cshowsPrec :: Int -> ExtractionType -> ShowS
Show)

instance ToJSON ExtractionType where
   toJSON :: ExtractionType -> Value
toJSON ExtractionType
ExtractionTypeNumber = String -> Value
stj String
"number"
   toJSON ExtractionType
ExtractionTypeText = String -> Value
stj String
"text"
   toJSON ExtractionType
ExtractionTypeString = String -> Value
stj String
"string"
   toJSON ExtractionType
ExtractionTypeDate = String -> Value
stj String
"date"
   toJSON ExtractionType
ExtractionTypeUser = String -> Value
stj String
"user"