{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module with modifiers for pull requests' and issues' listings.

module GitHub.Data.Options (
    -- * Common modifiers
    stateOpen,
    stateClosed,
    stateAll,
    sortAscending,
    sortDescending,
    sortByCreated,
    sortByUpdated,
    -- * Pull Requests
    PullRequestMod,
    prModToQueryString,
    optionsBase,
    optionsNoBase,
    optionsHead,
    optionsNoHead,
    sortByPopularity,
    sortByLongRunning,
    -- * Issues
    IssueMod,
    issueModToQueryString,
    sortByComments,
    optionsLabels,
    optionsSince,
    optionsSinceAll,
    optionsAssignedIssues,
    optionsCreatedIssues,
    optionsMentionedIssues,
    optionsSubscribedIssues,
    optionsAllIssues,
    -- * Repo issues
    IssueRepoMod,
    issueRepoModToQueryString,
    optionsCreator,
    optionsMentioned,
    optionsIrrelevantMilestone,
    optionsAnyMilestone,
    optionsNoMilestone,
    optionsMilestone,
    optionsIrrelevantAssignee,
    optionsAnyAssignee,
    optionsNoAssignee,
    optionsAssignee,
    -- * Actions artifacts
    ArtifactMod,
    artifactModToQueryString,
    optionsArtifactName,
    -- * Actions cache
    CacheMod,
    cacheModToQueryString,
    optionsRef,
    optionsNoRef,
    optionsKey,
    optionsNoKey,
    optionsDirectionAsc,
    optionsDirectionDesc,
    sortByCreatedAt,
    sortByLastAccessedAt,
    sortBySizeInBytes,
    -- * Actions workflow runs
    WorkflowRunMod,
    workflowRunModToQueryString,
    optionsWorkflowRunActor,
    optionsWorkflowRunBranch,
    optionsWorkflowRunEvent,
    optionsWorkflowRunStatus,
    optionsWorkflowRunCreated,
    optionsWorkflowRunHeadSha,
    -- * Data
    IssueState (..),
    IssueStateReason (..),
    MergeableState (..),
    -- * Internal
    HasState,
    HasDirection,
    HasCreatedUpdated,
    HasComments,
    HasLabels,
    HasSince,
    ) where

import GitHub.Data.Definitions
import GitHub.Data.Id          (Id, untagId)
import GitHub.Data.Milestone   (Milestone)
import GitHub.Data.Name        (Name, untagName)
import GitHub.Internal.Prelude
import Prelude ()

import qualified Data.Text          as T
import qualified Data.Text.Encoding as TE

-------------------------------------------------------------------------------
-- Data
-------------------------------------------------------------------------------

-- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state
data IssueState
    = StateOpen
    | StateClosed
  deriving
    (IssueState -> IssueState -> Bool
(IssueState -> IssueState -> Bool)
-> (IssueState -> IssueState -> Bool) -> Eq IssueState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueState -> IssueState -> Bool
== :: IssueState -> IssueState -> Bool
$c/= :: IssueState -> IssueState -> Bool
/= :: IssueState -> IssueState -> Bool
Eq, Eq IssueState
Eq IssueState =>
(IssueState -> IssueState -> Ordering)
-> (IssueState -> IssueState -> Bool)
-> (IssueState -> IssueState -> Bool)
-> (IssueState -> IssueState -> Bool)
-> (IssueState -> IssueState -> Bool)
-> (IssueState -> IssueState -> IssueState)
-> (IssueState -> IssueState -> IssueState)
-> Ord IssueState
IssueState -> IssueState -> Bool
IssueState -> IssueState -> Ordering
IssueState -> IssueState -> IssueState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueState -> IssueState -> Ordering
compare :: IssueState -> IssueState -> Ordering
$c< :: IssueState -> IssueState -> Bool
< :: IssueState -> IssueState -> Bool
$c<= :: IssueState -> IssueState -> Bool
<= :: IssueState -> IssueState -> Bool
$c> :: IssueState -> IssueState -> Bool
> :: IssueState -> IssueState -> Bool
$c>= :: IssueState -> IssueState -> Bool
>= :: IssueState -> IssueState -> Bool
$cmax :: IssueState -> IssueState -> IssueState
max :: IssueState -> IssueState -> IssueState
$cmin :: IssueState -> IssueState -> IssueState
min :: IssueState -> IssueState -> IssueState
Ord, Int -> IssueState -> ShowS
[IssueState] -> ShowS
IssueState -> String
(Int -> IssueState -> ShowS)
-> (IssueState -> String)
-> ([IssueState] -> ShowS)
-> Show IssueState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueState -> ShowS
showsPrec :: Int -> IssueState -> ShowS
$cshow :: IssueState -> String
show :: IssueState -> String
$cshowList :: [IssueState] -> ShowS
showList :: [IssueState] -> ShowS
Show, Int -> IssueState
IssueState -> Int
IssueState -> [IssueState]
IssueState -> IssueState
IssueState -> IssueState -> [IssueState]
IssueState -> IssueState -> IssueState -> [IssueState]
(IssueState -> IssueState)
-> (IssueState -> IssueState)
-> (Int -> IssueState)
-> (IssueState -> Int)
-> (IssueState -> [IssueState])
-> (IssueState -> IssueState -> [IssueState])
-> (IssueState -> IssueState -> [IssueState])
-> (IssueState -> IssueState -> IssueState -> [IssueState])
-> Enum IssueState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IssueState -> IssueState
succ :: IssueState -> IssueState
$cpred :: IssueState -> IssueState
pred :: IssueState -> IssueState
$ctoEnum :: Int -> IssueState
toEnum :: Int -> IssueState
$cfromEnum :: IssueState -> Int
fromEnum :: IssueState -> Int
$cenumFrom :: IssueState -> [IssueState]
enumFrom :: IssueState -> [IssueState]
$cenumFromThen :: IssueState -> IssueState -> [IssueState]
enumFromThen :: IssueState -> IssueState -> [IssueState]
$cenumFromTo :: IssueState -> IssueState -> [IssueState]
enumFromTo :: IssueState -> IssueState -> [IssueState]
$cenumFromThenTo :: IssueState -> IssueState -> IssueState -> [IssueState]
enumFromThenTo :: IssueState -> IssueState -> IssueState -> [IssueState]
Enum, IssueState
IssueState -> IssueState -> Bounded IssueState
forall a. a -> a -> Bounded a
$cminBound :: IssueState
minBound :: IssueState
$cmaxBound :: IssueState
maxBound :: IssueState
Bounded, (forall x. IssueState -> Rep IssueState x)
-> (forall x. Rep IssueState x -> IssueState) -> Generic IssueState
forall x. Rep IssueState x -> IssueState
forall x. IssueState -> Rep IssueState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IssueState -> Rep IssueState x
from :: forall x. IssueState -> Rep IssueState x
$cto :: forall x. Rep IssueState x -> IssueState
to :: forall x. Rep IssueState x -> IssueState
Generic, Typeable, Typeable IssueState
Typeable IssueState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IssueState -> c IssueState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueState)
-> (IssueState -> Constr)
-> (IssueState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IssueState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IssueState))
-> ((forall b. Data b => b -> b) -> IssueState -> IssueState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueState -> r)
-> (forall u. (forall d. Data d => d -> u) -> IssueState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IssueState -> m IssueState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueState -> m IssueState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueState -> m IssueState)
-> Data IssueState
IssueState -> Constr
IssueState -> DataType
(forall b. Data b => b -> b) -> IssueState -> IssueState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IssueState -> u
forall u. (forall d. Data d => d -> u) -> IssueState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueState -> c IssueState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueState)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueState -> c IssueState
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueState -> c IssueState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueState
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueState
$ctoConstr :: IssueState -> Constr
toConstr :: IssueState -> Constr
$cdataTypeOf :: IssueState -> DataType
dataTypeOf :: IssueState -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueState)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueState)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueState)
$cgmapT :: (forall b. Data b => b -> b) -> IssueState -> IssueState
gmapT :: (forall b. Data b => b -> b) -> IssueState -> IssueState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueState -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueState -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueState -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueState -> m IssueState
Data)

instance ToJSON IssueState where
    toJSON :: IssueState -> Value
toJSON IssueState
StateOpen    = Text -> Value
String Text
"open"
    toJSON IssueState
StateClosed  = Text -> Value
String Text
"closed"

instance FromJSON IssueState where
    parseJSON :: Value -> Parser IssueState
parseJSON = String -> (Text -> Parser IssueState) -> Value -> Parser IssueState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IssueState" ((Text -> Parser IssueState) -> Value -> Parser IssueState)
-> (Text -> Parser IssueState) -> Value -> Parser IssueState
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"open"   -> IssueState -> Parser IssueState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IssueState
StateOpen
        Text
"closed" -> IssueState -> Parser IssueState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IssueState
StateClosed
        Text
_        -> String -> Parser IssueState
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IssueState) -> String -> Parser IssueState
forall a b. (a -> b) -> a -> b
$ String
"Unknown IssueState: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

instance NFData IssueState where rnf :: IssueState -> ()
rnf = IssueState -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary IssueState

-- | 'GitHub.Data.Issues.Issue' state reason
data IssueStateReason
    = StateReasonCompleted
    | StateReasonNotPlanned
    | StateReasonReopened
  deriving
    (IssueStateReason -> IssueStateReason -> Bool
(IssueStateReason -> IssueStateReason -> Bool)
-> (IssueStateReason -> IssueStateReason -> Bool)
-> Eq IssueStateReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueStateReason -> IssueStateReason -> Bool
== :: IssueStateReason -> IssueStateReason -> Bool
$c/= :: IssueStateReason -> IssueStateReason -> Bool
/= :: IssueStateReason -> IssueStateReason -> Bool
Eq, Eq IssueStateReason
Eq IssueStateReason =>
(IssueStateReason -> IssueStateReason -> Ordering)
-> (IssueStateReason -> IssueStateReason -> Bool)
-> (IssueStateReason -> IssueStateReason -> Bool)
-> (IssueStateReason -> IssueStateReason -> Bool)
-> (IssueStateReason -> IssueStateReason -> Bool)
-> (IssueStateReason -> IssueStateReason -> IssueStateReason)
-> (IssueStateReason -> IssueStateReason -> IssueStateReason)
-> Ord IssueStateReason
IssueStateReason -> IssueStateReason -> Bool
IssueStateReason -> IssueStateReason -> Ordering
IssueStateReason -> IssueStateReason -> IssueStateReason
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueStateReason -> IssueStateReason -> Ordering
compare :: IssueStateReason -> IssueStateReason -> Ordering
$c< :: IssueStateReason -> IssueStateReason -> Bool
< :: IssueStateReason -> IssueStateReason -> Bool
$c<= :: IssueStateReason -> IssueStateReason -> Bool
<= :: IssueStateReason -> IssueStateReason -> Bool
$c> :: IssueStateReason -> IssueStateReason -> Bool
> :: IssueStateReason -> IssueStateReason -> Bool
$c>= :: IssueStateReason -> IssueStateReason -> Bool
>= :: IssueStateReason -> IssueStateReason -> Bool
$cmax :: IssueStateReason -> IssueStateReason -> IssueStateReason
max :: IssueStateReason -> IssueStateReason -> IssueStateReason
$cmin :: IssueStateReason -> IssueStateReason -> IssueStateReason
min :: IssueStateReason -> IssueStateReason -> IssueStateReason
Ord, Int -> IssueStateReason -> ShowS
[IssueStateReason] -> ShowS
IssueStateReason -> String
(Int -> IssueStateReason -> ShowS)
-> (IssueStateReason -> String)
-> ([IssueStateReason] -> ShowS)
-> Show IssueStateReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueStateReason -> ShowS
showsPrec :: Int -> IssueStateReason -> ShowS
$cshow :: IssueStateReason -> String
show :: IssueStateReason -> String
$cshowList :: [IssueStateReason] -> ShowS
showList :: [IssueStateReason] -> ShowS
Show, Int -> IssueStateReason
IssueStateReason -> Int
IssueStateReason -> [IssueStateReason]
IssueStateReason -> IssueStateReason
IssueStateReason -> IssueStateReason -> [IssueStateReason]
IssueStateReason
-> IssueStateReason -> IssueStateReason -> [IssueStateReason]
(IssueStateReason -> IssueStateReason)
-> (IssueStateReason -> IssueStateReason)
-> (Int -> IssueStateReason)
-> (IssueStateReason -> Int)
-> (IssueStateReason -> [IssueStateReason])
-> (IssueStateReason -> IssueStateReason -> [IssueStateReason])
-> (IssueStateReason -> IssueStateReason -> [IssueStateReason])
-> (IssueStateReason
    -> IssueStateReason -> IssueStateReason -> [IssueStateReason])
-> Enum IssueStateReason
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IssueStateReason -> IssueStateReason
succ :: IssueStateReason -> IssueStateReason
$cpred :: IssueStateReason -> IssueStateReason
pred :: IssueStateReason -> IssueStateReason
$ctoEnum :: Int -> IssueStateReason
toEnum :: Int -> IssueStateReason
$cfromEnum :: IssueStateReason -> Int
fromEnum :: IssueStateReason -> Int
$cenumFrom :: IssueStateReason -> [IssueStateReason]
enumFrom :: IssueStateReason -> [IssueStateReason]
$cenumFromThen :: IssueStateReason -> IssueStateReason -> [IssueStateReason]
enumFromThen :: IssueStateReason -> IssueStateReason -> [IssueStateReason]
$cenumFromTo :: IssueStateReason -> IssueStateReason -> [IssueStateReason]
enumFromTo :: IssueStateReason -> IssueStateReason -> [IssueStateReason]
$cenumFromThenTo :: IssueStateReason
-> IssueStateReason -> IssueStateReason -> [IssueStateReason]
enumFromThenTo :: IssueStateReason
-> IssueStateReason -> IssueStateReason -> [IssueStateReason]
Enum, IssueStateReason
IssueStateReason -> IssueStateReason -> Bounded IssueStateReason
forall a. a -> a -> Bounded a
$cminBound :: IssueStateReason
minBound :: IssueStateReason
$cmaxBound :: IssueStateReason
maxBound :: IssueStateReason
Bounded, (forall x. IssueStateReason -> Rep IssueStateReason x)
-> (forall x. Rep IssueStateReason x -> IssueStateReason)
-> Generic IssueStateReason
forall x. Rep IssueStateReason x -> IssueStateReason
forall x. IssueStateReason -> Rep IssueStateReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IssueStateReason -> Rep IssueStateReason x
from :: forall x. IssueStateReason -> Rep IssueStateReason x
$cto :: forall x. Rep IssueStateReason x -> IssueStateReason
to :: forall x. Rep IssueStateReason x -> IssueStateReason
Generic, Typeable, Typeable IssueStateReason
Typeable IssueStateReason =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IssueStateReason -> c IssueStateReason)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueStateReason)
-> (IssueStateReason -> Constr)
-> (IssueStateReason -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IssueStateReason))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IssueStateReason))
-> ((forall b. Data b => b -> b)
    -> IssueStateReason -> IssueStateReason)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> IssueStateReason -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueStateReason -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> IssueStateReason -> m IssueStateReason)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IssueStateReason -> m IssueStateReason)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IssueStateReason -> m IssueStateReason)
-> Data IssueStateReason
IssueStateReason -> Constr
IssueStateReason -> DataType
(forall b. Data b => b -> b)
-> IssueStateReason -> IssueStateReason
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> IssueStateReason -> u
forall u. (forall d. Data d => d -> u) -> IssueStateReason -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueStateReason
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueStateReason -> c IssueStateReason
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueStateReason)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueStateReason)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueStateReason -> c IssueStateReason
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueStateReason -> c IssueStateReason
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueStateReason
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueStateReason
$ctoConstr :: IssueStateReason -> Constr
toConstr :: IssueStateReason -> Constr
$cdataTypeOf :: IssueStateReason -> DataType
dataTypeOf :: IssueStateReason -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueStateReason)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueStateReason)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueStateReason)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueStateReason)
$cgmapT :: (forall b. Data b => b -> b)
-> IssueStateReason -> IssueStateReason
gmapT :: (forall b. Data b => b -> b)
-> IssueStateReason -> IssueStateReason
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueStateReason -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueStateReason -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueStateReason -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IssueStateReason -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IssueStateReason -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueStateReason -> m IssueStateReason
Data)

instance ToJSON IssueStateReason where
    toJSON :: IssueStateReason -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (IssueStateReason -> Text) -> IssueStateReason -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      IssueStateReason
StateReasonCompleted  -> Text
"completed"
      IssueStateReason
StateReasonNotPlanned -> Text
"not_planned"
      IssueStateReason
StateReasonReopened   -> Text
"reopened"

instance FromJSON IssueStateReason where
    parseJSON :: Value -> Parser IssueStateReason
parseJSON = String
-> (Text -> Parser IssueStateReason)
-> Value
-> Parser IssueStateReason
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"IssueStateReason" ((Text -> Parser IssueStateReason)
 -> Value -> Parser IssueStateReason)
-> (Text -> Parser IssueStateReason)
-> Value
-> Parser IssueStateReason
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"completed"   -> IssueStateReason -> Parser IssueStateReason
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IssueStateReason
StateReasonCompleted
        Text
