{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
module Data.Connect.BaseTypes
   ( Key(..)
   , PluginKey(..)
   , Timeout(..)
   , Vendor(..)
   , Authentication(..)
   , AuthType(..)
   , IconDetails(..)
   , Name(..)
   , I18nText(..)
   , simpleText
   , URLBean(..)
   , toUrl
   , Length(..)
   )
   where

import           Data.Aeson
import           Data.Aeson.Types
import           Data.Connect.AesonHelpers
import           Data.Connect.OrphanInstances ()
import           Data.Text
import qualified Data.Time.Units              as DTU
import           GHC.Generics
import qualified Network.URI                  as NU

-- | This data type represents a Key for a particular data type.
data Key t a = Key t deriving (Int -> Key t a -> ShowS
[Key t a] -> ShowS
Key t a -> String
(Int -> Key t a -> ShowS)
-> (Key t a -> String) -> ([Key t a] -> ShowS) -> Show (Key t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t a. Show t => Int -> Key t a -> ShowS
forall t a. Show t => [Key t a] -> ShowS
forall t a. Show t => Key t a -> String
showList :: [Key t a] -> ShowS
$cshowList :: forall t a. Show t => [Key t a] -> ShowS
show :: Key t a -> String
$cshow :: forall t a. Show t => Key t a -> String
showsPrec :: Int -> Key t a -> ShowS
$cshowsPrec :: forall t a. Show t => Int -> Key t a -> ShowS
Show, Key t a -> Key t a -> Bool
(Key t a -> Key t a -> Bool)
-> (Key t a -> Key t a -> Bool) -> Eq (Key t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t a. Eq t => Key t a -> Key t a -> Bool
/= :: Key t a -> Key t a -> Bool
$c/= :: forall t a. Eq t => Key t a -> Key t a -> Bool
== :: Key t a -> Key t a -> Bool
$c== :: forall t a. Eq t => Key t a -> Key t a -> Bool
Eq, (forall x. Key t a -> Rep (Key t a) x)
-> (forall x. Rep (Key t a) x -> Key t a) -> Generic (Key t a)
forall x. Rep (Key t a) x -> Key t a
forall x. Key t a -> Rep (Key t a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t a x. Rep (Key t a) x -> Key t a
forall t a x. Key t a -> Rep (Key t a) x
$cto :: forall t a x. Rep (Key t a) x -> Key t a
$cfrom :: forall t a x. Key t a -> Rep (Key t a) x
Generic)

-- | This data type represents an Atlassian Connect Add-on key.
data PluginKey = PluginKey Text deriving (Int -> PluginKey -> ShowS
[PluginKey] -> ShowS
PluginKey -> String
(Int -> PluginKey -> ShowS)
-> (PluginKey -> String)
-> ([PluginKey] -> ShowS)
-> Show PluginKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginKey] -> ShowS
$cshowList :: [PluginKey] -> ShowS
show :: PluginKey -> String
$cshow :: PluginKey -> String
showsPrec :: Int -> PluginKey -> ShowS
$cshowsPrec :: Int -> PluginKey -> ShowS
Show, PluginKey -> PluginKey -> Bool
(PluginKey -> PluginKey -> Bool)
-> (PluginKey -> PluginKey -> Bool) -> Eq PluginKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginKey -> PluginKey -> Bool
$c/= :: PluginKey -> PluginKey -> Bool
== :: PluginKey -> PluginKey -> Bool
$c== :: PluginKey -> PluginKey -> Bool
Eq, (forall x. PluginKey -> Rep PluginKey x)
-> (forall x. Rep PluginKey x -> PluginKey) -> Generic PluginKey
forall x. Rep PluginKey x -> PluginKey
forall x. PluginKey -> Rep PluginKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PluginKey x -> PluginKey
$cfrom :: forall x. PluginKey -> Rep PluginKey x
Generic)

instance ToJSON PluginKey

-- | Represents a timeout in seconds.
newtype Timeout = Timeout DTU.Second deriving (Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timeout] -> ShowS
$cshowList :: [Timeout] -> ShowS
show :: Timeout -> String
$cshow :: Timeout -> String
showsPrec :: Int -> Timeout -> ShowS
$cshowsPrec :: Int -> Timeout -> ShowS
Show, Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c== :: Timeout -> Timeout -> Bool
Eq, Int -> Timeout
Timeout -> Int
Timeout -> [Timeout]
Timeout -> Timeout
Timeout -> Timeout -> [Timeout]
Timeout -> Timeout -> Timeout -> [Timeout]
(Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Int -> Timeout)
-> (Timeout -> Int)
-> (Timeout -> [Timeout])
-> (Timeout -> Timeout -> [Timeout])
-> (Timeout -> Timeout -> [Timeout])
-> (Timeout -> Timeout -> Timeout -> [Timeout])
-> Enum Timeout
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Timeout -> Timeout -> Timeout -> [Timeout]
$cenumFromThenTo :: Timeout -> Timeout -> Timeout -> [Timeout]
enumFromTo :: Timeout -> Timeout -> [Timeout]
$cenumFromTo :: Timeout -> Timeout -> [Timeout]
enumFromThen :: Timeout -> Timeout -> [Timeout]
$cenumFromThen :: Timeout -> Timeout -> [Timeout]
enumFrom :: Timeout -> [Timeout]
$cenumFrom :: Timeout -> [Timeout]
fromEnum :: Timeout -> Int
$cfromEnum :: Timeout -> Int
toEnum :: Int -> Timeout
$ctoEnum :: Int -> Timeout
pred :: Timeout -> Timeout
$cpred :: Timeout -> Timeout
succ :: Timeout -> Timeout
$csucc :: Timeout -> Timeout
Enum, Integer -> Timeout
Timeout -> Timeout
Timeout -> Timeout -> Timeout
(Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Integer -> Timeout)
-> Num Timeout
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Timeout
$cfromInteger :: Integer -> Timeout
signum :: Timeout -> Timeout
$csignum :: Timeout -> Timeout
abs :: Timeout -> Timeout
$cabs :: Timeout -> Timeout
negate :: Timeout -> Timeout
$cnegate :: Timeout -> Timeout
* :: Timeout -> Timeout -> Timeout
$c* :: Timeout -> Timeout -> Timeout
- :: Timeout -> Timeout -> Timeout
$c- :: Timeout -> Timeout -> Timeout
+ :: Timeout -> Timeout -> Timeout
$c+ :: Timeout -> Timeout -> Timeout
Num, Eq Timeout
Eq Timeout
-> (Timeout -> Timeout -> Ordering)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> Ord Timeout
Timeout -> Timeout -> Bool
Timeout -> Timeout -> Ordering
Timeout -> Timeout -> Timeout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Timeout -> Timeout -> Timeout
$cmin :: Timeout -> Timeout -> Timeout
max :: Timeout -> Timeout -> Timeout
$cmax :: Timeout -> Timeout -> Timeout
>= :: Timeout -> Timeout -> Bool
$c>= :: Timeout -> Timeout -> Bool
> :: Timeout -> Timeout -> Bool
$c> :: Timeout -> Timeout -> Bool
<= :: Timeout -> Timeout -> Bool
$c<= :: Timeout -> Timeout -> Bool
< :: Timeout -> Timeout -> Bool
$c< :: Timeout -> Timeout -> Bool
compare :: Timeout -> Timeout -> Ordering
$ccompare :: Timeout -> Timeout -> Ordering
$cp1Ord :: Eq Timeout
Ord, Num Timeout
Ord Timeout
Num Timeout -> Ord Timeout -> (Timeout -> Rational) -> Real Timeout
Timeout -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Timeout -> Rational
$ctoRational :: Timeout -> Rational
$cp2Real :: Ord Timeout
$cp1Real :: Num Timeout
Real, Enum Timeout
Real Timeout
Real Timeout
-> Enum Timeout
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> (Timeout, Timeout))
-> (Timeout -> Timeout -> (Timeout, Timeout))
-> (Timeout -> Integer)
-> Integral Timeout
Timeout -> Integer
Timeout -> Timeout -> (Timeout, Timeout)
Timeout -> Timeout -> Timeout
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Timeout -> Integer
$ctoInteger :: Timeout -> Integer
divMod :: Timeout -> Timeout -> (Timeout, Timeout)
$cdivMod :: Timeout -> Timeout -> (Timeout, Timeout)
quotRem :: Timeout -> Timeout -> (Timeout, Timeout)
$cquotRem :: Timeout -> Timeout -> (Timeout, Timeout)
mod :: Timeout -> Timeout -> Timeout
$cmod :: Timeout -> Timeout -> Timeout
div :: Timeout -> Timeout -> Timeout
$cdiv :: Timeout -> Timeout -> Timeout
rem :: Timeout -> Timeout -> Timeout
$crem :: Timeout -> Timeout -> Timeout
quot :: Timeout -> Timeout -> Timeout
$cquot :: Timeout -> Timeout -> Timeout
$cp2Integral :: Enum Timeout
$cp1Integral :: Real Timeout
Integral)

-- | Represents the Vendor of the add-on; which will be you. Put your details in this structure.
data Vendor = Vendor
   { Vendor -> Name Vendor
vendorName :: Name Vendor -- ^ Your name as a Vendor. Might be your personal name or your business name.
   , Vendor -> URI
vendorUrl :: NU.URI -- ^ A URL to a website that represents you as a vendor.
   } deriving (Int -> Vendor -> ShowS
[Vendor] -> ShowS
Vendor -> String
(Int -> Vendor -> ShowS)
-> (Vendor -> String) -> ([Vendor] -> ShowS) -> Show Vendor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vendor] -> ShowS
$cshowList :: [Vendor] -> ShowS
show :: Vendor -> String
$cshow :: Vendor -> String
showsPrec :: Int -> Vendor -> ShowS
$cshowsPrec :: Int -> Vendor -> ShowS
Show, Vendor -> Vendor -> Bool
(Vendor -> Vendor -> Bool)
-> (Vendor -> Vendor -> Bool) -> Eq Vendor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vendor -> Vendor -> Bool
$c/= :: Vendor -> Vendor -> Bool
== :: Vendor -> Vendor -> Bool
$c== :: Vendor -> Vendor -> Bool
Eq, (forall x. Vendor -> Rep Vendor x)
-> (forall x. Rep Vendor x -> Vendor) -> Generic Vendor
forall x. Rep Vendor x -> Vendor
forall x. Vendor -> Rep Vendor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vendor x -> Vendor
$cfrom :: forall x. Vendor -> Rep Vendor x
Generic)

