{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Connect.Conditions
    ( Condition(..)
    , ConditionType(..)
    , ConditionSource(..)
    , JIRACondition(..)
    , ConfluenceCondition(..)
    , staticJiraCondition
    , staticConfluenceCondition
    , remoteCondition
    , invertCondition
    ) where

import           Data.Aeson
import           Data.Connect.AesonHelpers
import           Data.Connect.OrphanInstances ()
import           GHC.Generics
import qualified Data.HashMap.Strict as HM

-- | A 'Condition' can be placed on an Atlassian Connect Module to cause it to display or not based on the result it
-- returns. For example, you can choose not to show a WebPanel if the user viewing the page is not logged in. Conditions
-- are very useful in curating when your modules will appear to your users.
--
-- The Atlassian Connect documentation describes conditions fully:
-- <https://developer.atlassian.com/static/connect/docs/concepts/conditions.html>
data Condition
   -- | A single condition based on a source.
   = SingleCondition
   { Condition -> ConditionSource
conditionSource   :: ConditionSource -- ^ The source of this condition.
   , Condition -> Bool
conditionInverted :: Bool -- ^ If you should invert the condition. For example, only show if user is NOT logged in.
   , Condition -> HashMap String String
conditionParams :: HM.HashMap String String -- ^ Extra parameters to pass with the condition to give it context.
   }
   -- | A condition that is the composition of one or more conditions. The 'ConditionType' decides the way in which the
   -- conditions are composed
   | CompositeCondition
   { Condition -> [Condition]
subConditions :: [Condition] -- ^ The conditions that will be merged together.
   , Condition -> ConditionType
conditionType :: ConditionType -- ^ The way in which the conditions will be merged together.
   }
   deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show)

-- | Turn a standard JIRA Condition into a regular 'Condition'.
staticJiraCondition :: JIRACondition -> Condition
staticJiraCondition :: JIRACondition -> Condition
staticJiraCondition JIRACondition
c = SingleCondition :: ConditionSource -> Bool -> HashMap String String -> Condition
SingleCondition { conditionSource :: ConditionSource
conditionSource = JIRACondition -> ConditionSource
StaticJIRACondition JIRACondition
c, conditionInverted :: Bool
conditionInverted = Bool
False, conditionParams :: HashMap String String
conditionParams = HashMap String String
forall k v. HashMap k v
HM.empty }

-- | Turn a standard Confluence Condition into a regular 'Condition'.
staticConfluenceCondition :: ConfluenceCondition -> Condition
staticConfluenceCondition :: ConfluenceCondition -> Condition
staticConfluenceCondition ConfluenceCondition
c = SingleCondition :: ConditionSource -> Bool -> HashMap String String -> Condition
SingleCondition { conditionSource :: ConditionSource
conditionSource = ConfluenceCondition -> ConditionSource
StaticConfluenceCondition ConfluenceCondition
c, conditionInverted :: Bool
conditionInverted = Bool
False, conditionParams :: HashMap String String
conditionParams = HashMap String String
forall k v. HashMap k v
HM.empty }

-- | Given a URI that defines a remote condition convert it into a regular 'Condition'.
remoteCondition :: String -> Condition
remoteCondition :: String -> Condition
remoteCondition String
conditionLocation = SingleCondition :: ConditionSource -> Bool -> HashMap String String -> Condition
SingleCondition { conditionSource :: ConditionSource
conditionSource = String -> ConditionSource
RemoteCondition String
conditionLocation, conditionInverted :: Bool
conditionInverted = Bool
False, conditionParams :: HashMap String String
conditionParams = HashMap String String
forall k v. HashMap k v
HM.empty }