"not_planned" -> IssueStateReason -> Parser IssueStateReason
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IssueStateReason
StateReasonNotPlanned
        Text
"reopened"    -> IssueStateReason -> Parser IssueStateReason
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IssueStateReason
StateReasonReopened
        Text
_ -> String -> Parser IssueStateReason
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser IssueStateReason)
-> String -> Parser IssueStateReason
forall a b. (a -> b) -> a -> b
$ String
"Unknown IssueStateReason: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

instance NFData IssueStateReason where rnf :: IssueStateReason -> ()
rnf = IssueStateReason -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary IssueStateReason

-- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state
data MergeableState
    = StateUnknown
    | StateClean
    | StateDirty
    | StateUnstable
    | StateBlocked
    | StateBehind
    | StateDraft
  deriving
    (MergeableState -> MergeableState -> Bool
(MergeableState -> MergeableState -> Bool)
-> (MergeableState -> MergeableState -> Bool) -> Eq MergeableState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MergeableState -> MergeableState -> Bool
== :: MergeableState -> MergeableState -> Bool
$c/= :: MergeableState -> MergeableState -> Bool
/= :: MergeableState -> MergeableState -> Bool
Eq, Eq MergeableState
Eq MergeableState =>
(MergeableState -> MergeableState -> Ordering)
-> (MergeableState -> MergeableState -> Bool)
-> (MergeableState -> MergeableState -> Bool)
-> (MergeableState -> MergeableState -> Bool)
-> (MergeableState -> MergeableState -> Bool)
-> (MergeableState -> MergeableState -> MergeableState)
-> (MergeableState -> MergeableState -> MergeableState)
-> Ord MergeableState
MergeableState -> MergeableState -> Bool
MergeableState -> MergeableState -> Ordering
MergeableState -> MergeableState -> MergeableState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MergeableState -> MergeableState -> Ordering
compare :: MergeableState -> MergeableState -> Ordering
$c< :: MergeableState -> MergeableState -> Bool
< :: MergeableState -> MergeableState -> Bool
$c<= :: MergeableState -> MergeableState -> Bool
<= :: MergeableState -> MergeableState -> Bool
$c> :: MergeableState -> MergeableState -> Bool
> :: MergeableState -> MergeableState -> Bool
$c>= :: MergeableState -> MergeableState -> Bool
>= :: MergeableState -> MergeableState -> Bool
$cmax :: MergeableState -> MergeableState -> MergeableState
max :: MergeableState -> MergeableState -> MergeableState
$cmin :: MergeableState -> MergeableState -> MergeableState
min :: MergeableState -> MergeableState -> MergeableState
Ord, Int -> MergeableState -> ShowS
[MergeableState] -> ShowS
MergeableState -> String
(Int -> MergeableState -> ShowS)
-> (MergeableState -> String)
-> ([MergeableState] -> ShowS)
-> Show MergeableState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MergeableState -> ShowS
showsPrec :: Int -> MergeableState -> ShowS
$cshow :: MergeableState -> String
show :: MergeableState -> String
$cshowList :: [MergeableState] -> ShowS
showList :: [MergeableState] -> ShowS
Show, Int -> MergeableState
MergeableState -> Int
MergeableState -> [MergeableState]
MergeableState -> MergeableState
MergeableState -> MergeableState -> [MergeableState]
MergeableState
-> MergeableState -> MergeableState -> [MergeableState]
(MergeableState -> MergeableState)
-> (MergeableState -> MergeableState)
-> (Int -> MergeableState)
-> (MergeableState -> Int)
-> (MergeableState -> [MergeableState])
-> (MergeableState -> MergeableState -> [MergeableState])
-> (MergeableState -> MergeableState -> [MergeableState])
-> (MergeableState
    -> MergeableState -> MergeableState -> [MergeableState])
-> Enum MergeableState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MergeableState -> MergeableState
succ :: MergeableState -> MergeableState
$cpred :: MergeableState -> MergeableState
pred :: MergeableState -> MergeableState
$ctoEnum :: Int -> MergeableState
toEnum :: Int -> MergeableState
$cfromEnum :: MergeableState -> Int
fromEnum :: MergeableState -> Int
$cenumFrom :: MergeableState -> [MergeableState]
enumFrom :: MergeableState -> [MergeableState]
$cenumFromThen :: MergeableState -> MergeableState -> [MergeableState]
enumFromThen :: MergeableState -> MergeableState -> [MergeableState]
$cenumFromTo :: MergeableState -> MergeableState -> [MergeableState]
enumFromTo :: MergeableState -> MergeableState -> [MergeableState]
$cenumFromThenTo :: MergeableState
-> MergeableState -> MergeableState -> [MergeableState]
enumFromThenTo :: MergeableState
-> MergeableState -> MergeableState -> [MergeableState]
Enum, MergeableState
MergeableState -> MergeableState -> Bounded MergeableState
forall a. a -> a -> Bounded a
$cminBound :: MergeableState
minBound :: MergeableState
$cmaxBound :: MergeableState
maxBound :: MergeableState
Bounded, (forall x. MergeableState -> Rep MergeableState x)
-> (forall x. Rep MergeableState x -> MergeableState)
-> Generic MergeableState
forall x. Rep MergeableState x -> MergeableState
forall x. MergeableState -> Rep MergeableState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MergeableState -> Rep MergeableState x
from :: forall x. MergeableState -> Rep MergeableState x
$cto :: forall x. Rep MergeableState x -> MergeableState
to :: forall x. Rep MergeableState x -> MergeableState
Generic, Typeable, Typeable MergeableState
Typeable MergeableState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MergeableState -> c MergeableState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MergeableState)
-> (MergeableState -> Constr)
-> (MergeableState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MergeableState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MergeableState))
-> ((forall b. Data b => b -> b)
    -> MergeableState -> MergeableState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MergeableState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MergeableState -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> MergeableState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MergeableState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> MergeableState -> m MergeableState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MergeableState -> m MergeableState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> MergeableState -> m MergeableState)
-> Data MergeableState
MergeableState -> Constr
MergeableState -> DataType
(forall b. Data b => b -> b) -> MergeableState -> MergeableState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> MergeableState -> u
forall u. (forall d. Data d => d -> u) -> MergeableState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MergeableState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MergeableState -> c MergeableState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MergeableState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MergeableState)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MergeableState -> c MergeableState
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MergeableState -> c MergeableState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MergeableState
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MergeableState
$ctoConstr :: MergeableState -> Constr
toConstr :: MergeableState -> Constr
$cdataTypeOf :: MergeableState -> DataType
dataTypeOf :: MergeableState -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MergeableState)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MergeableState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MergeableState)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MergeableState)
$cgmapT :: (forall b. Data b => b -> b) -> MergeableState -> MergeableState
gmapT :: (forall b. Data b => b -> b) -> MergeableState -> MergeableState
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MergeableState -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MergeableState -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MergeableState -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MergeableState -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> MergeableState -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> MergeableState -> m MergeableState
Data)

instance ToJSON MergeableState where
    toJSON :: MergeableState -> Value
toJSON MergeableState
StateUnknown  = Text -> Value
String Text
"unknown"
    toJSON MergeableState
StateClean    = Text -> Value
String Text
"clean"
    toJSON MergeableState
StateDirty    = Text -> Value
String Text
"dirty"
    toJSON MergeableState
StateUnstable = Text -> Value
String Text
"unstable"
    toJSON MergeableState
StateBlocked  = Text -> Value
String Text
"blocked"
    toJSON MergeableState
StateBehind   = Text -> Value
String Text
"behind"
    toJSON MergeableState
StateDraft    = Text -> Value
String Text
"draft"

instance FromJSON MergeableState where
    parseJSON :: Value -> Parser MergeableState
parseJSON = String
-> (Text -> Parser MergeableState)
-> Value
-> Parser MergeableState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MergeableState" ((Text -> Parser MergeableState) -> Value -> Parser MergeableState)
-> (Text -> Parser MergeableState)
-> Value
-> Parser MergeableState
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"unknown"  -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateUnknown
        Text
"clean"    -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateClean
        Text
"dirty"    -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateDirty
        Text
"unstable" -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateUnstable
        Text
"blocked"  -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateBlocked
        Text
"behind"   -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateBehind
        Text
"draft"    -> MergeableState -> Parser MergeableState
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeableState
StateDraft
        Text
_          -> String -> Parser MergeableState
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MergeableState)
-> String -> Parser MergeableState
forall a b. (a -> b) -> a -> b
$ String
"Unknown MergeableState: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

instance NFData MergeableState where rnf :: MergeableState -> ()
rnf = MergeableState -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary MergeableState

data SortDirection
    = SortAscending
    | SortDescending
  deriving
    (SortDirection -> SortDirection -> Bool
(SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> Bool) -> Eq SortDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortDirection -> SortDirection -> Bool
== :: SortDirection -> SortDirection -> Bool
$c/= :: SortDirection -> SortDirection -> Bool
/= :: SortDirection -> SortDirection -> Bool
Eq, Eq SortDirection
Eq SortDirection =>
(SortDirection -> SortDirection -> Ordering)
-> (SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> Bool)
-> (SortDirection -> SortDirection -> SortDirection)
-> (SortDirection -> SortDirection -> SortDirection)
-> Ord SortDirection
SortDirection -> SortDirection -> Bool
SortDirection -> SortDirection -> Ordering
SortDirection -> SortDirection -> SortDirection
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SortDirection -> SortDirection -> Ordering
compare :: SortDirection -> SortDirection -> Ordering
$c< :: SortDirection -> SortDirection -> Bool
< :: SortDirection -> SortDirection -> Bool
$c<= :: SortDirection -> SortDirection -> Bool
<= :: SortDirection -> SortDirection -> Bool
$c> :: SortDirection -> SortDirection -> Bool
> :: SortDirection -> SortDirection -> Bool
$c>= :: SortDirection -> SortDirection -> Bool
>= :: SortDirection -> SortDirection -> Bool
$cmax :: SortDirection -> SortDirection -> SortDirection
max :: SortDirection -> SortDirection -> SortDirection
$cmin :: SortDirection -> SortDirection -> SortDirection
min :: SortDirection -> SortDirection -> SortDirection
Ord, Int -> SortDirection -> ShowS
[SortDirection] -> ShowS
SortDirection -> String
(Int -> SortDirection -> ShowS)
-> (SortDirection -> String)
-> ([SortDirection] -> ShowS)
-> Show SortDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortDirection -> ShowS
showsPrec :: Int -> SortDirection -> ShowS
$cshow :: SortDirection -> String
show :: SortDirection -> String
$cshowList :: [SortDirection] -> ShowS
showList :: [SortDirection] -> ShowS
Show, Int -> SortDirection
SortDirection -> Int
SortDirection -> [SortDirection]
SortDirection -> SortDirection
SortDirection -> SortDirection -> [SortDirection]
SortDirection -> SortDirection -> SortDirection -> [SortDirection]
(SortDirection -> SortDirection)
-> (SortDirection -> SortDirection)
-> (Int -> SortDirection)
-> (SortDirection -> Int)
-> (SortDirection -> [SortDirection])
-> (SortDirection -> SortDirection -> [SortDirection])
-> (SortDirection -> SortDirection -> [SortDirection])
-> (SortDirection
    -> SortDirection -> SortDirection -> [SortDirection])
-> Enum SortDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SortDirection -> SortDirection
succ :: SortDirection -> SortDirection
$cpred :: SortDirection -> SortDirection
pred :: SortDirection -> SortDirection
$ctoEnum :: Int -> SortDirection
toEnum :: Int -> SortDirection
$cfromEnum :: SortDirection -> Int
fromEnum :: SortDirection -> Int
$cenumFrom :: SortDirection -> [SortDirection]
enumFrom :: SortDirection -> [SortDirection]
$cenumFromThen :: SortDirection -> SortDirection -> [SortDirection]
enumFromThen :: SortDirection -> SortDirection -> [SortDirection]
$cenumFromTo :: SortDirection -> SortDirection -> [SortDirection]
enumFromTo :: SortDirection -> SortDirection -> [SortDirection]
$cenumFromThenTo :: SortDirection -> SortDirection -> SortDirection -> [SortDirection]
enumFromThenTo :: SortDirection -> SortDirection -> SortDirection -> [SortDirection]
Enum, SortDirection
SortDirection -> SortDirection -> Bounded SortDirection
forall a. a -> a -> Bounded a
$cminBound :: SortDirection
minBound :: SortDirection
$cmaxBound :: SortDirection
maxBound :: SortDirection
Bounded, (forall x. SortDirection -> Rep SortDirection x)
-> (forall x. Rep SortDirection x -> SortDirection)
-> Generic SortDirection
forall x. Rep SortDirection x -> SortDirection
forall x. SortDirection -> Rep SortDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SortDirection -> Rep SortDirection x
from :: forall x. SortDirection -> Rep SortDirection x
$cto :: forall x. Rep SortDirection x -> SortDirection
to :: forall x. Rep SortDirection x -> SortDirection
Generic, Typeable, Typeable SortDirection
Typeable SortDirection =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SortDirection -> c SortDirection)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortDirection)
-> (SortDirection -> Constr)
-> (SortDirection -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortDirection))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SortDirection))
-> ((forall b. Data b => b -> b) -> SortDirection -> SortDirection)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortDirection -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortDirection -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortDirection -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SortDirection -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortDirection -> m SortDirection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortDirection -> m SortDirection)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortDirection -> m SortDirection)
-> Data SortDirection
SortDirection -> Constr
SortDirection -> DataType
(forall b. Data b => b -> b) -> SortDirection -> SortDirection
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortDirection -> u
forall u. (forall d. Data d => d -> u) -> SortDirection -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortDirection
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortDirection -> c SortDirection
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortDirection)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortDirection)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortDirection -> c SortDirection
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortDirection -> c SortDirection
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortDirection
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortDirection
$ctoConstr :: SortDirection -> Constr
toConstr :: SortDirection -> Constr
$cdataTypeOf :: SortDirection -> DataType
dataTypeOf :: SortDirection -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortDirection)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortDirection)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortDirection)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SortDirection)
$cgmapT :: (forall b. Data b => b -> b) -> SortDirection -> SortDirection
gmapT :: (forall b. Data b => b -> b) -> SortDirection -> SortDirection
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortDirection -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortDirection -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SortDirection -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortDirection -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortDirection -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortDirection -> m SortDirection
Data)

instance NFData SortDirection where rnf :: SortDirection -> ()
rnf = SortDirection -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary SortDirection

-- PR