-- | If your Atlassian Connect addon wants to perform any server side communication with the host product then you will
-- need to use authentication. Otherwise you should specify that you don't need authentication.
data Authentication = Authentication
   { Authentication -> AuthType
authType :: AuthType -- ^ The authentication type that you wish to use.
   } deriving (Int -> Authentication -> ShowS
[Authentication] -> ShowS
Authentication -> String
(Int -> Authentication -> ShowS)
-> (Authentication -> String)
-> ([Authentication] -> ShowS)
-> Show Authentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authentication] -> ShowS
$cshowList :: [Authentication] -> ShowS
show :: Authentication -> String
$cshow :: Authentication -> String
showsPrec :: Int -> Authentication -> ShowS
$cshowsPrec :: Int -> Authentication -> ShowS
Show, Authentication -> Authentication -> Bool
(Authentication -> Authentication -> Bool)
-> (Authentication -> Authentication -> Bool) -> Eq Authentication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authentication -> Authentication -> Bool
$c/= :: Authentication -> Authentication -> Bool
== :: Authentication -> Authentication -> Bool
$c== :: Authentication -> Authentication -> Bool
Eq, (forall x. Authentication -> Rep Authentication x)
-> (forall x. Rep Authentication x -> Authentication)
-> Generic Authentication
forall x. Rep Authentication x -> Authentication
forall x. Authentication -> Rep Authentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Authentication x -> Authentication
$cfrom :: forall x. Authentication -> Rep Authentication x
Generic)