-- | Invert the given condition.
invertCondition :: Condition -> Condition
invertCondition :: Condition -> Condition
invertCondition c :: Condition
c@(SingleCondition {}) = Condition
c { conditionInverted :: Bool
conditionInverted = Bool -> Bool
not (Bool -> Bool) -> (Condition -> Bool) -> Condition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Condition -> Bool
conditionInverted (Condition -> Bool) -> Condition -> Bool
forall a b. (a -> b) -> a -> b
$ Condition
c }
-- One application of DeMorgans law for composite conditions.
invertCondition (CompositeCondition [Condition]
cs ConditionType
ct) = [Condition] -> ConditionType -> Condition
CompositeCondition ((Condition -> Condition) -> [Condition] -> [Condition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Condition -> Condition
invertCondition [Condition]
cs) (ConditionType -> ConditionType
invertConditionType ConditionType
ct)

invertConditionType :: ConditionType -> ConditionType
invertConditionType :: ConditionType -> ConditionType
invertConditionType ConditionType
AndCondition = ConditionType
OrCondition
invertConditionType ConditionType
OrCondition = ConditionType
AndCondition

instance ToJSON Condition where
   toJSON :: Condition -> Value
toJSON sc :: Condition
sc@(SingleCondition {}) = [Pair] -> Value
object
      [ Text
"condition" Text -> ConditionSource -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Condition -> ConditionSource
conditionSource Condition
sc
      , Text
"invert" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Condition -> Bool
conditionInverted Condition
sc
      , Text
"params" Text -> HashMap String String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Condition -> HashMap String String
conditionParams Condition
sc
      ]
   toJSON cc :: Condition
cc@(CompositeCondition {}) = [Pair] -> Value
object [ Condition -> Text
forall p. IsString p => Condition -> p
compositionConditionKey Condition
cc Text -> [Condition] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Condition -> [Condition]
subConditions Condition
cc]

compositionConditionKey :: Condition -> p
compositionConditionKey (CompositeCondition [Condition]
_ ConditionType
AndCondition) = p
"and"
compositionConditionKey (CompositeCondition [Condition]
_ ConditionType
OrCondition) = p
"or"

-- | Composite Conditions can be joined together to behave as a single condition. The way that you can join them together
-- is decided by the condition type.
data ConditionType
   = AndCondition -- ^ The boolean intersection of the conditions.
   | OrCondition -- ^ The boolean union of the conditions.
   deriving (ConditionType -> ConditionType -> Bool
(ConditionType -> ConditionType -> Bool)
-> (ConditionType -> ConditionType -> Bool) -> Eq ConditionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionType -> ConditionType -> Bool
$c/= :: ConditionType -> ConditionType -> Bool
== :: ConditionType -> ConditionType -> Bool
$c== :: ConditionType -> ConditionType -> Bool
Eq, Int -> ConditionType -> ShowS
[ConditionType] -> ShowS
ConditionType -> String
(Int -> ConditionType -> ShowS)
-> (ConditionType -> String)
-> ([ConditionType] -> ShowS)
-> Show ConditionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionType] -> ShowS
$cshowList :: [ConditionType] -> ShowS
show :: ConditionType -> String
$cshow :: ConditionType -> String
showsPrec :: Int -> ConditionType -> ShowS
$cshowsPrec :: Int -> ConditionType -> ShowS
Show)

instance ToJSON ConditionType where
   toJSON :: ConditionType -> Value
toJSON ConditionType
AndCondition = Text -> Value
String Text
"AND"
   toJSON ConditionType
OrCondition  = Text -> Value
String Text
"OR"

-- | Conditions can be specified by the Host application or by the Atlassian Connect add-on itself. This means that the
-- source of the condition needs to be specified and that is what you can use this data type to do.
data ConditionSource
   -- | A static JIRA condition.
   = StaticJIRACondition        JIRACondition
   -- | A static Confluence condition.
   | StaticConfluenceCondition  ConfluenceCondition
   -- | A remote condition defined by your Atlassian Connect application.
   | RemoteCondition
      { ConditionSource -> String
remoteConditionPath :: String -- ^ The relative URI that you should hit in your Atlassian Connect application to
                                      -- get the condition result. This URI, when hit, should return a JSON response in
                                      -- the format:
                                      --
                                      -- > { "shouldDisplay": <true|false> }
      }
   deriving (Int -> ConditionSource -> ShowS
[ConditionSource] -> ShowS
ConditionSource -> String
(Int -> ConditionSource -> ShowS)
-> (ConditionSource -> String)
-> ([ConditionSource] -> ShowS)
-> Show ConditionSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionSource] -> ShowS
$cshowList :: [ConditionSource] -> ShowS
show :: ConditionSource -> String
$cshow :: ConditionSource -> String
showsPrec :: Int -> ConditionSource -> ShowS
$cshowsPrec :: Int -> ConditionSource -> ShowS
Show, ConditionSource -> ConditionSource -> Bool
(ConditionSource -> ConditionSource -> Bool)
-> (ConditionSource -> ConditionSource -> Bool)
-> Eq ConditionSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionSource -> ConditionSource -> Bool
$c/= :: ConditionSource -> ConditionSource -> Bool
== :: ConditionSource -> ConditionSource -> Bool
$c== :: ConditionSource -> ConditionSource -> Bool
Eq)