data SortPR
    = SortPRCreated
    | SortPRUpdated
    | SortPRPopularity
    | SortPRLongRunning
  deriving
    (SortPR -> SortPR -> Bool
(SortPR -> SortPR -> Bool)
-> (SortPR -> SortPR -> Bool) -> Eq SortPR
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortPR -> SortPR -> Bool
== :: SortPR -> SortPR -> Bool
$c/= :: SortPR -> SortPR -> Bool
/= :: SortPR -> SortPR -> Bool
Eq, Eq SortPR
Eq SortPR =>
(SortPR -> SortPR -> Ordering)
-> (SortPR -> SortPR -> Bool)
-> (SortPR -> SortPR -> Bool)
-> (SortPR -> SortPR -> Bool)
-> (SortPR -> SortPR -> Bool)
-> (SortPR -> SortPR -> SortPR)
-> (SortPR -> SortPR -> SortPR)
-> Ord SortPR
SortPR -> SortPR -> Bool
SortPR -> SortPR -> Ordering
SortPR -> SortPR -> SortPR
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SortPR -> SortPR -> Ordering
compare :: SortPR -> SortPR -> Ordering
$c< :: SortPR -> SortPR -> Bool
< :: SortPR -> SortPR -> Bool
$c<= :: SortPR -> SortPR -> Bool
<= :: SortPR -> SortPR -> Bool
$c> :: SortPR -> SortPR -> Bool
> :: SortPR -> SortPR -> Bool
$c>= :: SortPR -> SortPR -> Bool
>= :: SortPR -> SortPR -> Bool
$cmax :: SortPR -> SortPR -> SortPR
max :: SortPR -> SortPR -> SortPR
$cmin :: SortPR -> SortPR -> SortPR
min :: SortPR -> SortPR -> SortPR
Ord, Int -> SortPR -> ShowS
[SortPR] -> ShowS
SortPR -> String
(Int -> SortPR -> ShowS)
-> (SortPR -> String) -> ([SortPR] -> ShowS) -> Show SortPR
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortPR -> ShowS
showsPrec :: Int -> SortPR -> ShowS
$cshow :: SortPR -> String
show :: SortPR -> String
$cshowList :: [SortPR] -> ShowS
showList :: [SortPR] -> ShowS
Show, Int -> SortPR
SortPR -> Int
SortPR -> [SortPR]
SortPR -> SortPR
SortPR -> SortPR -> [SortPR]
SortPR -> SortPR -> SortPR -> [SortPR]
(SortPR -> SortPR)
-> (SortPR -> SortPR)
-> (Int -> SortPR)
-> (SortPR -> Int)
-> (SortPR -> [SortPR])
-> (SortPR -> SortPR -> [SortPR])
-> (SortPR -> SortPR -> [SortPR])
-> (SortPR -> SortPR -> SortPR -> [SortPR])
-> Enum SortPR
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SortPR -> SortPR
succ :: SortPR -> SortPR
$cpred :: SortPR -> SortPR
pred :: SortPR -> SortPR
$ctoEnum :: Int -> SortPR
toEnum :: Int -> SortPR
$cfromEnum :: SortPR -> Int
fromEnum :: SortPR -> Int
$cenumFrom :: SortPR -> [SortPR]
enumFrom :: SortPR -> [SortPR]
$cenumFromThen :: SortPR -> SortPR -> [SortPR]
enumFromThen :: SortPR -> SortPR -> [SortPR]
$cenumFromTo :: SortPR -> SortPR -> [SortPR]
enumFromTo :: SortPR -> SortPR -> [SortPR]
$cenumFromThenTo :: SortPR -> SortPR -> SortPR -> [SortPR]
enumFromThenTo :: SortPR -> SortPR -> SortPR -> [SortPR]
Enum, SortPR
SortPR -> SortPR -> Bounded SortPR
forall a. a -> a -> Bounded a
$cminBound :: SortPR
minBound :: SortPR
$cmaxBound :: SortPR
maxBound :: SortPR
Bounded, (forall x. SortPR -> Rep SortPR x)
-> (forall x. Rep SortPR x -> SortPR) -> Generic SortPR
forall x. Rep SortPR x -> SortPR
forall x. SortPR -> Rep SortPR x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SortPR -> Rep SortPR x
from :: forall x. SortPR -> Rep SortPR x
$cto :: forall x. Rep SortPR x -> SortPR
to :: forall x. Rep SortPR x -> SortPR
Generic, Typeable, Typeable SortPR
Typeable SortPR =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SortPR -> c SortPR)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortPR)
-> (SortPR -> Constr)
-> (SortPR -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortPR))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortPR))
-> ((forall b. Data b => b -> b) -> SortPR -> SortPR)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortPR -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortPR -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortPR -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SortPR -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortPR -> m SortPR)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortPR -> m SortPR)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortPR -> m SortPR)
-> Data SortPR
SortPR -> Constr
SortPR -> DataType
(forall b. Data b => b -> b) -> SortPR -> SortPR
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortPR -> u
forall u. (forall d. Data d => d -> u) -> SortPR -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortPR
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortPR -> c SortPR
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortPR)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortPR)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortPR -> c SortPR
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortPR -> c SortPR
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortPR
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortPR
$ctoConstr :: SortPR -> Constr
toConstr :: SortPR -> Constr
$cdataTypeOf :: SortPR -> DataType
dataTypeOf :: SortPR -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortPR)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortPR)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortPR)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortPR)
$cgmapT :: (forall b. Data b => b -> b) -> SortPR -> SortPR
gmapT :: (forall b. Data b => b -> b) -> SortPR -> SortPR
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SortPR -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortPR -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SortPR -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortPR -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortPR -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortPR -> m SortPR
Data)

instance NFData SortPR where rnf :: SortPR -> ()
rnf = SortPR -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary SortPR

-- Issue
data IssueFilter
    = IssueFilterAssigned
    | IssueFilterCreated
    | IssueFilterMentioned
    | IssueFilterSubscribed
    | IssueFilterAll
  deriving
    (IssueFilter -> IssueFilter -> Bool
(IssueFilter -> IssueFilter -> Bool)
-> (IssueFilter -> IssueFilter -> Bool) -> Eq IssueFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueFilter -> IssueFilter -> Bool
== :: IssueFilter -> IssueFilter -> Bool
$c/= :: IssueFilter -> IssueFilter -> Bool
/= :: IssueFilter -> IssueFilter -> Bool
Eq, Eq IssueFilter
Eq IssueFilter =>
(IssueFilter -> IssueFilter -> Ordering)
-> (IssueFilter -> IssueFilter -> Bool)
-> (IssueFilter -> IssueFilter -> Bool)
-> (IssueFilter -> IssueFilter -> Bool)
-> (IssueFilter -> IssueFilter -> Bool)
-> (IssueFilter -> IssueFilter -> IssueFilter)
-> (IssueFilter -> IssueFilter -> IssueFilter)
-> Ord IssueFilter
IssueFilter -> IssueFilter -> Bool
IssueFilter -> IssueFilter -> Ordering
IssueFilter -> IssueFilter -> IssueFilter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueFilter -> IssueFilter -> Ordering
compare :: IssueFilter -> IssueFilter -> Ordering
$c< :: IssueFilter -> IssueFilter -> Bool
< :: IssueFilter -> IssueFilter -> Bool
$c<= :: IssueFilter -> IssueFilter -> Bool
<= :: IssueFilter -> IssueFilter -> Bool
$c> :: IssueFilter -> IssueFilter -> Bool
> :: IssueFilter -> IssueFilter -> Bool
$c>= :: IssueFilter -> IssueFilter -> Bool
>= :: IssueFilter -> IssueFilter -> Bool
$cmax :: IssueFilter -> IssueFilter -> IssueFilter
max :: IssueFilter -> IssueFilter -> IssueFilter
$cmin :: IssueFilter -> IssueFilter -> IssueFilter
min :: IssueFilter -> IssueFilter -> IssueFilter
Ord, Int -> IssueFilter -> ShowS
[IssueFilter] -> ShowS
IssueFilter -> String
(Int -> IssueFilter -> ShowS)
-> (IssueFilter -> String)
-> ([IssueFilter] -> ShowS)
-> Show IssueFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueFilter -> ShowS
showsPrec :: Int -> IssueFilter -> ShowS
$cshow :: IssueFilter -> String
show :: IssueFilter -> String
$cshowList :: [IssueFilter] -> ShowS
showList :: [IssueFilter] -> ShowS
Show, Int -> IssueFilter
IssueFilter -> Int
IssueFilter -> [IssueFilter]
IssueFilter -> IssueFilter
IssueFilter -> IssueFilter -> [IssueFilter]
IssueFilter -> IssueFilter -> IssueFilter -> [IssueFilter]
(IssueFilter -> IssueFilter)
-> (IssueFilter -> IssueFilter)
-> (Int -> IssueFilter)
-> (IssueFilter -> Int)
-> (IssueFilter -> [IssueFilter])
-> (IssueFilter -> IssueFilter -> [IssueFilter])
-> (IssueFilter -> IssueFilter -> [IssueFilter])
-> (IssueFilter -> IssueFilter -> IssueFilter -> [IssueFilter])
-> Enum IssueFilter
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IssueFilter -> IssueFilter
succ :: IssueFilter -> IssueFilter
$cpred :: IssueFilter -> IssueFilter
pred :: IssueFilter -> IssueFilter
$ctoEnum :: Int -> IssueFilter
toEnum :: Int -> IssueFilter
$cfromEnum :: IssueFilter -> Int
fromEnum :: IssueFilter -> Int
$cenumFrom :: IssueFilter -> [IssueFilter]
enumFrom :: IssueFilter -> [IssueFilter]
$cenumFromThen :: IssueFilter -> IssueFilter -> [IssueFilter]
enumFromThen :: IssueFilter -> IssueFilter -> [IssueFilter]
$cenumFromTo :: IssueFilter -> IssueFilter -> [IssueFilter]
enumFromTo :: IssueFilter -> IssueFilter -> [IssueFilter]
$cenumFromThenTo :: IssueFilter -> IssueFilter -> IssueFilter -> [IssueFilter]
enumFromThenTo :: IssueFilter -> IssueFilter -> IssueFilter -> [IssueFilter]
Enum, IssueFilter
IssueFilter -> IssueFilter -> Bounded IssueFilter
forall a. a -> a -> Bounded a
$cminBound :: IssueFilter
minBound :: IssueFilter
$cmaxBound :: IssueFilter
maxBound :: IssueFilter
Bounded, (forall x. IssueFilter -> Rep IssueFilter x)
-> (forall x. Rep IssueFilter x -> IssueFilter)
-> Generic IssueFilter
forall x. Rep IssueFilter x -> IssueFilter
forall x. IssueFilter -> Rep IssueFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IssueFilter -> Rep IssueFilter x
from :: forall x. IssueFilter -> Rep IssueFilter x
$cto :: forall x. Rep IssueFilter x -> IssueFilter
to :: forall x. Rep IssueFilter x -> IssueFilter
Generic, Typeable, Typeable IssueFilter
Typeable IssueFilter =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IssueFilter -> c IssueFilter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueFilter)
-> (IssueFilter -> Constr)
-> (IssueFilter -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IssueFilter))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IssueFilter))
-> ((forall b. Data b => b -> b) -> IssueFilter -> IssueFilter)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueFilter -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueFilter -> r)
-> (forall u. (forall d. Data d => d -> u) -> IssueFilter -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueFilter -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter)
-> Data IssueFilter
IssueFilter -> Constr
IssueFilter -> DataType
(forall b. Data b => b -> b) -> IssueFilter -> IssueFilter
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IssueFilter -> u
forall u. (forall d. Data d => d -> u) -> IssueFilter -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueFilter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueFilter -> c IssueFilter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueFilter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueFilter)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueFilter -> c IssueFilter
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueFilter -> c IssueFilter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueFilter
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueFilter
$ctoConstr :: IssueFilter -> Constr
toConstr :: IssueFilter -> Constr
$cdataTypeOf :: IssueFilter -> DataType
dataTypeOf :: IssueFilter -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueFilter)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueFilter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueFilter)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueFilter)
$cgmapT :: (forall b. Data b => b -> b) -> IssueFilter -> IssueFilter
gmapT :: (forall b. Data b => b -> b) -> IssueFilter -> IssueFilter
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueFilter -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueFilter -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueFilter -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueFilter -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueFilter -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueFilter -> m IssueFilter
Data)

instance NFData IssueFilter where rnf :: IssueFilter -> ()
rnf = IssueFilter -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary IssueFilter

data SortIssue
    = SortIssueCreated
    | SortIssueUpdated
    | SortIssueComments
  deriving
    (SortIssue -> SortIssue -> Bool
(SortIssue -> SortIssue -> Bool)
-> (SortIssue -> SortIssue -> Bool) -> Eq SortIssue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortIssue -> SortIssue -> Bool
== :: SortIssue -> SortIssue -> Bool
$c/= :: SortIssue -> SortIssue -> Bool
/= :: SortIssue -> SortIssue -> Bool
Eq, Eq SortIssue
Eq SortIssue =>
(SortIssue -> SortIssue -> Ordering)
-> (SortIssue -> SortIssue -> Bool)
-> (SortIssue -> SortIssue -> Bool)
-> (SortIssue -> SortIssue -> Bool)
-> (SortIssue -> SortIssue -> Bool)
-> (SortIssue -> SortIssue -> SortIssue)
-> (SortIssue -> SortIssue -> SortIssue)
-> Ord SortIssue
SortIssue -> SortIssue -> Bool
SortIssue -> SortIssue -> Ordering
SortIssue -> SortIssue -> SortIssue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SortIssue -> SortIssue -> Ordering
compare :: SortIssue -> SortIssue -> Ordering
$c< :: SortIssue -> SortIssue -> Bool
< :: SortIssue -> SortIssue -> Bool
$c<= :: SortIssue -> SortIssue -> Bool
<= :: SortIssue -> SortIssue -> Bool
$c> :: SortIssue -> SortIssue -> Bool
> :: SortIssue -> SortIssue -> Bool
$c>= :: SortIssue -> SortIssue -> Bool
>= :: SortIssue -> SortIssue -> Bool
$cmax :: SortIssue -> SortIssue -> SortIssue
max :: SortIssue -> SortIssue -> SortIssue
$cmin :: SortIssue -> SortIssue -> SortIssue
min :: SortIssue -> SortIssue -> SortIssue
Ord, Int -> SortIssue -> ShowS
[SortIssue] -> ShowS
SortIssue -> String
(Int -> SortIssue -> ShowS)
-> (SortIssue -> String)
-> ([SortIssue] -> ShowS)
-> Show SortIssue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortIssue -> ShowS
showsPrec :: Int -> SortIssue -> ShowS
$cshow :: SortIssue -> String
show :: SortIssue -> String
$cshowList :: [SortIssue] -> ShowS
showList :: [SortIssue] -> ShowS
Show, Int -> SortIssue
SortIssue -> Int
SortIssue -> [SortIssue]
SortIssue -> SortIssue
SortIssue -> SortIssue -> [SortIssue]
SortIssue -> SortIssue -> SortIssue -> [SortIssue]
(SortIssue -> SortIssue)
-> (SortIssue -> SortIssue)
-> (Int -> SortIssue)
-> (SortIssue -> Int)
-> (SortIssue -> [SortIssue])
-> (SortIssue -> SortIssue -> [SortIssue])
-> (SortIssue -> SortIssue -> [SortIssue])
-> (SortIssue -> SortIssue -> SortIssue -> [SortIssue])
-> Enum SortIssue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SortIssue -> SortIssue
succ :: SortIssue -> SortIssue
$cpred :: SortIssue -> SortIssue
pred :: SortIssue -> SortIssue
$ctoEnum :: Int -> SortIssue
toEnum :: Int -> SortIssue
$cfromEnum :: SortIssue -> Int
fromEnum :: SortIssue -> Int
$cenumFrom :: SortIssue -> [SortIssue]
enumFrom :: SortIssue -> [SortIssue]
$cenumFromThen :: SortIssue -> SortIssue -> [SortIssue]
enumFromThen :: SortIssue -> SortIssue -> [SortIssue]
$cenumFromTo :: SortIssue -> SortIssue -> [SortIssue]
enumFromTo :: SortIssue -> SortIssue -> [SortIssue]
$cenumFromThenTo :: SortIssue -> SortIssue -> SortIssue -> [SortIssue]
enumFromThenTo :: SortIssue -> SortIssue -> SortIssue -> [SortIssue]
Enum, SortIssue
SortIssue -> SortIssue -> Bounded SortIssue
forall a. a -> a -> Bounded a
$cminBound :: SortIssue
minBound :: SortIssue
$cmaxBound :: SortIssue
maxBound :: SortIssue
Bounded, (forall x. SortIssue -> Rep SortIssue x)
-> (forall x. Rep SortIssue x -> SortIssue) -> Generic SortIssue
forall x. Rep SortIssue x -> SortIssue
forall x. SortIssue -> Rep SortIssue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SortIssue -> Rep SortIssue x
from :: forall x. SortIssue -> Rep SortIssue x
$cto :: forall x. Rep SortIssue x -> SortIssue
to :: forall x. Rep SortIssue x -> SortIssue
Generic, Typeable, Typeable SortIssue
Typeable SortIssue =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SortIssue -> c SortIssue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortIssue)
-> (SortIssue -> Constr)
-> (SortIssue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortIssue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortIssue))
-> ((forall b. Data b => b -> b) -> SortIssue -> SortIssue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortIssue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortIssue -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortIssue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SortIssue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortIssue -> m SortIssue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortIssue -> m SortIssue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortIssue -> m SortIssue)
-> Data SortIssue
SortIssue -> Constr
SortIssue -> DataType
(forall b. Data b => b -> b) -> SortIssue -> SortIssue
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortIssue -> u
forall u. (forall d. Data d => d -> u) -> SortIssue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortIssue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortIssue -> c SortIssue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortIssue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortIssue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortIssue -> c SortIssue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortIssue -> c SortIssue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortIssue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortIssue
$ctoConstr :: SortIssue -> Constr
toConstr :: SortIssue -> Constr
$cdataTypeOf :: SortIssue -> DataType
dataTypeOf :: SortIssue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortIssue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortIssue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortIssue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortIssue)
$cgmapT :: (forall b. Data b => b -> b) -> SortIssue -> SortIssue
gmapT :: (forall b. Data b => b -> b) -> SortIssue -> SortIssue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortIssue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortIssue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SortIssue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortIssue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortIssue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortIssue -> m SortIssue
Data)

instance NFData SortIssue where rnf :: SortIssue -> ()
rnf = SortIssue -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary SortIssue