-- | The authentication type that you wish to use in your Add-on.
data AuthType
   = Jwt -- ^ If you need to communicate with the host product then you will want to request JWT authentication.
   | None -- ^ If you do not need to communicate the host product then you should request None for authentication.
   deriving (Int -> AuthType -> ShowS
[AuthType] -> ShowS
AuthType -> String
(Int -> AuthType -> ShowS)
-> (AuthType -> String) -> ([AuthType] -> ShowS) -> Show AuthType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthType] -> ShowS
$cshowList :: [AuthType] -> ShowS
show :: AuthType -> String
$cshow :: AuthType -> String
showsPrec :: Int -> AuthType -> ShowS
$cshowsPrec :: Int -> AuthType -> ShowS
Show, AuthType -> AuthType -> Bool
(AuthType -> AuthType -> Bool)
-> (AuthType -> AuthType -> Bool) -> Eq AuthType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthType -> AuthType -> Bool
$c/= :: AuthType -> AuthType -> Bool
== :: AuthType -> AuthType -> Bool
$c== :: AuthType -> AuthType -> Bool
Eq, (forall x. AuthType -> Rep AuthType x)
-> (forall x. Rep AuthType x -> AuthType) -> Generic AuthType
forall x. Rep AuthType x -> AuthType
forall x. AuthType -> Rep AuthType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthType x -> AuthType
$cfrom :: forall x. AuthType -> Rep AuthType x
Generic)