instance ToJSON ConditionSource where
   toJSON :: ConditionSource -> Value
toJSON (StaticJIRACondition JIRACondition
x) = JIRACondition -> Value
forall a. ToJSON a => a -> Value
toJSON JIRACondition
x
   toJSON (StaticConfluenceCondition ConfluenceCondition
x) = ConfluenceCondition -> Value
forall a. ToJSON a => a -> Value
toJSON ConfluenceCondition
x
   toJSON (RemoteCondition String
x) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
x

-- The JIRA Conditions have been taken from:
-- https://developer.atlassian.com/static/connect/docs/modules/fragment/single-condition.html
-- as of the following date: Tue 23 Sep 2014 08:45:49 EST
-- Please update the date above whenever you update these conditions.

-- | The conditions that have been provided by JIRA. Please see the single condition documentation for more details:
-- <https://developer.atlassian.com/static/connect/docs/modules/fragment/single-condition.html>
data JIRACondition
   = CanAttachFileToIssueJiraCondition
   | CanManageAttachmentsJiraCondition
   | EntityPropertyEqualToJiraCondition
   | FeatureFlagJiraCondition
   | HasIssuePermissionJiraCondition
   | HasProjectPermissionJiraCondition -- ^ Returns true if there is a selected project and the user has project admin to it.
   | HasSelectedProjectPermissionJiraCondition
   | HasSubTasksAvaliableJiraCondition
   | HasVotedForIssueJiraCondition
   | IsAdminModeJiraCondition
   | IsIssueAssignedToCurrentUserJiraCondition
   | IsIssueEditableJiraCondition
   | IsIssueReportedByCurrentUserJiraCondition
   | IsIssueUnresolvedJiraCondition
   | IsSubTaskJiraCondition
   | IsWatchingIssueJiraCondition
   | LinkingEnabledJiraCondition
   | SubTasksEnabledJiraCondition
   | TimeTrackingEnabledJiraCondition
   | UserHasIssueHistoryJiraCondition
   | UserIsAdminJiraCondition
   | UserIsLoggedInJiraCondition
   | UserIsProjectAdminJiraCondition
   | UserIsSysadminJiraCondition
   | UserIsTheLoggedInUserJiraCondition
   | VotingEnabledJiraCondition
   | WatchingEnabledJiraCondition
   deriving (JIRACondition -> JIRACondition -> Bool
(JIRACondition -> JIRACondition -> Bool)
-> (JIRACondition -> JIRACondition -> Bool) -> Eq JIRACondition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JIRACondition -> JIRACondition -> Bool
$c/= :: JIRACondition -> JIRACondition -> Bool
== :: JIRACondition -> JIRACondition -> Bool
$c== :: JIRACondition -> JIRACondition -> Bool
Eq, Int -> JIRACondition -> ShowS
[JIRACondition] -> ShowS
JIRACondition -> String
(Int -> JIRACondition -> ShowS)
-> (JIRACondition -> String)
-> ([JIRACondition] -> ShowS)
-> Show JIRACondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIRACondition] -> ShowS
$cshowList :: [JIRACondition] -> ShowS
show :: JIRACondition -> String
$cshow :: JIRACondition -> String
showsPrec :: Int -> JIRACondition -> ShowS
$cshowsPrec :: Int -> JIRACondition -> ShowS
Show, (forall x. JIRACondition -> Rep JIRACondition x)
-> (forall x. Rep JIRACondition x -> JIRACondition)
-> Generic JIRACondition
forall x. Rep JIRACondition x -> JIRACondition
forall x. JIRACondition -> Rep JIRACondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JIRACondition x -> JIRACondition
$cfrom :: forall x. JIRACondition -> Rep JIRACondition x
Generic)

instance ToJSON JIRACondition where
   toJSON :: JIRACondition -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (JIRACondition -> String) -> JIRACondition -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropSuffixAndSnakeCase String
"JiraCondition" ShowS -> (JIRACondition -> String) -> JIRACondition -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JIRACondition -> String
forall a. Show a => a -> String
show