data FilterBy a
    = FilterAny
    | FilterNone
    | FilterBy a
    | FilterNotSpecified
      -- ^ e.g. for milestones "any" means "any milestone".
      -- I.e. won't show issues without mileston specified
  deriving
    (FilterBy a -> FilterBy a -> Bool
(FilterBy a -> FilterBy a -> Bool)
-> (FilterBy a -> FilterBy a -> Bool) -> Eq (FilterBy a)
forall a. Eq a => FilterBy a -> FilterBy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FilterBy a -> FilterBy a -> Bool
== :: FilterBy a -> FilterBy a -> Bool
$c/= :: forall a. Eq a => FilterBy a -> FilterBy a -> Bool
/= :: FilterBy a -> FilterBy a -> Bool
Eq, Eq (FilterBy a)
Eq (FilterBy a) =>
(FilterBy a -> FilterBy a -> Ordering)
-> (FilterBy a -> FilterBy a -> Bool)
-> (FilterBy a -> FilterBy a -> Bool)
-> (FilterBy a -> FilterBy a -> Bool)
-> (FilterBy a -> FilterBy a -> Bool)
-> (FilterBy a -> FilterBy a -> FilterBy a)
-> (FilterBy a -> FilterBy a -> FilterBy a)
-> Ord (FilterBy a)
FilterBy a -> FilterBy a -> Bool
FilterBy a -> FilterBy a -> Ordering
FilterBy a -> FilterBy a -> FilterBy a
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
forall a. Ord a => Eq (FilterBy a)
forall a. Ord a => FilterBy a -> FilterBy a -> Bool
forall a. Ord a => FilterBy a -> FilterBy a -> Ordering
forall a. Ord a => FilterBy a -> FilterBy a -> FilterBy a
$ccompare :: forall a. Ord a => FilterBy a -> FilterBy a -> Ordering
compare :: FilterBy a -> FilterBy a -> Ordering
$c< :: forall a. Ord a => FilterBy a -> FilterBy a -> Bool
< :: FilterBy a -> FilterBy a -> Bool
$c<= :: forall a. Ord a => FilterBy a -> FilterBy a -> Bool
<= :: FilterBy a -> FilterBy a -> Bool
$c> :: forall a. Ord a => FilterBy a -> FilterBy a -> Bool
> :: FilterBy a -> FilterBy a -> Bool
$c>= :: forall a. Ord a => FilterBy a -> FilterBy a -> Bool
>= :: FilterBy a -> FilterBy a -> Bool
$cmax :: forall a. Ord a => FilterBy a -> FilterBy a -> FilterBy a
max :: FilterBy a -> FilterBy a -> FilterBy a
$cmin :: forall a. Ord a => FilterBy a -> FilterBy a -> FilterBy a
min :: FilterBy a -> FilterBy a -> FilterBy a
Ord, Int -> FilterBy a -> ShowS
[FilterBy a] -> ShowS
FilterBy a -> String
(Int -> FilterBy a -> ShowS)
-> (FilterBy a -> String)
-> ([FilterBy a] -> ShowS)
-> Show (FilterBy a)
forall a. Show a => Int -> FilterBy a -> ShowS
forall a. Show a => [FilterBy a] -> ShowS
forall a. Show a => FilterBy a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FilterBy a -> ShowS
showsPrec :: Int -> FilterBy a -> ShowS
$cshow :: forall a. Show a => FilterBy a -> String
show :: FilterBy a -> String
$cshowList :: forall a. Show a => [FilterBy a] -> ShowS
showList :: [FilterBy a] -> ShowS
Show, (forall x. FilterBy a -> Rep (FilterBy a) x)
-> (forall x. Rep (FilterBy a) x -> FilterBy a)
-> Generic (FilterBy a)
forall x. Rep (FilterBy a) x -> FilterBy a
forall x. FilterBy a -> Rep (FilterBy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FilterBy a) x -> FilterBy a
forall a x. FilterBy a -> Rep (FilterBy a) x
$cfrom :: forall a x. FilterBy a -> Rep (FilterBy a) x
from :: forall x. FilterBy a -> Rep (FilterBy a) x
$cto :: forall a x. Rep (FilterBy a) x -> FilterBy a
to :: forall x. Rep (FilterBy a) x -> FilterBy a
Generic, Typeable, Typeable (FilterBy a)
Typeable (FilterBy a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FilterBy a -> c (FilterBy a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (FilterBy a))
-> (FilterBy a -> Constr)
-> (FilterBy a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (FilterBy a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (FilterBy a)))
-> ((forall b. Data b => b -> b) -> FilterBy a -> FilterBy a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FilterBy a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FilterBy a -> r)
-> (forall u. (forall d. Data d => d -> u) -> FilterBy a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FilterBy a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a))
-> Data (FilterBy a)
FilterBy a -> Constr
FilterBy a -> DataType
(forall b. Data b => b -> b) -> FilterBy a -> FilterBy a
forall a. Data a => Typeable (FilterBy a)
forall a. Data a => FilterBy a -> Constr
forall a. Data a => FilterBy a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> FilterBy a -> FilterBy a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FilterBy a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FilterBy a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FilterBy a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilterBy a -> c (FilterBy a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FilterBy a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FilterBy a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FilterBy a -> u
forall u. (forall d. Data d => d -> u) -> FilterBy a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FilterBy a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilterBy a -> c (FilterBy a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FilterBy a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FilterBy a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilterBy a -> c (FilterBy a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FilterBy a -> c (FilterBy a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FilterBy a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FilterBy a)
$ctoConstr :: forall a. Data a => FilterBy a -> Constr
toConstr :: FilterBy a -> Constr
$cdataTypeOf :: forall a. Data a => FilterBy a -> DataType
dataTypeOf :: FilterBy a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FilterBy a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FilterBy a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FilterBy a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FilterBy a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> FilterBy a -> FilterBy a
gmapT :: (forall b. Data b => b -> b) -> FilterBy a -> FilterBy a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FilterBy a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FilterBy a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FilterBy a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FilterBy a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FilterBy a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FilterBy a -> m (FilterBy a)
Data)

-- Actions cache

data SortCache
    = SortCacheCreatedAt
    | SortCacheLastAccessedAt
    | SortCacheSizeInBytes
  deriving
    (SortCache -> SortCache -> Bool
(SortCache -> SortCache -> Bool)
-> (SortCache -> SortCache -> Bool) -> Eq SortCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortCache -> SortCache -> Bool
== :: SortCache -> SortCache -> Bool
$c/= :: SortCache -> SortCache -> Bool
/= :: SortCache -> SortCache -> Bool
Eq, Eq SortCache
Eq SortCache =>
(SortCache -> SortCache -> Ordering)
-> (SortCache -> SortCache -> Bool)
-> (SortCache -> SortCache -> Bool)
-> (SortCache -> SortCache -> Bool)
-> (SortCache -> SortCache -> Bool)
-> (SortCache -> SortCache -> SortCache)
-> (SortCache -> SortCache -> SortCache)
-> Ord SortCache
SortCache -> SortCache -> Bool
SortCache -> SortCache -> Ordering
SortCache -> SortCache -> SortCache
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SortCache -> SortCache -> Ordering
compare :: SortCache -> SortCache -> Ordering
$c< :: SortCache -> SortCache -> Bool
< :: SortCache -> SortCache -> Bool
$c<= :: SortCache -> SortCache -> Bool
<= :: SortCache -> SortCache -> Bool
$c> :: SortCache -> SortCache -> Bool
> :: SortCache -> SortCache -> Bool
$c>= :: SortCache -> SortCache -> Bool
>= :: SortCache -> SortCache -> Bool
$cmax :: SortCache -> SortCache -> SortCache
max :: SortCache -> SortCache -> SortCache
$cmin :: SortCache -> SortCache -> SortCache
min :: SortCache -> SortCache -> SortCache
Ord, Int -> SortCache -> ShowS
[SortCache] -> ShowS
SortCache -> String
(Int -> SortCache -> ShowS)
-> (SortCache -> String)
-> ([SortCache] -> ShowS)
-> Show SortCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortCache -> ShowS
showsPrec :: Int -> SortCache -> ShowS
$cshow :: SortCache -> String
show :: SortCache -> String
$cshowList :: [SortCache] -> ShowS
showList :: [SortCache] -> ShowS
Show, Int -> SortCache
SortCache -> Int
SortCache -> [SortCache]
SortCache -> SortCache
SortCache -> SortCache -> [SortCache]
SortCache -> SortCache -> SortCache -> [SortCache]
(SortCache -> SortCache)
-> (SortCache -> SortCache)
-> (Int -> SortCache)
-> (SortCache -> Int)
-> (SortCache -> [SortCache])
-> (SortCache -> SortCache -> [SortCache])
-> (SortCache -> SortCache -> [SortCache])
-> (SortCache -> SortCache -> SortCache -> [SortCache])
-> Enum SortCache
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SortCache -> SortCache
succ :: SortCache -> SortCache
$cpred :: SortCache -> SortCache
pred :: SortCache -> SortCache
$ctoEnum :: Int -> SortCache
toEnum :: Int -> SortCache
$cfromEnum :: SortCache -> Int
fromEnum :: SortCache -> Int
$cenumFrom :: SortCache -> [SortCache]
enumFrom :: SortCache -> [SortCache]
$cenumFromThen :: SortCache -> SortCache -> [SortCache]
enumFromThen :: SortCache -> SortCache -> [SortCache]
$cenumFromTo :: SortCache -> SortCache -> [SortCache]
enumFromTo :: SortCache -> SortCache -> [SortCache]
$cenumFromThenTo :: SortCache -> SortCache -> SortCache -> [SortCache]
enumFromThenTo :: SortCache -> SortCache -> SortCache -> [SortCache]
Enum, SortCache
SortCache -> SortCache -> Bounded SortCache
forall a. a -> a -> Bounded a
$cminBound :: SortCache
minBound :: SortCache
$cmaxBound :: SortCache
maxBound :: SortCache
Bounded, (forall x. SortCache -> Rep SortCache x)
-> (forall x. Rep SortCache x -> SortCache) -> Generic SortCache
forall x. Rep SortCache x -> SortCache
forall x. SortCache -> Rep SortCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SortCache -> Rep SortCache x
from :: forall x. SortCache -> Rep SortCache x
$cto :: forall x. Rep SortCache x -> SortCache
to :: forall x. Rep SortCache x -> SortCache
Generic, Typeable, Typeable SortCache
Typeable SortCache =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SortCache -> c SortCache)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SortCache)
-> (SortCache -> Constr)
-> (SortCache -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SortCache))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortCache))
-> ((forall b. Data b => b -> b) -> SortCache -> SortCache)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SortCache -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SortCache -> r)
-> (forall u. (forall d. Data d => d -> u) -> SortCache -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SortCache -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SortCache -> m SortCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortCache -> m SortCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SortCache -> m SortCache)
-> Data SortCache
SortCache -> Constr
SortCache -> DataType
(forall b. Data b => b -> b) -> SortCache -> SortCache
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SortCache -> u
forall u. (forall d. Data d => d -> u) -> SortCache -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortCache
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortCache -> c SortCache
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortCache)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortCache)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortCache -> c SortCache
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SortCache -> c SortCache
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortCache
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SortCache
$ctoConstr :: SortCache -> Constr
toConstr :: SortCache -> Constr
$cdataTypeOf :: SortCache -> DataType
dataTypeOf :: SortCache -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortCache)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SortCache)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortCache)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SortCache)
$cgmapT :: (forall b. Data b => b -> b) -> SortCache -> SortCache
gmapT :: (forall b. Data b => b -> b) -> SortCache -> SortCache
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SortCache -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SortCache -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SortCache -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortCache -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SortCache -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SortCache -> m SortCache
Data)

instance NFData SortCache where rnf :: SortCache -> ()
rnf = SortCache -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary SortCache

-------------------------------------------------------------------------------
-- Classes
-------------------------------------------------------------------------------

class HasState mod where
    state :: Maybe IssueState -> mod

stateOpen :: HasState mod => mod
stateOpen :: forall mod. HasState mod => mod
stateOpen = Maybe IssueState -> mod
forall mod. HasState mod => Maybe IssueState -> mod
state (IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
StateOpen)

stateClosed :: HasState mod => mod
stateClosed :: forall mod. HasState mod => mod
stateClosed = Maybe IssueState -> mod
forall mod. HasState mod => Maybe IssueState -> mod
state (IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
StateClosed)

stateAll :: HasState mod => mod
stateAll :: forall mod. HasState mod => mod
stateAll = Maybe IssueState -> mod
forall mod. HasState mod => Maybe IssueState -> mod
state Maybe IssueState
forall a. Maybe a
Nothing

instance HasState PullRequestMod where
    state :: Maybe IssueState -> PullRequestMod
state Maybe IssueState
s = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
        PullRequestOptions
opts { pullRequestOptionsState = s }

instance HasState IssueMod where
    state :: Maybe IssueState -> IssueMod
state Maybe IssueState
s = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsState = s }

instance HasState IssueRepoMod where
    state :: Maybe IssueState -> IssueRepoMod
state Maybe IssueState
s = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsState = s }


class HasDirection mod where
    sortDir :: SortDirection -> mod

sortAscending :: HasDirection mod => mod
sortAscending :: forall mod. HasDirection mod => mod
sortAscending = SortDirection -> mod
forall mod. HasDirection mod => SortDirection -> mod
sortDir SortDirection
SortAscending

sortDescending :: HasDirection mod => mod
sortDescending :: forall mod. HasDirection mod => mod
sortDescending = SortDirection -> mod
forall mod. HasDirection mod => SortDirection -> mod
sortDir SortDirection
SortDescending

instance HasDirection PullRequestMod where
    sortDir :: SortDirection -> PullRequestMod
sortDir SortDirection
x = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
        PullRequestOptions
opts { pullRequestOptionsDirection = x }

instance HasDirection IssueMod where
    sortDir :: SortDirection -> IssueMod
sortDir SortDirection
x = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsDirection = x }

instance HasDirection IssueRepoMod where
    sortDir :: SortDirection -> IssueRepoMod
sortDir SortDirection
x = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsDirection = x }


class HasCreatedUpdated mod where
    sortByCreated :: mod
    sortByUpdated :: mod

instance HasCreatedUpdated PullRequestMod where
    sortByCreated :: PullRequestMod
sortByCreated = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
        PullRequestOptions
opts { pullRequestOptionsSort = SortPRCreated }
    sortByUpdated :: PullRequestMod
sortByUpdated = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
        PullRequestOptions
opts { pullRequestOptionsSort = SortPRUpdated }

instance HasCreatedUpdated IssueMod where
    sortByCreated :: IssueMod
sortByCreated = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsSort = SortIssueCreated }
    sortByUpdated :: IssueMod
sortByUpdated = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsSort = SortIssueUpdated }

instance HasCreatedUpdated IssueRepoMod where
    sortByCreated :: IssueRepoMod
sortByCreated = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsSort = SortIssueCreated }
    sortByUpdated :: IssueRepoMod
sortByUpdated = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsSort = SortIssueUpdated }

-------------------------------------------------------------------------------
-- Pull Request
-------------------------------------------------------------------------------

-- | See <https://developer.github.com/v3/pulls/#parameters>.
data PullRequestOptions = PullRequestOptions
    { PullRequestOptions -> Maybe IssueState
pullRequestOptionsState     :: !(Maybe IssueState)
    , PullRequestOptions -> Maybe Text
pullRequestOptionsHead      :: !(Maybe Text)
    , PullRequestOptions -> Maybe Text
pullRequestOptionsBase      :: !(Maybe Text)
    , PullRequestOptions -> SortPR
pullRequestOptionsSort      :: !SortPR
    , PullRequestOptions -> SortDirection
pullRequestOptionsDirection :: !SortDirection
    }
  deriving
    (PullRequestOptions -> PullRequestOptions -> Bool
(PullRequestOptions -> PullRequestOptions -> Bool)
-> (PullRequestOptions -> PullRequestOptions -> Bool)
-> Eq PullRequestOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullRequestOptions -> PullRequestOptions -> Bool
== :: PullRequestOptions -> PullRequestOptions -> Bool
$c/= :: PullRequestOptions -> PullRequestOptions -> Bool
/= :: PullRequestOptions -> PullRequestOptions -> Bool
Eq, Eq PullRequestOptions
Eq PullRequestOptions =>
(PullRequestOptions -> PullRequestOptions -> Ordering)
-> (PullRequestOptions -> PullRequestOptions -> Bool)
-> (PullRequestOptions -> PullRequestOptions -> Bool)
-> (PullRequestOptions -> PullRequestOptions -> Bool)
-> (PullRequestOptions -> PullRequestOptions -> Bool)
-> (PullRequestOptions -> PullRequestOptions -> PullRequestOptions)
-> (PullRequestOptions -> PullRequestOptions -> PullRequestOptions)
-> Ord PullRequestOptions
PullRequestOptions -> PullRequestOptions -> Bool
PullRequestOptions -> PullRequestOptions -> Ordering
PullRequestOptions -> PullRequestOptions -> PullRequestOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PullRequestOptions -> PullRequestOptions -> Ordering
compare :: PullRequestOptions -> PullRequestOptions -> Ordering
$c< :: PullRequestOptions -> PullRequestOptions -> Bool
< :: PullRequestOptions -> PullRequestOptions -> Bool
$c<= :: PullRequestOptions -> PullRequestOptions -> Bool
<= :: PullRequestOptions -> PullRequestOptions -> Bool
$c> :: PullRequestOptions -> PullRequestOptions -> Bool
> :: PullRequestOptions -> PullRequestOptions -> Bool
$c>= :: PullRequestOptions -> PullRequestOptions -> Bool
>= :: PullRequestOptions -> PullRequestOptions -> Bool
$cmax :: PullRequestOptions -> PullRequestOptions -> PullRequestOptions
max :: PullRequestOptions -> PullRequestOptions -> PullRequestOptions
$cmin :: PullRequestOptions -> PullRequestOptions -> PullRequestOptions
min :: PullRequestOptions -> PullRequestOptions -> PullRequestOptions
Ord, Int -> PullRequestOptions -> ShowS
[PullRequestOptions] -> ShowS
PullRequestOptions -> String
(Int -> PullRequestOptions -> ShowS)
-> (PullRequestOptions -> String)
-> ([PullRequestOptions] -> ShowS)
-> Show PullRequestOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullRequestOptions -> ShowS
showsPrec :: Int -> PullRequestOptions -> ShowS
$cshow :: PullRequestOptions -> String
show :: PullRequestOptions -> String
$cshowList :: [PullRequestOptions] -> ShowS
showList :: [PullRequestOptions] -> ShowS
Show, (forall x. PullRequestOptions -> Rep PullRequestOptions x)
-> (forall x. Rep PullRequestOptions x -> PullRequestOptions)
-> Generic PullRequestOptions
forall x. Rep PullRequestOptions x -> PullRequestOptions
forall x. PullRequestOptions -> Rep PullRequestOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PullRequestOptions -> Rep PullRequestOptions x
from :: forall x. PullRequestOptions -> Rep PullRequestOptions x
$cto :: forall x. Rep PullRequestOptions x -> PullRequestOptions
to :: forall x. Rep PullRequestOptions x -> PullRequestOptions
Generic, Typeable, Typeable PullRequestOptions
Typeable PullRequestOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> PullRequestOptions
 -> c PullRequestOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PullRequestOptions)