-- | Represents an arbitrary icon. Potentially for an Atlassian Connect module or for the entire add-on itself.
data IconDetails = IconDetails
   { IconDetails -> Text
iconUrl    :: Text -- ^ The URI to the icon.
   , IconDetails -> Maybe Integer
iconWidth  :: Maybe Integer -- ^ The width of the icon.
   , IconDetails -> Maybe Integer
iconHeight :: Maybe Integer -- ^ The height of the icon.
   } deriving (Int -> IconDetails -> ShowS
[IconDetails] -> ShowS
IconDetails -> String
(Int -> IconDetails -> ShowS)
-> (IconDetails -> String)
-> ([IconDetails] -> ShowS)
-> Show IconDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IconDetails] -> ShowS
$cshowList :: [IconDetails] -> ShowS
show :: IconDetails -> String
$cshow :: IconDetails -> String
showsPrec :: Int -> IconDetails -> ShowS
$cshowsPrec :: Int -> IconDetails -> ShowS
Show, (forall x. IconDetails -> Rep IconDetails x)
-> (forall x. Rep IconDetails x -> IconDetails)
-> Generic IconDetails
forall x. Rep IconDetails x -> IconDetails
forall x. IconDetails -> Rep IconDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IconDetails x -> IconDetails
$cfrom :: forall x. IconDetails -> Rep IconDetails x
Generic)

-- | Atlassian Connect descriptors contain many names: module names, add-on names, vendor names etc. We want to make sure
-- that these names don't get put in places that they do not belong. Or, if they do get moved around, they get moved around
-- specifically. We are just adding type saefty to names.
data Name a = Name Text deriving (Int -> Name a -> ShowS
[Name a] -> ShowS
Name a -> String
(Int -> Name a -> ShowS)
-> (Name a -> String) -> ([Name a] -> ShowS) -> Show (Name a)
forall a. Int -> Name a -> ShowS
forall a. [Name a] -> ShowS
forall a. Name a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name a] -> ShowS
$cshowList :: forall a. [Name a] -> ShowS
show :: Name a -> String
$cshow :: forall a. Name a -> String
showsPrec :: Int -> Name a -> ShowS
$cshowsPrec :: forall a. Int -> Name a -> ShowS
Show, Name a -> Name a -> Bool
(Name a -> Name a -> Bool)
-> (Name a -> Name a -> Bool) -> Eq (Name a)
forall a. Name a -> Name a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name a -> Name a -> Bool
$c/= :: forall a. Name a -> Name a -> Bool
== :: Name a -> Name a -> Bool
$c== :: forall a. Name a -> Name a -> Bool
Eq, (forall x. Name a -> Rep (Name a) x)
-> (forall x. Rep (Name a) x -> Name a) -> Generic (Name a)
forall x. Rep (Name a) x -> Name a
forall x. Name a -> Rep (Name a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Name a) x -> Name a
forall a x. Name a -> Rep (Name a) x
$cto :: forall a x. Rep (Name a) x -> Name a
$cfrom :: forall a x. Name a -> Rep (Name a) x
Generic)