-- | The conditions that have been provided by Confluence. Please see the single condition documentation for more details:
-- <https://developer.atlassian.com/static/connect/docs/modules/fragment/single-condition.html>
data ConfluenceCondition
   = ActiveThemeConfluenceCondition
   | CanEditSpaceStylesConfluenceCondition
   | CanSignupConfluenceCondition
   | ContentHasAnyPermissionsSetConfluenceCondition
   | CreateContentConfluenceCondition
   | EmailAddressPublicConfluenceCondition
   | FavouritePageConfluenceCondition
   | FavouriteSpaceConfluenceCondition
   | FeatureFlagConfluenceCondition
   | FollowingTargetUserConfluenceCondition
   | HasAttachmentConfluenceCondition
   | HasBlogPostConfluenceCondition
   | HasPageConfluenceCondition
   | HasSpaceConfluenceCondition
   | HasTemplateConfluenceCondition
   | LatestVersionConfluenceCondition
   | NotPersonalSpaceConfluenceCondition
   | PrintableVersionConfluenceCondition
   | ShowingPageAttachmentsConfluenceCondition
   | SpaceFunctionPermissionConfluenceCondition
   | SpaceSidebarConfluenceCondition
   | TargetUserCanSetStatusConfluenceCondition
   | TargetUserHasPersonalBlogConfluenceCondition
   | TargetUserHasPersonalSpaceConfluenceCondition
   | ThreadedCommentsConfluenceCondition
   | TinyUrlSupportedConfluenceCondition
   | UserCanCreatePersonalSpaceConfluenceCondition
   | UserCanUpdateUserStatusConfluenceCondition
   | UserCanUseConfluenceConfluenceCondition
   | UserFavouritingTargetUserPersonalSpaceConfluenceCondition
   | UserHasPersonalBlogConfluenceCondition
   | UserHasPersonalSpaceConfluenceCondition
   | UserIsAdminConfluenceCondition
   | UserIsConfluenceAdministratorConfluenceCondition
   | UserIsLoggedInConfluenceCondition
   | UserIsSysadminConfluenceCondition
   | UserLoggedInEditableConfluenceCondition
   | UserWatchingPageConfluenceCondition
   | UserWatchingSpaceConfluenceCondition
   | UserWatchingSpaceForContentTypeConfluenceCondition
   | ViewingContentConfluenceCondition
   | ViewingOwnProfileConfluenceCondition
   deriving (ConfluenceCondition -> ConfluenceCondition -> Bool
(ConfluenceCondition -> ConfluenceCondition -> Bool)
-> (ConfluenceCondition -> ConfluenceCondition -> Bool)
-> Eq ConfluenceCondition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfluenceCondition -> ConfluenceCondition -> Bool
$c/= :: ConfluenceCondition -> ConfluenceCondition -> Bool
== :: ConfluenceCondition -> ConfluenceCondition -> Bool
$c== :: ConfluenceCondition -> ConfluenceCondition -> Bool
Eq, Int -> ConfluenceCondition -> ShowS
[ConfluenceCondition] -> ShowS
ConfluenceCondition -> String
(Int -> ConfluenceCondition -> ShowS)
-> (ConfluenceCondition -> String)
-> ([ConfluenceCondition] -> ShowS)
-> Show ConfluenceCondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfluenceCondition] -> ShowS
$cshowList :: [ConfluenceCondition] -> ShowS
show :: ConfluenceCondition -> String
$cshow :: ConfluenceCondition -> String
showsPrec :: Int -> ConfluenceCondition -> ShowS
$cshowsPrec :: Int -> ConfluenceCondition -> ShowS
Show, (forall x. ConfluenceCondition -> Rep ConfluenceCondition x)
-> (forall x. Rep ConfluenceCondition x -> ConfluenceCondition)
-> Generic ConfluenceCondition
forall x. Rep ConfluenceCondition x -> ConfluenceCondition
forall x. ConfluenceCondition -> Rep ConfluenceCondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfluenceCondition x -> ConfluenceCondition
$cfrom :: forall x. ConfluenceCondition -> Rep ConfluenceCondition x
Generic)

instance ToJSON ConfluenceCondition where
   toJSON :: ConfluenceCondition -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (ConfluenceCondition -> String) -> ConfluenceCondition -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
dropSuffixAndSnakeCase String
"ConfluenceCondition" ShowS
-> (ConfluenceCondition -> String) -> ConfluenceCondition -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfluenceCondition -> String
forall a. Show a => a -> String
show