-> (PullRequestOptions -> Constr)
-> (PullRequestOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PullRequestOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PullRequestOptions))
-> ((forall b. Data b => b -> b)
    -> PullRequestOptions -> PullRequestOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PullRequestOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PullRequestOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PullRequestOptions -> m PullRequestOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PullRequestOptions -> m PullRequestOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PullRequestOptions -> m PullRequestOptions)
-> Data PullRequestOptions
PullRequestOptions -> Constr
PullRequestOptions -> DataType
(forall b. Data b => b -> b)
-> PullRequestOptions -> PullRequestOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestOptions -> u
forall u. (forall d. Data d => d -> u) -> PullRequestOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PullRequestOptions
-> c PullRequestOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PullRequestOptions
-> c PullRequestOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PullRequestOptions
-> c PullRequestOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestOptions
$ctoConstr :: PullRequestOptions -> Constr
toConstr :: PullRequestOptions -> Constr
$cdataTypeOf :: PullRequestOptions -> DataType
dataTypeOf :: PullRequestOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> PullRequestOptions -> PullRequestOptions
gmapT :: (forall b. Data b => b -> b)
-> PullRequestOptions -> PullRequestOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PullRequestOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PullRequestOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestOptions -> m PullRequestOptions
Data)

defaultPullRequestOptions :: PullRequestOptions
defaultPullRequestOptions :: PullRequestOptions
defaultPullRequestOptions = PullRequestOptions
    { pullRequestOptionsState :: Maybe IssueState
pullRequestOptionsState     = IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
StateOpen
    , pullRequestOptionsHead :: Maybe Text
pullRequestOptionsHead      = Maybe Text
forall a. Maybe a
Nothing
    , pullRequestOptionsBase :: Maybe Text
pullRequestOptionsBase      = Maybe Text
forall a. Maybe a
Nothing
    , pullRequestOptionsSort :: SortPR
pullRequestOptionsSort      = SortPR
SortPRCreated
    , pullRequestOptionsDirection :: SortDirection
pullRequestOptionsDirection = SortDirection
SortDescending
    }

-- | See <https://developer.github.com/v3/pulls/#parameters>.
newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions)

instance Semigroup PullRequestMod where
    PRMod PullRequestOptions -> PullRequestOptions
f <> :: PullRequestMod -> PullRequestMod -> PullRequestMod
<> PRMod PullRequestOptions -> PullRequestOptions
g = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod (PullRequestOptions -> PullRequestOptions
g (PullRequestOptions -> PullRequestOptions)
-> (PullRequestOptions -> PullRequestOptions)
-> PullRequestOptions
-> PullRequestOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequestOptions -> PullRequestOptions
f)

instance Monoid PullRequestMod where
    mempty :: PullRequestMod
mempty  = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod PullRequestOptions -> PullRequestOptions
forall a. a -> a
id
    mappend :: PullRequestMod -> PullRequestMod -> PullRequestMod
mappend = PullRequestMod -> PullRequestMod -> PullRequestMod
forall a. Semigroup a => a -> a -> a
(<>)

toPullRequestOptions :: PullRequestMod -> PullRequestOptions
toPullRequestOptions :: PullRequestMod -> PullRequestOptions
toPullRequestOptions (PRMod PullRequestOptions -> PullRequestOptions
f) = PullRequestOptions -> PullRequestOptions
f PullRequestOptions
defaultPullRequestOptions

prModToQueryString :: PullRequestMod -> QueryString
prModToQueryString :: PullRequestMod -> QueryString
prModToQueryString = PullRequestOptions -> QueryString
pullRequestOptionsToQueryString (PullRequestOptions -> QueryString)
-> (PullRequestMod -> PullRequestOptions)
-> PullRequestMod
-> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PullRequestMod -> PullRequestOptions
toPullRequestOptions

pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString
pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString
pullRequestOptionsToQueryString (PullRequestOptions Maybe IssueState
st Maybe Text
head_ Maybe Text
base SortPR
sort SortDirection
dir) =
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"state"     ByteString
state'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"sort"      ByteString
sort'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"direction" ByteString
direction'
    ] QueryString -> QueryString -> QueryString
forall a. [a] -> [a] -> [a]
++ [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"head" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
head'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"base" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
base'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    state' :: ByteString
state' = case Maybe IssueState
st of
        Maybe IssueState
Nothing          -> ByteString
"all"
        Just IssueState
StateOpen   -> ByteString
"open"
        Just IssueState
StateClosed -> ByteString
"closed"
    sort' :: ByteString
sort' = case SortPR
sort of
        SortPR
SortPRCreated     -> ByteString
"created"
        SortPR
SortPRUpdated     -> ByteString
"updated"
        SortPR
SortPRPopularity  -> ByteString
"popularity"
        SortPR
SortPRLongRunning -> ByteString
"long-running"
    direction' :: ByteString
direction' = case SortDirection
dir of
       SortDirection
SortDescending -> ByteString
"desc"
       SortDirection
SortAscending  -> ByteString
"asc"
    head' :: Maybe ByteString
head' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
head_
    base' :: Maybe ByteString
base' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
base

-------------------------------------------------------------------------------
-- Pull request modifiers
-------------------------------------------------------------------------------

optionsBase :: Text -> PullRequestMod
optionsBase :: Text -> PullRequestMod
optionsBase Text
x = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsBase = Just x }

optionsNoBase :: PullRequestMod
optionsNoBase :: PullRequestMod
optionsNoBase = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsBase = Nothing }

optionsHead :: Text -> PullRequestMod
optionsHead :: Text -> PullRequestMod
optionsHead Text
x = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsHead = Just x }

optionsNoHead :: PullRequestMod
optionsNoHead :: PullRequestMod
optionsNoHead = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsHead = Nothing }

sortByPopularity :: PullRequestMod
sortByPopularity :: PullRequestMod
sortByPopularity = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsSort = SortPRPopularity }

sortByLongRunning :: PullRequestMod
sortByLongRunning :: PullRequestMod
sortByLongRunning = (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
PRMod ((PullRequestOptions -> PullRequestOptions) -> PullRequestMod)
-> (PullRequestOptions -> PullRequestOptions) -> PullRequestMod
forall a b. (a -> b) -> a -> b
$ \PullRequestOptions
opts ->
    PullRequestOptions
opts { pullRequestOptionsSort = SortPRLongRunning }

-------------------------------------------------------------------------------
-- Issues
-------------------------------------------------------------------------------

-- | See <https://docs.github.com/en/rest/reference/issues#list-issues-assigned-to-the-authenticated-user--parameters>.
data IssueOptions = IssueOptions
    { IssueOptions -> IssueFilter
issueOptionsFilter    :: !IssueFilter
    , IssueOptions -> Maybe IssueState
issueOptionsState     :: !(Maybe IssueState)
    , IssueOptions -> [Name IssueLabel]
issueOptionsLabels    :: ![Name IssueLabel] -- TODO: change to newtype
    , IssueOptions -> SortIssue
issueOptionsSort      :: !SortIssue
    , IssueOptions -> SortDirection
issueOptionsDirection :: !SortDirection
    , IssueOptions -> Maybe UTCTime
issueOptionsSince     :: !(Maybe UTCTime)
    }
  deriving
    (IssueOptions -> IssueOptions -> Bool
(IssueOptions -> IssueOptions -> Bool)
-> (IssueOptions -> IssueOptions -> Bool) -> Eq IssueOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueOptions -> IssueOptions -> Bool
== :: IssueOptions -> IssueOptions -> Bool
$c/= :: IssueOptions -> IssueOptions -> Bool
/= :: IssueOptions -> IssueOptions -> Bool
Eq, Eq IssueOptions
Eq IssueOptions =>
(IssueOptions -> IssueOptions -> Ordering)
-> (IssueOptions -> IssueOptions -> Bool)
-> (IssueOptions -> IssueOptions -> Bool)
-> (IssueOptions -> IssueOptions -> Bool)
-> (IssueOptions -> IssueOptions -> Bool)
-> (IssueOptions -> IssueOptions -> IssueOptions)
-> (IssueOptions -> IssueOptions -> IssueOptions)
-> Ord IssueOptions
IssueOptions -> IssueOptions -> Bool
IssueOptions -> IssueOptions -> Ordering
IssueOptions -> IssueOptions -> IssueOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueOptions -> IssueOptions -> Ordering
compare :: IssueOptions -> IssueOptions -> Ordering
$c< :: IssueOptions -> IssueOptions -> Bool
< :: IssueOptions -> IssueOptions -> Bool
$c<= :: IssueOptions -> IssueOptions -> Bool
<= :: IssueOptions -> IssueOptions -> Bool
$c> :: IssueOptions -> IssueOptions -> Bool
> :: IssueOptions -> IssueOptions -> Bool
$c>= :: IssueOptions -> IssueOptions -> Bool
>= :: IssueOptions -> IssueOptions -> Bool
$cmax :: IssueOptions -> IssueOptions -> IssueOptions
max :: IssueOptions -> IssueOptions -> IssueOptions
$cmin :: IssueOptions -> IssueOptions -> IssueOptions
min :: IssueOptions -> IssueOptions -> IssueOptions
Ord, Int -> IssueOptions -> ShowS
[IssueOptions] -> ShowS
IssueOptions -> String
(Int -> IssueOptions -> ShowS)
-> (IssueOptions -> String)
-> ([IssueOptions] -> ShowS)
-> Show IssueOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueOptions -> ShowS
showsPrec :: Int -> IssueOptions -> ShowS
$cshow :: IssueOptions -> String
show :: IssueOptions -> String
$cshowList :: [IssueOptions] -> ShowS
showList :: [IssueOptions] -> ShowS
Show, (forall x. IssueOptions -> Rep IssueOptions x)
-> (forall x. Rep IssueOptions x -> IssueOptions)
-> Generic IssueOptions
forall x. Rep IssueOptions x -> IssueOptions
forall x. IssueOptions -> Rep IssueOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IssueOptions -> Rep IssueOptions x
from :: forall x. IssueOptions -> Rep IssueOptions x
$cto :: forall x. Rep IssueOptions x -> IssueOptions
to :: forall x. Rep IssueOptions x -> IssueOptions
Generic, Typeable, Typeable IssueOptions
Typeable IssueOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IssueOptions -> c IssueOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueOptions)
-> (IssueOptions -> Constr)
-> (IssueOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IssueOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IssueOptions))
-> ((forall b. Data b => b -> b) -> IssueOptions -> IssueOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueOptions -> r)
-> (forall u. (forall d. Data d => d -> u) -> IssueOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions)
-> Data IssueOptions
IssueOptions -> Constr
IssueOptions -> DataType
(forall b. Data b => b -> b) -> IssueOptions -> IssueOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IssueOptions -> u
forall u. (forall d. Data d => d -> u) -> IssueOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueOptions -> c IssueOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueOptions -> c IssueOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueOptions -> c IssueOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueOptions
$ctoConstr :: IssueOptions -> Constr
toConstr :: IssueOptions -> Constr
$cdataTypeOf :: IssueOptions -> DataType
dataTypeOf :: IssueOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueOptions)
$cgmapT :: (forall b. Data b => b -> b) -> IssueOptions -> IssueOptions
gmapT :: (forall b. Data b => b -> b) -> IssueOptions -> IssueOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueOptions -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueOptions -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueOptions -> m IssueOptions
Data)

defaultIssueOptions :: IssueOptions
defaultIssueOptions :: IssueOptions
defaultIssueOptions = IssueOptions
    { issueOptionsFilter :: IssueFilter
issueOptionsFilter    = IssueFilter
IssueFilterAssigned
    , issueOptionsState :: Maybe IssueState
issueOptionsState     = IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
StateOpen
    , issueOptionsLabels :: [Name IssueLabel]
issueOptionsLabels    = []
    , issueOptionsSort :: SortIssue
issueOptionsSort      = SortIssue
SortIssueCreated
    , issueOptionsDirection :: SortDirection
issueOptionsDirection = SortDirection
SortDescending
    , issueOptionsSince :: Maybe UTCTime
issueOptionsSince     = Maybe UTCTime
forall a. Maybe a
Nothing
    }

-- | See <https://docs.github.com/en/rest/reference/issues#list-issues-assigned-to-the-authenticated-user--parameters>.
newtype IssueMod = IssueMod (IssueOptions -> IssueOptions)

instance Semigroup IssueMod where
    IssueMod IssueOptions -> IssueOptions
f <> :: IssueMod -> IssueMod -> IssueMod
<> IssueMod IssueOptions -> IssueOptions
g = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod (IssueOptions -> IssueOptions
g (IssueOptions -> IssueOptions)
-> (IssueOptions -> IssueOptions) -> IssueOptions -> IssueOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueOptions -> IssueOptions
f)

instance Monoid IssueMod where
    mempty :: IssueMod
mempty  = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod IssueOptions -> IssueOptions
forall a. a -> a
id
    mappend :: IssueMod -> IssueMod -> IssueMod
mappend = IssueMod -> IssueMod -> IssueMod
forall a. Semigroup a => a -> a -> a
(<>)

toIssueOptions :: IssueMod -> IssueOptions
toIssueOptions :: IssueMod -> IssueOptions
toIssueOptions (IssueMod IssueOptions -> IssueOptions
f) = IssueOptions -> IssueOptions
f IssueOptions
defaultIssueOptions

issueModToQueryString :: IssueMod -> QueryString
issueModToQueryString :: IssueMod -> QueryString
issueModToQueryString = IssueOptions -> QueryString
issueOptionsToQueryString (IssueOptions -> QueryString)
-> (IssueMod -> IssueOptions) -> IssueMod -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueMod -> IssueOptions
toIssueOptions

issueOptionsToQueryString :: IssueOptions -> QueryString
issueOptionsToQueryString :: IssueOptions -> QueryString
issueOptionsToQueryString (IssueOptions IssueFilter
filt Maybe IssueState
st [Name IssueLabel]
labels SortIssue
sort SortDirection
dir Maybe UTCTime
since) =
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"state"     ByteString
state'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"sort"      ByteString
sort'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"direction" ByteString
direction'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"filter" ByteString
filt'
    ] QueryString -> QueryString -> QueryString
forall a. [a] -> [a] -> [a]
++ [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"labels" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
labels'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"since" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
since'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    filt' :: ByteString
filt' = case IssueFilter
filt of
        IssueFilter
IssueFilterAssigned   -> ByteString
"assigned"
        IssueFilter
IssueFilterCreated    -> ByteString
"created"
        IssueFilter
IssueFilterMentioned  -> ByteString
"mentioned"
        IssueFilter
IssueFilterSubscribed -> ByteString
"subscribed"
        IssueFilter
IssueFilterAll        -> ByteString
"all"
    state' :: ByteString
state' = case Maybe IssueState
st of
        Maybe IssueState
Nothing          -> ByteString
"all"
        Just IssueState
StateOpen   -> ByteString
"open"
        Just IssueState
StateClosed -> ByteString
"closed"
    sort' :: ByteString
sort' = case SortIssue
sort of
        SortIssue
SortIssueCreated  -> ByteString
"created"
        SortIssue
SortIssueUpdated  -> ByteString
"updated"
        SortIssue
SortIssueComments -> ByteString
"comments"
    direction' :: ByteString
direction' = case SortDirection
dir of
       SortDirection
SortDescending -> ByteString
"desc"
       SortDirection
SortAscending  -> ByteString
"asc"

    since' :: Maybe ByteString
since' = (UTCTime -> ByteString) -> Maybe UTCTime -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (UTCTime -> Text) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show) Maybe UTCTime
since
    labels' :: Maybe ByteString
labels' = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> ([Name IssueLabel] -> Text) -> [Name IssueLabel] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text)
-> ([Name IssueLabel] -> [Text]) -> [Name IssueLabel] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name IssueLabel -> Text) -> [Name IssueLabel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name IssueLabel -> Text
forall entity. Name entity -> Text
untagName ([Name IssueLabel] -> ByteString)
-> Maybe [Name IssueLabel] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name IssueLabel] -> Maybe [Name IssueLabel]
forall (f :: * -> *) a. Foldable f => f a -> Maybe (f a)
nullToNothing [Name IssueLabel]
labels