-- | Represents a standard text type in the descriptor than may be Internationalised in the future. However, currently
-- there is no I18n support: <http://goo.gl/9vJEsW>
data I18nText = I18nText
   { I18nText -> Text
dValue :: Text -- ^ The raw text value that will show.
   , I18nText -> Maybe Text
dI18n  :: Maybe Text -- ^ The potential i18n key that will be used when we eventually have I18n support: <http://goo.gl/9vJEsW>
   } deriving (Int -> I18nText -> ShowS
[I18nText] -> ShowS
I18nText -> String
(Int -> I18nText -> ShowS)
-> (I18nText -> String) -> ([I18nText] -> ShowS) -> Show I18nText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [I18nText] -> ShowS
$cshowList :: [I18nText] -> ShowS
show :: I18nText -> String
$cshow :: I18nText -> String
showsPrec :: Int -> I18nText -> ShowS
$cshowsPrec :: Int -> I18nText -> ShowS
Show, (forall x. I18nText -> Rep I18nText x)
-> (forall x. Rep I18nText x -> I18nText) -> Generic I18nText
forall x. Rep I18nText x -> I18nText
forall x. I18nText -> Rep I18nText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep I18nText x -> I18nText
$cfrom :: forall x. I18nText -> Rep I18nText x
Generic)

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

-- | Since there is currently no I18n support (<http://goo.gl/9vJEsW>) we have this helper method to quickly create an 'I18nText' from a standard
-- 'Text' object.
simpleText :: Text -> I18nText
simpleText :: Text -> I18nText
simpleText Text
t = I18nText :: Text -> Maybe Text -> I18nText
I18nText { dValue :: Text
dValue = Text
t, dI18n :: Maybe Text
dI18n = Maybe Text
forall a. Maybe a
Nothing }

-- | This represents a URL wrapped as an object instead of as a plain text element.
data URLBean = URLBean
   { URLBean -> Text
ubUrl :: Text -- ^ The raw URL.
   } deriving (Int -> URLBean -> ShowS
[URLBean] -> ShowS
URLBean -> String
(Int -> URLBean -> ShowS)
-> (URLBean -> String) -> ([URLBean] -> ShowS) -> Show URLBean
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URLBean] -> ShowS
$cshowList :: [URLBean] -> ShowS
show :: URLBean -> String
$cshow :: URLBean -> String
showsPrec :: Int -> URLBean -> ShowS
$cshowsPrec :: Int -> URLBean -> ShowS
Show, (forall x. URLBean -> Rep URLBean x)
-> (forall x. Rep URLBean x -> URLBean) -> Generic URLBean
forall x. Rep URLBean x -> URLBean
forall x. URLBean -> Rep URLBean x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URLBean x -> URLBean
$cfrom :: forall x. URLBean -> Rep URLBean x
Generic)

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

-- | Wrap a regular 'Text' based URL inside a URLBean.
toUrl :: Text -> URLBean
toUrl :: Text -> URLBean
toUrl = Text -> URLBean
URLBean

instance ToJSON (Name PluginKey)
instance ToJSON (Name Vendor)

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

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

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

instance ToJSON AuthType where
   toJSON :: AuthType -> Value
toJSON AuthType
Jwt  = Value
"jwt"
   toJSON AuthType
None  = Value
"none"

-- | A basic length type for HTML elements. Useful for 'WebPanel's and other modules that may require length specifications.
data Length
   = Pixels Integer -- ^ Specify a length in pixels
   | Percentage Integer -- ^ Specify a length as a percentage in the range [0-100].
   deriving (Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
(Int -> Length -> ShowS)
-> (Length -> String) -> ([Length] -> ShowS) -> Show Length
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, (forall x. Length -> Rep Length x)
-> (forall x. Rep Length x -> Length) -> Generic Length
forall x. Rep Length x -> Length
forall x. Length -> Rep Length x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Length x -> Length
$cfrom :: forall x. Length -> Rep Length x
Generic)

instance ToJSON Length where
   toJSON :: Length -> Value
toJSON (Pixels Integer
x) = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ (Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"px")
   toJSON (Percentage Integer
x) = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ (Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%")