nullToNothing :: Foldable f => f a -> Maybe (f a)
nullToNothing :: forall (f :: * -> *) a. Foldable f => f a -> Maybe (f a)
nullToNothing f a
xs
    | f a -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
xs   = Maybe (f a)
forall a. Maybe a
Nothing
    | Bool
otherwise = f a -> Maybe (f a)
forall a. a -> Maybe a
Just f a
xs

-------------------------------------------------------------------------------
-- Issues modifiers
-------------------------------------------------------------------------------

class HasComments mod where
    sortByComments :: mod

instance HasComments IssueMod where
    sortByComments :: IssueMod
sortByComments = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsSort = SortIssueComments }

instance HasComments IssueRepoMod where
    sortByComments :: IssueRepoMod
sortByComments = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsSort = SortIssueComments }


class HasLabels mod where
    optionsLabels :: Foldable f => f (Name IssueLabel) -> mod

instance HasLabels IssueMod where
    optionsLabels :: forall (f :: * -> *). Foldable f => f (Name IssueLabel) -> IssueMod
optionsLabels f (Name IssueLabel)
lbls = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsLabels = toList lbls }

instance HasLabels IssueRepoMod where
    optionsLabels :: forall (f :: * -> *).
Foldable f =>
f (Name IssueLabel) -> IssueRepoMod
optionsLabels f (Name IssueLabel)
lbls = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsLabels = toList lbls }


class HasSince mod where
    optionsSince :: UTCTime -> mod
    optionsSinceAll :: mod

instance HasSince IssueMod where
    optionsSince :: UTCTime -> IssueMod
optionsSince UTCTime
since = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsSince = Just since }
    optionsSinceAll :: IssueMod
optionsSinceAll = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
        IssueOptions
opts { issueOptionsSince = Nothing }

instance HasSince IssueRepoMod where
    optionsSince :: UTCTime -> IssueRepoMod
optionsSince UTCTime
since = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsSince = Just since }
    optionsSinceAll :: IssueRepoMod
optionsSinceAll = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
        IssueRepoOptions
opts { issueRepoOptionsSince = Nothing }

-------------------------------------------------------------------------------
-- Only issues modifiers
-------------------------------------------------------------------------------

optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues,
  optionsSubscribedIssues, optionsAllIssues  :: IssueMod
optionsAssignedIssues :: IssueMod
optionsAssignedIssues   = IssueFilter -> IssueMod
issueFilter IssueFilter
IssueFilterAssigned
optionsCreatedIssues :: IssueMod
optionsCreatedIssues    = IssueFilter -> IssueMod
issueFilter IssueFilter
IssueFilterCreated
optionsMentionedIssues :: IssueMod
optionsMentionedIssues  = IssueFilter -> IssueMod
issueFilter IssueFilter
IssueFilterMentioned
optionsSubscribedIssues :: IssueMod
optionsSubscribedIssues = IssueFilter -> IssueMod
issueFilter IssueFilter
IssueFilterSubscribed
optionsAllIssues :: IssueMod
optionsAllIssues        = IssueFilter -> IssueMod
issueFilter IssueFilter
IssueFilterAll

issueFilter :: IssueFilter -> IssueMod
issueFilter :: IssueFilter -> IssueMod
issueFilter IssueFilter
f = (IssueOptions -> IssueOptions) -> IssueMod
IssueMod ((IssueOptions -> IssueOptions) -> IssueMod)
-> (IssueOptions -> IssueOptions) -> IssueMod
forall a b. (a -> b) -> a -> b
$ \IssueOptions
opts ->
    IssueOptions
opts { issueOptionsFilter = f }

-------------------------------------------------------------------------------
-- Issues repo
-------------------------------------------------------------------------------

-- | Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@).
--
-- See <https://docs.github.com/en/rest/reference/issues#list-repository-issues>.
--
data IssueRepoOptions = IssueRepoOptions
    { IssueRepoOptions -> FilterBy (Id Milestone)
issueRepoOptionsMilestone :: !(FilterBy (Id Milestone))   -- ^ 'optionsMilestone' etc.
    , IssueRepoOptions -> Maybe IssueState
issueRepoOptionsState     :: !(Maybe IssueState)          -- ^ 'HasState'
    , IssueRepoOptions -> FilterBy (Name User)
issueRepoOptionsAssignee  :: !(FilterBy (Name User))      -- ^ 'optionsAssignee' etc.
    , IssueRepoOptions -> Maybe (Name User)
issueRepoOptionsCreator   :: !(Maybe (Name User))         -- ^ 'optionsCreator'
    , IssueRepoOptions -> Maybe (Name User)
issueRepoOptionsMentioned :: !(Maybe (Name User))         -- ^ 'optionsMentioned'
    , IssueRepoOptions -> [Name IssueLabel]
issueRepoOptionsLabels    :: ![Name IssueLabel]           -- ^ 'HasLabels'
    , IssueRepoOptions -> SortIssue
issueRepoOptionsSort      :: !SortIssue                   -- ^ 'HasCreatedUpdated' and 'HasComments'
    , IssueRepoOptions -> SortDirection
issueRepoOptionsDirection :: !SortDirection               -- ^ 'HasDirection'
    , IssueRepoOptions -> Maybe UTCTime
issueRepoOptionsSince     :: !(Maybe UTCTime)             -- ^ 'HasSince'
    }
  deriving
    (IssueRepoOptions -> IssueRepoOptions -> Bool
(IssueRepoOptions -> IssueRepoOptions -> Bool)
-> (IssueRepoOptions -> IssueRepoOptions -> Bool)
-> Eq IssueRepoOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueRepoOptions -> IssueRepoOptions -> Bool
== :: IssueRepoOptions -> IssueRepoOptions -> Bool
$c/= :: IssueRepoOptions -> IssueRepoOptions -> Bool
/= :: IssueRepoOptions -> IssueRepoOptions -> Bool
Eq, Eq IssueRepoOptions
Eq IssueRepoOptions =>
(IssueRepoOptions -> IssueRepoOptions -> Ordering)
-> (IssueRepoOptions -> IssueRepoOptions -> Bool)
-> (IssueRepoOptions -> IssueRepoOptions -> Bool)
-> (IssueRepoOptions -> IssueRepoOptions -> Bool)
-> (IssueRepoOptions -> IssueRepoOptions -> Bool)
-> (IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions)
-> (IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions)
-> Ord IssueRepoOptions
IssueRepoOptions -> IssueRepoOptions -> Bool
IssueRepoOptions -> IssueRepoOptions -> Ordering
IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IssueRepoOptions -> IssueRepoOptions -> Ordering
compare :: IssueRepoOptions -> IssueRepoOptions -> Ordering
$c< :: IssueRepoOptions -> IssueRepoOptions -> Bool
< :: IssueRepoOptions -> IssueRepoOptions -> Bool
$c<= :: IssueRepoOptions -> IssueRepoOptions -> Bool
<= :: IssueRepoOptions -> IssueRepoOptions -> Bool
$c> :: IssueRepoOptions -> IssueRepoOptions -> Bool
> :: IssueRepoOptions -> IssueRepoOptions -> Bool
$c>= :: IssueRepoOptions -> IssueRepoOptions -> Bool
>= :: IssueRepoOptions -> IssueRepoOptions -> Bool
$cmax :: IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions
max :: IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions
$cmin :: IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions
min :: IssueRepoOptions -> IssueRepoOptions -> IssueRepoOptions
Ord, Int -> IssueRepoOptions -> ShowS
[IssueRepoOptions] -> ShowS
IssueRepoOptions -> String
(Int -> IssueRepoOptions -> ShowS)
-> (IssueRepoOptions -> String)
-> ([IssueRepoOptions] -> ShowS)
-> Show IssueRepoOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueRepoOptions -> ShowS
showsPrec :: Int -> IssueRepoOptions -> ShowS
$cshow :: IssueRepoOptions -> String
show :: IssueRepoOptions -> String
$cshowList :: [IssueRepoOptions] -> ShowS
showList :: [IssueRepoOptions] -> ShowS
Show, (forall x. IssueRepoOptions -> Rep IssueRepoOptions x)
-> (forall x. Rep IssueRepoOptions x -> IssueRepoOptions)
-> Generic IssueRepoOptions
forall x. Rep IssueRepoOptions x -> IssueRepoOptions
forall x. IssueRepoOptions -> Rep IssueRepoOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IssueRepoOptions -> Rep IssueRepoOptions x
from :: forall x. IssueRepoOptions -> Rep IssueRepoOptions x
$cto :: forall x. Rep IssueRepoOptions x -> IssueRepoOptions
to :: forall x. Rep IssueRepoOptions x -> IssueRepoOptions
Generic, Typeable, Typeable IssueRepoOptions
Typeable IssueRepoOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IssueRepoOptions -> c IssueRepoOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueRepoOptions)
-> (IssueRepoOptions -> Constr)
-> (IssueRepoOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IssueRepoOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IssueRepoOptions))
-> ((forall b. Data b => b -> b)
    -> IssueRepoOptions -> IssueRepoOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> IssueRepoOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueRepoOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> IssueRepoOptions -> m IssueRepoOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IssueRepoOptions -> m IssueRepoOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> IssueRepoOptions -> m IssueRepoOptions)
-> Data IssueRepoOptions
IssueRepoOptions -> Constr
IssueRepoOptions -> DataType
(forall b. Data b => b -> b)
-> IssueRepoOptions -> IssueRepoOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> IssueRepoOptions -> u
forall u. (forall d. Data d => d -> u) -> IssueRepoOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueRepoOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueRepoOptions -> c IssueRepoOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueRepoOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueRepoOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueRepoOptions -> c IssueRepoOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueRepoOptions -> c IssueRepoOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueRepoOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueRepoOptions
$ctoConstr :: IssueRepoOptions -> Constr
toConstr :: IssueRepoOptions -> Constr
$cdataTypeOf :: IssueRepoOptions -> DataType
dataTypeOf :: IssueRepoOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueRepoOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueRepoOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueRepoOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IssueRepoOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> IssueRepoOptions -> IssueRepoOptions
gmapT :: (forall b. Data b => b -> b)
-> IssueRepoOptions -> IssueRepoOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueRepoOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueRepoOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueRepoOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IssueRepoOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> IssueRepoOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> IssueRepoOptions -> m IssueRepoOptions
Data)

defaultIssueRepoOptions :: IssueRepoOptions
defaultIssueRepoOptions :: IssueRepoOptions
defaultIssueRepoOptions = IssueRepoOptions
    { issueRepoOptionsMilestone :: FilterBy (Id Milestone)
issueRepoOptionsMilestone = FilterBy (Id Milestone)
forall a. FilterBy a
FilterNotSpecified
    , issueRepoOptionsState :: Maybe IssueState
issueRepoOptionsState     = (IssueState -> Maybe IssueState
forall a. a -> Maybe a
Just IssueState
StateOpen)
    , issueRepoOptionsAssignee :: FilterBy (Name User)
issueRepoOptionsAssignee  = FilterBy (Name User)
forall a. FilterBy a
FilterNotSpecified
    , issueRepoOptionsCreator :: Maybe (Name User)
issueRepoOptionsCreator   = Maybe (Name User)
forall a. Maybe a
Nothing
    , issueRepoOptionsMentioned :: Maybe (Name User)
issueRepoOptionsMentioned = Maybe (Name User)
forall a. Maybe a
Nothing
    , issueRepoOptionsLabels :: [Name IssueLabel]
issueRepoOptionsLabels    = []
    , issueRepoOptionsSort :: SortIssue
issueRepoOptionsSort      = SortIssue
SortIssueCreated
    , issueRepoOptionsDirection :: SortDirection
issueRepoOptionsDirection = SortDirection
SortDescending
    , issueRepoOptionsSince :: Maybe UTCTime
issueRepoOptionsSince     = Maybe UTCTime
forall a. Maybe a
Nothing
    }

-- | See <https://developer.github.com/v3/issues/#parameters-1>.
newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions)

instance Semigroup IssueRepoMod where
    IssueRepoMod IssueRepoOptions -> IssueRepoOptions
f <> :: IssueRepoMod -> IssueRepoMod -> IssueRepoMod
<> IssueRepoMod IssueRepoOptions -> IssueRepoOptions
g = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod (IssueRepoOptions -> IssueRepoOptions
g (IssueRepoOptions -> IssueRepoOptions)
-> (IssueRepoOptions -> IssueRepoOptions)
-> IssueRepoOptions
-> IssueRepoOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueRepoOptions -> IssueRepoOptions
f)

instance Monoid IssueRepoMod where
    mempty :: IssueRepoMod
mempty  = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod IssueRepoOptions -> IssueRepoOptions
forall a. a -> a
id
    mappend :: IssueRepoMod -> IssueRepoMod -> IssueRepoMod
mappend = IssueRepoMod -> IssueRepoMod -> IssueRepoMod
forall a. Semigroup a => a -> a -> a
(<>)

toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions
toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions
toIssueRepoOptions (IssueRepoMod IssueRepoOptions -> IssueRepoOptions
f) = IssueRepoOptions -> IssueRepoOptions
f IssueRepoOptions
defaultIssueRepoOptions

issueRepoModToQueryString :: IssueRepoMod -> QueryString
issueRepoModToQueryString :: IssueRepoMod -> QueryString
issueRepoModToQueryString = IssueRepoOptions -> QueryString
issueRepoOptionsToQueryString (IssueRepoOptions -> QueryString)
-> (IssueRepoMod -> IssueRepoOptions)
-> IssueRepoMod
-> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IssueRepoMod -> IssueRepoOptions
toIssueRepoOptions

issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString
issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString
issueRepoOptionsToQueryString IssueRepoOptions {[Name IssueLabel]
Maybe UTCTime
Maybe (Name User)
Maybe IssueState
FilterBy (Name User)
FilterBy (Id Milestone)
SortIssue
SortDirection
issueRepoOptionsState :: IssueRepoOptions -> Maybe IssueState
issueRepoOptionsDirection :: IssueRepoOptions -> SortDirection
issueRepoOptionsSort :: IssueRepoOptions -> SortIssue
issueRepoOptionsLabels :: IssueRepoOptions -> [Name IssueLabel]
issueRepoOptionsSince :: IssueRepoOptions -> Maybe UTCTime
issueRepoOptionsMilestone :: IssueRepoOptions -> FilterBy (Id Milestone)
issueRepoOptionsAssignee :: IssueRepoOptions -> FilterBy (Name User)
issueRepoOptionsCreator :: IssueRepoOptions -> Maybe (Name User)
issueRepoOptionsMentioned :: IssueRepoOptions -> Maybe (Name User)
issueRepoOptionsMilestone :: FilterBy (Id Milestone)
issueRepoOptionsState :: Maybe IssueState
issueRepoOptionsAssignee :: FilterBy (Name User)
issueRepoOptionsCreator :: Maybe (Name User)
issueRepoOptionsMentioned :: Maybe (Name User)
issueRepoOptionsLabels :: [Name IssueLabel]
issueRepoOptionsSort :: SortIssue
issueRepoOptionsDirection :: SortDirection
issueRepoOptionsSince :: Maybe UTCTime
..} =
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"state"     ByteString
state'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"sort"      ByteString
sort'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"direction" ByteString
direction'
    ] QueryString -> QueryString -> QueryString
forall a. [a] -> [a] -> [a]
++ [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"milestone" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
milestone'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"assignee"  (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
assignee'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"labels"    (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
labels'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"since"     (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
since'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"creator"   (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
creator'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"mentioned" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mentioned'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    filt :: (t -> Text) -> FilterBy t -> Maybe ByteString
filt t -> Text
f FilterBy t
x = case FilterBy t
x of
        FilterBy t
FilterAny          -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"*"
        FilterBy t
FilterNone         -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"none"
        FilterBy t
x'        -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ t -> Text
f t
x'
        FilterBy t
FilterNotSpecified -> Maybe ByteString
forall a. Maybe a
Nothing

    milestone' :: Maybe ByteString
milestone' = (Id Milestone -> Text)
-> FilterBy (Id Milestone) -> Maybe ByteString
forall {t}. (t -> Text) -> FilterBy t -> Maybe ByteString
filt (String -> Text
T.pack (String -> Text)
-> (Id Milestone -> String) -> Id Milestone -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Id Milestone -> Int) -> Id Milestone -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id Milestone -> Int
forall entity. Id entity -> Int
untagId) FilterBy (Id Milestone)
issueRepoOptionsMilestone
    assignee' :: Maybe ByteString
assignee'  = (Name User -> Text) -> FilterBy (Name User) -> Maybe ByteString
forall {t}. (t -> Text) -> FilterBy t -> Maybe ByteString
filt Name User -> Text
forall entity. Name entity -> Text
untagName FilterBy (Name User)
issueRepoOptionsAssignee

    state' :: ByteString
state' = case Maybe IssueState
issueRepoOptionsState of
        Maybe IssueState
Nothing          -> ByteString
"all"
        Just IssueState
StateOpen   -> ByteString
"open"
        Just IssueState
StateClosed -> ByteString
"closed"
    sort' :: ByteString
sort' = case SortIssue
issueRepoOptionsSort of
        SortIssue
SortIssueCreated  -> ByteString
"created"
        SortIssue
SortIssueUpdated  -> ByteString
"updated"
        SortIssue
SortIssueComments -> ByteString
"comments"
    direction' :: ByteString
direction' = case SortDirection
issueRepoOptionsDirection of
       SortDirection
SortDescending -> ByteString
"desc"
       SortDirection
SortAscending  -> ByteString
"asc"

    since' :: Maybe ByteString
since'     = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (UTCTime -> Text) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> ByteString) -> Maybe UTCTime -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
issueRepoOptionsSince
    labels' :: Maybe ByteString
labels'    = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> ([Name IssueLabel] -> Text) -> [Name IssueLabel] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text)
-> ([Name IssueLabel] -> [Text]) -> [Name IssueLabel] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name IssueLabel -> Text) -> [Name IssueLabel] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name IssueLabel -> Text
forall entity. Name entity -> Text
untagName ([Name IssueLabel] -> ByteString)
-> Maybe [Name IssueLabel] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name IssueLabel] -> Maybe [Name IssueLabel]
forall (f :: * -> *) a. Foldable f => f a -> Maybe (f a)
nullToNothing [Name IssueLabel]
issueRepoOptionsLabels
    creator' :: Maybe ByteString
creator'   = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (Name User -> Text) -> Name User -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name User -> Text
forall entity. Name entity -> Text
untagName (Name User -> ByteString) -> Maybe (Name User) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Name User)
issueRepoOptionsCreator
    mentioned' :: Maybe ByteString
mentioned' = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString)
-> (Name User -> Text) -> Name User -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name User -> Text
forall entity. Name entity -> Text
untagName (Name User -> ByteString) -> Maybe (Name User) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Name User)
issueRepoOptionsMentioned

-------------------------------------------------------------------------------
-- Issues repo modifiers
-------------------------------------------------------------------------------

-- | Issues created by a certain user.
optionsCreator :: Name User -> IssueRepoMod
optionsCreator :: Name User -> IssueRepoMod
optionsCreator Name User
u = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsCreator = Just u }

-- | Issue mentioning the given user.
optionsMentioned :: Name User -> IssueRepoMod
optionsMentioned :: Name User -> IssueRepoMod
optionsMentioned Name User
u = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsMentioned = Just u }

-- | Don't care about milestones (default).
--
-- 'optionsAnyMilestone' means there should be some milestone, but it can be any.
--
-- See <https://developer.github.com/v3/issues/#list-issues-for-a-repository>
optionsIrrelevantMilestone :: IssueRepoMod
optionsIrrelevantMilestone :: IssueRepoMod
optionsIrrelevantMilestone = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsMilestone = FilterNotSpecified }

-- | Issues that have a milestone.
optionsAnyMilestone :: IssueRepoMod
optionsAnyMilestone :: IssueRepoMod
optionsAnyMilestone = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsMilestone = FilterAny }

-- | Issues that have no milestone.
optionsNoMilestone :: IssueRepoMod
optionsNoMilestone :: IssueRepoMod
optionsNoMilestone = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsMilestone = FilterNone }

-- | Issues with the given milestone.
optionsMilestone :: Id Milestone -> IssueRepoMod
optionsMilestone :: Id Milestone -> IssueRepoMod
optionsMilestone Id Milestone
m = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsMilestone = FilterBy m }

-- | Issues with or without assignee (default).
optionsIrrelevantAssignee :: IssueRepoMod
optionsIrrelevantAssignee :: IssueRepoMod
optionsIrrelevantAssignee = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsAssignee = FilterNotSpecified }

-- | Issues assigned to someone.
optionsAnyAssignee :: IssueRepoMod
optionsAnyAssignee :: IssueRepoMod
optionsAnyAssignee = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsAssignee = FilterAny }

-- | Issues assigned to nobody.
optionsNoAssignee :: IssueRepoMod
optionsNoAssignee :: IssueRepoMod
optionsNoAssignee = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsAssignee = FilterNone }

-- | Issues assigned to a specific user.
optionsAssignee :: Name User -> IssueRepoMod
optionsAssignee :: Name User -> IssueRepoMod
optionsAssignee Name User
u = (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
IssueRepoMod ((IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod)
-> (IssueRepoOptions -> IssueRepoOptions) -> IssueRepoMod
forall a b. (a -> b) -> a -> b
$ \IssueRepoOptions
opts ->
    IssueRepoOptions
opts { issueRepoOptionsAssignee = FilterBy u }

-------------------------------------------------------------------------------
-- Actions artifacts
-------------------------------------------------------------------------------

-- | See <https://docs.github.com/en/rest/actions/artifacts#list-artifacts-for-a-repository>.
data ArtifactOptions = ArtifactOptions
    { ArtifactOptions -> Maybe Text
artifactOptionsName :: !(Maybe Text)
    }
  deriving
    (ArtifactOptions -> ArtifactOptions -> Bool
(ArtifactOptions -> ArtifactOptions -> Bool)
-> (ArtifactOptions -> ArtifactOptions -> Bool)
-> Eq ArtifactOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArtifactOptions -> ArtifactOptions -> Bool
== :: ArtifactOptions -> ArtifactOptions -> Bool
$c/= :: ArtifactOptions -> ArtifactOptions -> Bool
/= :: ArtifactOptions -> ArtifactOptions -> Bool
Eq, Eq ArtifactOptions
Eq ArtifactOptions =>
(ArtifactOptions -> ArtifactOptions -> Ordering)
-> (ArtifactOptions -> ArtifactOptions -> Bool)
-> (ArtifactOptions -> ArtifactOptions -> Bool)
-> (ArtifactOptions -> ArtifactOptions -> Bool)
-> (ArtifactOptions -> ArtifactOptions -> Bool)
-> (ArtifactOptions -> ArtifactOptions -> ArtifactOptions)
-> (ArtifactOptions -> ArtifactOptions -> ArtifactOptions)
-> Ord ArtifactOptions
ArtifactOptions -> ArtifactOptions -> Bool
ArtifactOptions -> ArtifactOptions -> Ordering
ArtifactOptions -> ArtifactOptions -> ArtifactOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ArtifactOptions -> ArtifactOptions -> Ordering
compare :: ArtifactOptions -> ArtifactOptions -> Ordering
$c< :: ArtifactOptions -> ArtifactOptions -> Bool
< :: ArtifactOptions -> ArtifactOptions -> Bool
$c<= :: ArtifactOptions -> ArtifactOptions -> Bool
<= :: ArtifactOptions -> ArtifactOptions -> Bool
$c> :: ArtifactOptions -> ArtifactOptions -> Bool
> :: ArtifactOptions -> ArtifactOptions -> Bool
$c>= :: ArtifactOptions -> ArtifactOptions -> Bool
>= :: ArtifactOptions -> ArtifactOptions -> Bool
$cmax :: ArtifactOptions -> ArtifactOptions -> ArtifactOptions
max :: ArtifactOptions -> ArtifactOptions -> ArtifactOptions
$cmin :: ArtifactOptions -> ArtifactOptions -> ArtifactOptions
min :: ArtifactOptions -> ArtifactOptions -> ArtifactOptions
Ord, Int -> ArtifactOptions -> ShowS
[ArtifactOptions] -> ShowS
ArtifactOptions -> String
(Int -> ArtifactOptions -> ShowS)
-> (ArtifactOptions -> String)
-> ([ArtifactOptions] -> ShowS)
-> Show ArtifactOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArtifactOptions -> ShowS
showsPrec :: Int -> ArtifactOptions -> ShowS
$cshow :: ArtifactOptions -> String
show :: ArtifactOptions -> String
$cshowList :: [ArtifactOptions] -> ShowS
showList :: [ArtifactOptions] -> ShowS
Show, (forall x. ArtifactOptions -> Rep ArtifactOptions x)
-> (forall x. Rep ArtifactOptions x -> ArtifactOptions)
-> Generic ArtifactOptions
forall x. Rep ArtifactOptions x -> ArtifactOptions
forall x. ArtifactOptions -> Rep ArtifactOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArtifactOptions -> Rep ArtifactOptions x
from :: forall x. ArtifactOptions -> Rep ArtifactOptions x
$cto :: forall x. Rep ArtifactOptions x -> ArtifactOptions
to :: forall x. Rep ArtifactOptions x -> ArtifactOptions
Generic, Typeable, Typeable ArtifactOptions
Typeable ArtifactOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ArtifactOptions -> c ArtifactOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ArtifactOptions)
-> (ArtifactOptions -> Constr)
-> (ArtifactOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ArtifactOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ArtifactOptions))
-> ((forall b. Data b => b -> b)
    -> ArtifactOptions -> ArtifactOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ArtifactOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ArtifactOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ArtifactOptions -> m ArtifactOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactOptions -> m ArtifactOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ArtifactOptions -> m ArtifactOptions)
-> Data ArtifactOptions
ArtifactOptions -> Constr
ArtifactOptions -> DataType
(forall b. Data b => b -> b) -> ArtifactOptions -> ArtifactOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactOptions -> u
forall u. (forall d. Data d => d -> u) -> ArtifactOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactOptions -> c ArtifactOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactOptions -> c ArtifactOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArtifactOptions -> c ArtifactOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArtifactOptions
$ctoConstr :: ArtifactOptions -> Constr
toConstr :: ArtifactOptions -> Constr
$cdataTypeOf :: ArtifactOptions -> DataType
dataTypeOf :: ArtifactOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArtifactOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArtifactOptions)
$cgmapT :: (forall b. Data b => b -> b) -> ArtifactOptions -> ArtifactOptions
gmapT :: (forall b. Data b => b -> b) -> ArtifactOptions -> ArtifactOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArtifactOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArtifactOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ArtifactOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArtifactOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArtifactOptions -> m ArtifactOptions
Data)

defaultArtifactOptions :: ArtifactOptions
defaultArtifactOptions :: ArtifactOptions
defaultArtifactOptions = ArtifactOptions
    { artifactOptionsName :: Maybe Text
artifactOptionsName = Maybe Text
forall a. Maybe a
Nothing
    }

-- | See <https://docs.github.com/en/rest/actions/artifacts#list-artifacts-for-a-repository>.
newtype ArtifactMod = ArtifactMod (ArtifactOptions -> ArtifactOptions)

instance Semigroup ArtifactMod where
    ArtifactMod ArtifactOptions -> ArtifactOptions
f <> :: ArtifactMod -> ArtifactMod -> ArtifactMod
<> ArtifactMod ArtifactOptions -> ArtifactOptions
g = (ArtifactOptions -> ArtifactOptions) -> ArtifactMod
ArtifactMod (ArtifactOptions -> ArtifactOptions
g (ArtifactOptions -> ArtifactOptions)
-> (ArtifactOptions -> ArtifactOptions)
-> ArtifactOptions
-> ArtifactOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactOptions -> ArtifactOptions
f)

instance Monoid ArtifactMod where
    mempty :: ArtifactMod
mempty  = (ArtifactOptions -> ArtifactOptions) -> ArtifactMod
ArtifactMod ArtifactOptions -> ArtifactOptions
forall a. a -> a
id
    mappend :: ArtifactMod -> ArtifactMod -> ArtifactMod
mappend = ArtifactMod -> ArtifactMod -> ArtifactMod
forall a. Semigroup a => a -> a -> a
(<>)

-- | Filters artifacts by exact match on their name field.
optionsArtifactName :: Text -> ArtifactMod
optionsArtifactName :: Text -> ArtifactMod
optionsArtifactName Text
n = (ArtifactOptions -> ArtifactOptions) -> ArtifactMod
ArtifactMod ((ArtifactOptions -> ArtifactOptions) -> ArtifactMod)
-> (ArtifactOptions -> ArtifactOptions) -> ArtifactMod
forall a b. (a -> b) -> a -> b
$ \ArtifactOptions
opts ->
    ArtifactOptions
opts { artifactOptionsName = Just n }

toArtifactOptions :: ArtifactMod -> ArtifactOptions
toArtifactOptions :: ArtifactMod -> ArtifactOptions
toArtifactOptions (ArtifactMod ArtifactOptions -> ArtifactOptions
f) = ArtifactOptions -> ArtifactOptions
f ArtifactOptions
defaultArtifactOptions

artifactModToQueryString :: ArtifactMod -> QueryString
artifactModToQueryString :: ArtifactMod -> QueryString
artifactModToQueryString = ArtifactOptions -> QueryString
artifactOptionsToQueryString (ArtifactOptions -> QueryString)
-> (ArtifactMod -> ArtifactOptions) -> ArtifactMod -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactMod -> ArtifactOptions
toArtifactOptions

artifactOptionsToQueryString :: ArtifactOptions -> QueryString
artifactOptionsToQueryString :: ArtifactOptions -> QueryString
artifactOptionsToQueryString (ArtifactOptions Maybe Text
name) =
    [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"name" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
name'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    name' :: Maybe ByteString
name' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
name

-------------------------------------------------------------------------------
-- Actions cache
-------------------------------------------------------------------------------

-- | See <https://docs.github.com/en/rest/actions/cache#list-github-actions-caches-for-a-repository>.
data CacheOptions = CacheOptions
    { CacheOptions -> Maybe Text
cacheOptionsRef       :: !(Maybe Text)
    , CacheOptions -> Maybe Text
cacheOptionsKey       :: !(Maybe Text)
    , CacheOptions -> Maybe SortCache
cacheOptionsSort      :: !(Maybe SortCache)
    , CacheOptions -> Maybe SortDirection
cacheOptionsDirection :: !(Maybe SortDirection)
    }
  deriving
    (CacheOptions -> CacheOptions -> Bool
(CacheOptions -> CacheOptions -> Bool)
-> (CacheOptions -> CacheOptions -> Bool) -> Eq CacheOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheOptions -> CacheOptions -> Bool
== :: CacheOptions -> CacheOptions -> Bool
$c/= :: CacheOptions -> CacheOptions -> Bool
/= :: CacheOptions -> CacheOptions -> Bool
Eq, Eq CacheOptions
Eq CacheOptions =>
(CacheOptions -> CacheOptions -> Ordering)
-> (CacheOptions -> CacheOptions -> Bool)
-> (CacheOptions -> CacheOptions -> Bool)
-> (CacheOptions -> CacheOptions -> Bool)
-> (CacheOptions -> CacheOptions -> Bool)
-> (CacheOptions -> CacheOptions -> CacheOptions)
-> (CacheOptions -> CacheOptions -> CacheOptions)
-> Ord CacheOptions
CacheOptions -> CacheOptions -> Bool
CacheOptions -> CacheOptions -> Ordering
CacheOptions -> CacheOptions -> CacheOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CacheOptions -> CacheOptions -> Ordering
compare :: CacheOptions -> CacheOptions -> Ordering
$c< :: CacheOptions -> CacheOptions -> Bool
< :: CacheOptions -> CacheOptions -> Bool
$c<= :: CacheOptions -> CacheOptions -> Bool
<= :: CacheOptions -> CacheOptions -> Bool
$c> :: CacheOptions -> CacheOptions -> Bool
> :: CacheOptions -> CacheOptions -> Bool
$c>= :: CacheOptions -> CacheOptions -> Bool
>= :: CacheOptions -> CacheOptions -> Bool
$cmax :: CacheOptions -> CacheOptions -> CacheOptions
max :: CacheOptions -> CacheOptions -> CacheOptions
$cmin :: CacheOptions -> CacheOptions -> CacheOptions
min :: CacheOptions -> CacheOptions -> CacheOptions
Ord, Int -> CacheOptions -> ShowS
[CacheOptions] -> ShowS
CacheOptions -> String
(Int -> CacheOptions -> ShowS)
-> (CacheOptions -> String)
-> ([CacheOptions] -> ShowS)
-> Show CacheOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheOptions -> ShowS
showsPrec :: Int -> CacheOptions -> ShowS
$cshow :: CacheOptions -> String
show :: CacheOptions -> String
$cshowList :: [CacheOptions] -> ShowS
showList :: [CacheOptions] -> ShowS
Show, (forall x. CacheOptions -> Rep CacheOptions x)
-> (forall x. Rep CacheOptions x -> CacheOptions)
-> Generic CacheOptions
forall x. Rep CacheOptions x -> CacheOptions
forall x. CacheOptions -> Rep CacheOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheOptions -> Rep CacheOptions x
from :: forall x. CacheOptions -> Rep CacheOptions x
$cto :: forall x. Rep CacheOptions x -> CacheOptions
to :: forall x. Rep CacheOptions x -> CacheOptions
Generic, Typeable, Typeable CacheOptions
Typeable CacheOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CacheOptions -> c CacheOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CacheOptions)
-> (CacheOptions -> Constr)
-> (CacheOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CacheOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CacheOptions))
-> ((forall b. Data b => b -> b) -> CacheOptions -> CacheOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CacheOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CacheOptions -> r)
-> (forall u. (forall d. Data d => d -> u) -> CacheOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CacheOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions)
-> Data CacheOptions
CacheOptions -> Constr
CacheOptions -> DataType
(forall b. Data b => b -> b) -> CacheOptions -> CacheOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CacheOptions -> u
forall u. (forall d. Data d => d -> u) -> CacheOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CacheOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CacheOptions -> c CacheOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CacheOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CacheOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CacheOptions -> c CacheOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CacheOptions -> c CacheOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CacheOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CacheOptions
$ctoConstr :: CacheOptions -> Constr
toConstr :: CacheOptions -> Constr
$cdataTypeOf :: CacheOptions -> DataType
dataTypeOf :: CacheOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CacheOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CacheOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CacheOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CacheOptions)
$cgmapT :: (forall b. Data b => b -> b) -> CacheOptions -> CacheOptions
gmapT :: (forall b. Data b => b -> b) -> CacheOptions -> CacheOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CacheOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CacheOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CacheOptions -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CacheOptions -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CacheOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CacheOptions -> m CacheOptions
Data)

defaultCacheOptions :: CacheOptions
defaultCacheOptions :: CacheOptions
defaultCacheOptions = CacheOptions
    { cacheOptionsRef :: Maybe Text
cacheOptionsRef       = Maybe Text
forall a. Maybe a
Nothing
    , cacheOptionsKey :: Maybe Text
cacheOptionsKey       = Maybe Text
forall a. Maybe a
Nothing
    , cacheOptionsSort :: Maybe SortCache
cacheOptionsSort      = Maybe SortCache
forall a. Maybe a
Nothing
    , cacheOptionsDirection :: Maybe SortDirection
cacheOptionsDirection = Maybe SortDirection
forall a. Maybe a
Nothing
    }

-- | See <https://docs.github.com/en/rest/actions/cache#list-github-actions-caches-for-a-repository>.
newtype CacheMod = CacheMod (CacheOptions -> CacheOptions)

instance Semigroup CacheMod where
    CacheMod CacheOptions -> CacheOptions
f <> :: CacheMod -> CacheMod -> CacheMod
<> CacheMod CacheOptions -> CacheOptions
g = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod (CacheOptions -> CacheOptions
g (CacheOptions -> CacheOptions)
-> (CacheOptions -> CacheOptions) -> CacheOptions -> CacheOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheOptions -> CacheOptions
f)

instance Monoid CacheMod where
    mempty :: CacheMod
mempty  = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod CacheOptions -> CacheOptions
forall a. a -> a
id
    mappend :: CacheMod -> CacheMod -> CacheMod
mappend = CacheMod -> CacheMod -> CacheMod
forall a. Semigroup a => a -> a -> a
(<>)

toCacheOptions :: CacheMod -> CacheOptions
toCacheOptions :: CacheMod -> CacheOptions
toCacheOptions (CacheMod CacheOptions -> CacheOptions
f) = CacheOptions -> CacheOptions
f CacheOptions
defaultCacheOptions

cacheModToQueryString :: CacheMod -> QueryString
cacheModToQueryString :: CacheMod -> QueryString
cacheModToQueryString = CacheOptions -> QueryString
cacheOptionsToQueryString (CacheOptions -> QueryString)
-> (CacheMod -> CacheOptions) -> CacheMod -> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheMod -> CacheOptions
toCacheOptions

cacheOptionsToQueryString :: CacheOptions -> QueryString
cacheOptionsToQueryString :: CacheOptions -> QueryString
cacheOptionsToQueryString (CacheOptions Maybe Text
ref Maybe Text
key Maybe SortCache
sort Maybe SortDirection
dir) =
    [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"ref"        (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
ref'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"key"        (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
key'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"sort"       (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
sort'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"directions" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
direction'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    sort' :: Maybe ByteString
sort' = Maybe SortCache
sort Maybe SortCache -> (SortCache -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        SortCache
SortCacheCreatedAt      -> ByteString
"created_at"
        SortCache
SortCacheLastAccessedAt -> ByteString
"last_accessed_at"
        SortCache
SortCacheSizeInBytes    -> ByteString
"size_in_bytes"
    direction' :: Maybe ByteString
direction' = Maybe SortDirection
dir Maybe SortDirection
-> (SortDirection -> ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
       SortDirection
SortDescending -> ByteString
"desc"
       SortDirection
SortAscending  -> ByteString
"asc"
    ref' :: Maybe ByteString
ref' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
ref
    key' :: Maybe ByteString
key' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
key

-------------------------------------------------------------------------------
-- Cache modifiers
-------------------------------------------------------------------------------

optionsRef :: Text -> CacheMod
optionsRef :: Text -> CacheMod
optionsRef Text
x = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsRef = Just x }

optionsNoRef :: CacheMod
optionsNoRef :: CacheMod
optionsNoRef = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsRef = Nothing }

optionsKey :: Text -> CacheMod
optionsKey :: Text -> CacheMod
optionsKey Text
x = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsKey = Just x }

optionsNoKey :: CacheMod
optionsNoKey :: CacheMod
optionsNoKey = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsKey = Nothing }

optionsDirectionAsc :: CacheMod
optionsDirectionAsc :: CacheMod
optionsDirectionAsc = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsDirection = Just SortAscending }

optionsDirectionDesc :: CacheMod
optionsDirectionDesc :: CacheMod
optionsDirectionDesc = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsDirection = Just SortDescending }

sortByCreatedAt :: CacheMod
sortByCreatedAt :: CacheMod
sortByCreatedAt = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsSort = Just SortCacheCreatedAt }

sortByLastAccessedAt :: CacheMod
sortByLastAccessedAt :: CacheMod
sortByLastAccessedAt = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsSort = Just SortCacheLastAccessedAt }

sortBySizeInBytes :: CacheMod
sortBySizeInBytes :: CacheMod
sortBySizeInBytes = (CacheOptions -> CacheOptions) -> CacheMod
CacheMod ((CacheOptions -> CacheOptions) -> CacheMod)
-> (CacheOptions -> CacheOptions) -> CacheMod
forall a b. (a -> b) -> a -> b
$ \CacheOptions
opts ->
    CacheOptions
opts { cacheOptionsSort = Just SortCacheSizeInBytes }

-------------------------------------------------------------------------------
-- Actions workflow runs
-------------------------------------------------------------------------------

-- | See <https://docs.github.com/en/rest/actions/workflow-runs#list-workflow-runs-for-a-repository>.
data WorkflowRunOptions = WorkflowRunOptions
    { WorkflowRunOptions -> Maybe Text
workflowRunOptionsActor   :: !(Maybe Text)
    , WorkflowRunOptions -> Maybe Text
workflowRunOptionsBranch  :: !(Maybe Text)
    , WorkflowRunOptions -> Maybe Text
workflowRunOptionsEvent   :: !(Maybe Text)
    , WorkflowRunOptions -> Maybe Text
workflowRunOptionsStatus  :: !(Maybe Text)
    , WorkflowRunOptions -> Maybe Text
workflowRunOptionsCreated :: !(Maybe Text)
    , WorkflowRunOptions -> Maybe Text
workflowRunOptionsHeadSha :: !(Maybe Text)
    }
  deriving
    (WorkflowRunOptions -> WorkflowRunOptions -> Bool
(WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> (WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> Eq WorkflowRunOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
== :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
$c/= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
/= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
Eq, Eq WorkflowRunOptions
Eq WorkflowRunOptions =>
(WorkflowRunOptions -> WorkflowRunOptions -> Ordering)
-> (WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> (WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> (WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> (WorkflowRunOptions -> WorkflowRunOptions -> Bool)
-> (WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions)
-> (WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions)
-> Ord WorkflowRunOptions
WorkflowRunOptions -> WorkflowRunOptions -> Bool
WorkflowRunOptions -> WorkflowRunOptions -> Ordering
WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorkflowRunOptions -> WorkflowRunOptions -> Ordering
compare :: WorkflowRunOptions -> WorkflowRunOptions -> Ordering
$c< :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
< :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
$c<= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
<= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
$c> :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
> :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
$c>= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
>= :: WorkflowRunOptions -> WorkflowRunOptions -> Bool
$cmax :: WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions
max :: WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions
$cmin :: WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions
min :: WorkflowRunOptions -> WorkflowRunOptions -> WorkflowRunOptions
Ord, Int -> WorkflowRunOptions -> ShowS
[WorkflowRunOptions] -> ShowS
WorkflowRunOptions -> String
(Int -> WorkflowRunOptions -> ShowS)
-> (WorkflowRunOptions -> String)
-> ([WorkflowRunOptions] -> ShowS)
-> Show WorkflowRunOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowRunOptions -> ShowS
showsPrec :: Int -> WorkflowRunOptions -> ShowS
$cshow :: WorkflowRunOptions -> String
show :: WorkflowRunOptions -> String
$cshowList :: [WorkflowRunOptions] -> ShowS
showList :: [WorkflowRunOptions] -> ShowS
Show, (forall x. WorkflowRunOptions -> Rep WorkflowRunOptions x)
-> (forall x. Rep WorkflowRunOptions x -> WorkflowRunOptions)
-> Generic WorkflowRunOptions
forall x. Rep WorkflowRunOptions x -> WorkflowRunOptions
forall x. WorkflowRunOptions -> Rep WorkflowRunOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkflowRunOptions -> Rep WorkflowRunOptions x
from :: forall x. WorkflowRunOptions -> Rep WorkflowRunOptions x
$cto :: forall x. Rep WorkflowRunOptions x -> WorkflowRunOptions
to :: forall x. Rep WorkflowRunOptions x -> WorkflowRunOptions
Generic, Typeable, Typeable WorkflowRunOptions
Typeable WorkflowRunOptions =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> WorkflowRunOptions
 -> c WorkflowRunOptions)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WorkflowRunOptions)
-> (WorkflowRunOptions -> Constr)
-> (WorkflowRunOptions -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WorkflowRunOptions))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WorkflowRunOptions))
-> ((forall b. Data b => b -> b)
    -> WorkflowRunOptions -> WorkflowRunOptions)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> WorkflowRunOptions -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WorkflowRunOptions -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> WorkflowRunOptions -> m WorkflowRunOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WorkflowRunOptions -> m WorkflowRunOptions)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> WorkflowRunOptions -> m WorkflowRunOptions)
-> Data WorkflowRunOptions
WorkflowRunOptions -> Constr
WorkflowRunOptions -> DataType
(forall b. Data b => b -> b)
-> WorkflowRunOptions -> WorkflowRunOptions
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowRunOptions -> u
forall u. (forall d. Data d => d -> u) -> WorkflowRunOptions -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRunOptions
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowRunOptions
-> c WorkflowRunOptions
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRunOptions)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRunOptions)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowRunOptions
-> c WorkflowRunOptions
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> WorkflowRunOptions
-> c WorkflowRunOptions
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRunOptions
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WorkflowRunOptions
$ctoConstr :: WorkflowRunOptions -> Constr
toConstr :: WorkflowRunOptions -> Constr
$cdataTypeOf :: WorkflowRunOptions -> DataType
dataTypeOf :: WorkflowRunOptions -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRunOptions)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WorkflowRunOptions)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRunOptions)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WorkflowRunOptions)
$cgmapT :: (forall b. Data b => b -> b)
-> WorkflowRunOptions -> WorkflowRunOptions
gmapT :: (forall b. Data b => b -> b)
-> WorkflowRunOptions -> WorkflowRunOptions
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WorkflowRunOptions -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WorkflowRunOptions -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> WorkflowRunOptions -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowRunOptions -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> WorkflowRunOptions -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> WorkflowRunOptions -> m WorkflowRunOptions
Data)

defaultWorkflowRunOptions :: WorkflowRunOptions
defaultWorkflowRunOptions :: WorkflowRunOptions
defaultWorkflowRunOptions = WorkflowRunOptions
    { workflowRunOptionsActor :: Maybe Text
workflowRunOptionsActor   = Maybe Text
forall a. Maybe a
Nothing
    , workflowRunOptionsBranch :: Maybe Text
workflowRunOptionsBranch  = Maybe Text
forall a. Maybe a
Nothing
    , workflowRunOptionsEvent :: Maybe Text
workflowRunOptionsEvent   = Maybe Text
forall a. Maybe a
Nothing
    , workflowRunOptionsStatus :: Maybe Text
workflowRunOptionsStatus  = Maybe Text
forall a. Maybe a
Nothing
    , workflowRunOptionsCreated :: Maybe Text
workflowRunOptionsCreated = Maybe Text
forall a. Maybe a
Nothing
    , workflowRunOptionsHeadSha :: Maybe Text
workflowRunOptionsHeadSha = Maybe Text
forall a. Maybe a
Nothing
    }

-- | See <https://docs.github.com/en/rest/actions/workflow-runs#list-workflow-runs-for-a-repository>.
newtype WorkflowRunMod = WorkflowRunMod (WorkflowRunOptions -> WorkflowRunOptions)

instance Semigroup WorkflowRunMod where
    WorkflowRunMod WorkflowRunOptions -> WorkflowRunOptions
f <> :: WorkflowRunMod -> WorkflowRunMod -> WorkflowRunMod
<> WorkflowRunMod WorkflowRunOptions -> WorkflowRunOptions
g = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod (WorkflowRunOptions -> WorkflowRunOptions
g (WorkflowRunOptions -> WorkflowRunOptions)
-> (WorkflowRunOptions -> WorkflowRunOptions)
-> WorkflowRunOptions
-> WorkflowRunOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkflowRunOptions -> WorkflowRunOptions
f)

instance Monoid WorkflowRunMod where
    mempty :: WorkflowRunMod
mempty  = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod WorkflowRunOptions -> WorkflowRunOptions
forall a. a -> a
id
    mappend :: WorkflowRunMod -> WorkflowRunMod -> WorkflowRunMod
mappend = WorkflowRunMod -> WorkflowRunMod -> WorkflowRunMod
forall a. Semigroup a => a -> a -> a
(<>)

toWorkflowRunOptions :: WorkflowRunMod -> WorkflowRunOptions
toWorkflowRunOptions :: WorkflowRunMod -> WorkflowRunOptions
toWorkflowRunOptions (WorkflowRunMod WorkflowRunOptions -> WorkflowRunOptions
f) = WorkflowRunOptions -> WorkflowRunOptions
f WorkflowRunOptions
defaultWorkflowRunOptions

workflowRunModToQueryString :: WorkflowRunMod -> QueryString
workflowRunModToQueryString :: WorkflowRunMod -> QueryString
workflowRunModToQueryString = WorkflowRunOptions -> QueryString
workflowRunOptionsToQueryString (WorkflowRunOptions -> QueryString)
-> (WorkflowRunMod -> WorkflowRunOptions)
-> WorkflowRunMod
-> QueryString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkflowRunMod -> WorkflowRunOptions
toWorkflowRunOptions

workflowRunOptionsToQueryString :: WorkflowRunOptions -> QueryString
workflowRunOptionsToQueryString :: WorkflowRunOptions -> QueryString
workflowRunOptionsToQueryString (WorkflowRunOptions Maybe Text
actor Maybe Text
branch Maybe Text
event Maybe Text
status Maybe Text
created Maybe Text
headSha) =
    [Maybe (ByteString, Maybe ByteString)] -> QueryString
forall a. [Maybe a] -> [a]
catMaybes
    [ ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"actor"    (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
actor'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"branch"   (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
branch'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"event"    (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
event'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"status"   (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
status'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"created"  (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
created'
    , ByteString -> ByteString -> (ByteString, Maybe ByteString)
forall {a} {a}. a -> a -> (a, Maybe a)
mk ByteString
"head_sha" (ByteString -> (ByteString, Maybe ByteString))
-> Maybe ByteString -> Maybe (ByteString, Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
headSha'
    ]
  where
    mk :: a -> a -> (a, Maybe a)
mk a
k a
v = (a
k, a -> Maybe a
forall a. a -> Maybe a
Just a
v)
    actor' :: Maybe ByteString
actor'   = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
actor
    branch' :: Maybe ByteString
branch'  = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
branch
    event' :: Maybe ByteString
event'   = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
event
    status' :: Maybe ByteString
status'  = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
status
    created' :: Maybe ByteString
created' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
created
    headSha' :: Maybe ByteString
headSha' = (Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 Maybe Text
headSha

-------------------------------------------------------------------------------
-- Workflow run modifiers
-------------------------------------------------------------------------------

optionsWorkflowRunActor :: Text -> WorkflowRunMod
optionsWorkflowRunActor :: Text -> WorkflowRunMod
optionsWorkflowRunActor Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsActor = Just x }

optionsWorkflowRunBranch :: Text -> WorkflowRunMod
optionsWorkflowRunBranch :: Text -> WorkflowRunMod
optionsWorkflowRunBranch Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsBranch = Just x }

optionsWorkflowRunEvent :: Text -> WorkflowRunMod
optionsWorkflowRunEvent :: Text -> WorkflowRunMod
optionsWorkflowRunEvent Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsEvent = Just x }

optionsWorkflowRunStatus :: Text -> WorkflowRunMod
optionsWorkflowRunStatus :: Text -> WorkflowRunMod
optionsWorkflowRunStatus Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsStatus = Just x }

optionsWorkflowRunCreated :: Text -> WorkflowRunMod
optionsWorkflowRunCreated :: Text -> WorkflowRunMod
optionsWorkflowRunCreated Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsCreated = Just x }

optionsWorkflowRunHeadSha :: Text -> WorkflowRunMod
optionsWorkflowRunHeadSha :: Text -> WorkflowRunMod
optionsWorkflowRunHeadSha Text
x = (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
WorkflowRunMod ((WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod)
-> (WorkflowRunOptions -> WorkflowRunOptions) -> WorkflowRunMod
forall a b. (a -> b) -> a -> b
$ \WorkflowRunOptions
opts ->
    WorkflowRunOptions
opts { workflowRunOptionsHeadSha = Just x }