{-# HLINT ignore "Use ?~" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{- |
Module: Temporal.Client.Schedule
Description: Schedule Workflow executions

A Schedule contains instructions for starting a Workflow Execution at specific times. Schedules provide a more flexible and user-friendly approach than Temporal Cron Jobs.

= How to enable Schedules
A Schedule has an identity and is independent of a Workflow Execution. This differs from a Temporal Cron Job, which relies on a cron schedule as a property of the Workflow Execution.

== Action
The Action of a Schedule is where the Workflow Execution properties are established, such as Workflow Type, Task Queue, parameters, and timeouts.

Workflow Executions started by a Schedule have the following additional properties:

- The Action's timestamp is appended to the Workflow Id.
- The TemporalScheduledStartTime Search Attribute is added to the Workflow Execution. The value is the Action's timestamp.
- The TemporalScheduledById Search Attribute is added to the Workflow Execution. The value is the Schedule Id.
- The Schedule Spec describes when the Action is taken. There are two kinds of Schedule Spec:
  - A simple interval, like "every 30 minutes" (aligned to start at the Unix epoch, and optionally including a phase offset).
  - A calendar-based expression, similar to the "cron expressions" supported by lots of software, including the older Temporal Cron feature.

The following calendar JSON fields are available:

- year
- month
- dayOfMonth
- dayOfWeek
- hour
- minute
- second
- comment

Each field can contain a comma-separated list of ranges (or the * wildcard), and each range can include a slash followed by a skip value. The hour, minute, and second fields default to 0 while the others default to *, so you can describe many useful specs with only a few fields.

For month, names of months may be used instead of integers (case-insensitive, abbreviations permitted). For dayOfWeek, day-of-week names may be used.

The comment field is optional and can be used to include a free-form description of the intent of the calendar spec, useful for complicated specs.

No matter which form you supply, calendar and interval specs are converted to canonical representations. What you see when you "describe" or "list" a Schedule might not look exactly like what you entered, but it has the same meaning.

== Other Spec features

=== Multiple intervals/calendar expressions

A Spec can have combinations of multiple intervals and/or calendar expressions to define a specific Schedule.

=== Time bounds

Provide an absolute start or end time (or both) with a Spec to ensure that no actions are taken before the start time or after the end time.

=== Exclusions

A Spec can contain exclusions in the form of zero or more calendar expressions. This can be used to express scheduling like "each Monday at noon except for holidays. You'll have to provide your own set of exclusions and include it in each schedule; there are no pre-defined sets. (This feature isn't currently exposed in tctl or the Temporal Web UI.)

=== Jitter

If given, a random offset between zero and the maximum jitter is added to each Action time (but bounded by the time until the next scheduled Action).

== Time zones

By default, calendar-based expressions are interpreted in UTC. Temporal recommends using UTC to avoid various surprising properties of time zones. If you don't want to use UTC, you can provide the name of a time zone. The time zone definition is loaded on the Temporal Server Worker Service from either disk or the fallback embedded in the binary.

For more operational control, embed the contents of the time zone database file in the Schedule Spec itself. (Note: this isn't currently exposed in tctl or the web UI.)

== Pause
A Schedule can be Paused. When a Schedule is Paused, the Spec has no effect. However, you can still force manual actions by using the tctl schedule trigger command.

To assist communication among developers and operators, a “notes” field can be updated on pause or resume to store an explanation for the current state.

== Backfill
A Schedule can be Backfilled. When a Schedule is Backfilled, all the Actions that would have been taken over a specified time period are taken now (in parallel if the AllowAll Overlap Policy is used; sequentially if BufferAll is used). You might use this to fill in runs from a time period when the Schedule was paused due to an external condition that's now resolved, or a period before the Schedule was created.

== Limit number of Actions
A Schedule can be limited to a certain number of scheduled Actions (that is, not trigger immediately). After that it will act as if it were paused.

== Policies
A Schedule supports a set of Policies that enable customizing behavior.

=== Overlap Policy
The Overlap Policy controls what happens when it is time to start a Workflow Execution but a previously started Workflow Execution is still running. The following options are available:

Skip: Default. Nothing happens; the Workflow Execution is not started.
BufferOne: Starts the Workflow Execution as soon as the current one completes. The buffer is limited to one. If another Workflow Execution is supposed to start, but one is already in the buffer, only the one in the buffer eventually starts.
BufferAll: Allows an unlimited number of Workflows to buffer. They are started sequentially.
CancelOther: Cancels the running Workflow Execution, and then starts the new one after the old one completes cancellation.
TerminateOther: Terminates the running Workflow Execution and starts the new one immediately.
AllowAll Starts any number of concurrent Workflow Executions. With this policy (and only this policy), more than one Workflow Execution, started by the Schedule, can run simultaneously.
Catchup Window
The Temporal Cluster might be down or unavailable at the time when a Schedule should take an Action. When it comes back up, the Catchup Window controls which missed Actions should be taken at that point. The default is one minute, which means that the Schedule attempts to take any Actions that wouldn't be more than one minute late. An outage that lasts longer than the Catchup Window could lead to missed Actions. (But you can always Backfill.)

=== Pause-on-failure
If this policy is set, a Workflow Execution started by a Schedule that ends with a failure or timeout (but not Cancellation or Termination) causes the Schedule to automatically pause.

Note that with the AllowAll Overlap Policy, this pause might not apply to the next Workflow Execution, because the next Workflow Execution might have started before the failed one finished. It applies only to Workflow Executions that were scheduled to start after the failed one finished.

== Last completion result
A Workflow started by a Schedule can obtain the completion result from the most recent successful run. (How you do this depends on the SDK you're using.)

For overlap policies that don't allow overlap, “the most recent successful run” is straightforward to define. For the AllowAll policy, it refers to the run that completed most recently, at the time that the run in question is started. Consider the following overlapping runs:

@
time -------------------------------------------->
 A     |----------------------|
 B               |-------|
 C                          |---------------|
 D                                |--------------T
@

If D asks for the last completion result at time T, it gets the result of A. Not B, even though B started more recently, because A completed later. And not C, even though C completed after A, because the result for D is captured when D is started, not when it's queried.

Failures and timeouts do not affect the last completion result.

Last failure
A Workflow started by a Schedule can obtain the details of the failure of the most recent run that ended at the time when the Workflow in question was started. Unlike last completion result, a successful run does reset the last failure.

Limitations
Internally, a Schedule is implemented as a Workflow. If you're using Advanced Visibility (Elasticsearch), these Workflow Executions are hidden from normal views. If you're using Standard Visibility, they are visible, though there's no need to interact with them directly.
-}
module Temporal.Client.Schedule (
  mkScheduleClient,
  ScheduleClient,
  CreateScheduleRequest (..),
  createSchedule,
  deleteSchedule,
  listSchedules,
  ScheduleListInfo (..),
  ScheduleListEntry (..),
  ScheduleActionResult (..),
  ListSchedulesOptions (..),
  ListScheduleMatchingTimesOptions (..),
  listScheduleMatchingTimes,
  describeSchedule,
  DescribeScheduleResponse (..),
  patchSchedule,
  SchedulePatch (..),
  updateSchedule,
  UpdateScheduleRequest (..),
  ScheduleId (..),
  scheduleSpec,
  ScheduleSpec (..),
  Schedule (..),
  TriggerImmediatelyRequest (..),
  BackfillRequest (..),
  StructuredCalendarSpec (..),
  structuredCalendarSpec,
  calendarSpec,
  CalendarSpec (..),
  IntervalSpec (..),
  WorkflowExecution (..),
  ScheduleInfo (..),
  mkScheduleAction,
  ScheduleAction (..),
  SchedulePolicies (..),
  ScheduleState (..),
  OverlapPolicy (..),
  Range (..),
  module Temporal.Duration,
) where

import Control.Monad
import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.Conduit
import Data.Int (Int32, Int64)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.ProtoLens
import Data.Text (Text)
-- import Temporal.Client (StartWorkflowOptions(..), TimeoutOptions(..))

import Data.Time.Clock.System (SystemTime)
import Data.Vector (Vector)
import qualified Data.Vector as V
import GHC.Generics
import GHC.Records
import Lens.Family2
import qualified Proto.Temporal.Api.Common.V1.Message as C
import qualified Proto.Temporal.Api.Common.V1.Message_Fields as C
import qualified Proto.Temporal.Api.Enums.V1.Schedule as S
import Proto.Temporal.Api.Enums.V1.TaskQueue (TaskQueueKind (..))
import qualified Proto.Temporal.Api.Schedule.V1.Message as S
import qualified Proto.Temporal.Api.Schedule.V1.Message_Fields as S
import qualified Proto.Temporal.Api.Taskqueue.V1.Message_Fields as TQ
import qualified Proto.Temporal.Api.Workflow.V1.Message as W
import qualified Proto.Temporal.Api.Workflow.V1.Message_Fields as W
import qualified Proto.Temporal.Api.Workflowservice.V1.RequestResponse_Fields as WF
import Temporal.Client
import Temporal.Common
import Temporal.Core.Client
import qualified Temporal.Core.Client.WorkflowService as Core
import Temporal.Duration
import Temporal.Payload
import Temporal.SearchAttributes
import Temporal.SearchAttributes.Internal
import Temporal.Workflow
import UnliftIO


throwEither :: (MonadIO m, Exception e) => m (Either e a) -> m a
throwEither :: forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither m (Either e a)
m = do
  e <- m (Either e a)
m
  case e of
    Left e
err -> e -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO e
err
    Right a
ok -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ok


---------------------------------------------------------------------------------
-- ScheduleClient

mkScheduleClient :: Client -> Namespace -> ScheduleClient
mkScheduleClient :: Client -> Namespace -> ScheduleClient
mkScheduleClient Client
c Namespace
ns =
  ScheduleClient
    { scheduleClient :: Client
scheduleClient = Client
c
    , scheduleClientNamespace :: Namespace
scheduleClientNamespace = Namespace
ns
    }


data ScheduleClient = ScheduleClient
  { ScheduleClient -> Client
scheduleClient :: Client
  , ScheduleClient -> Namespace
scheduleClientNamespace :: Namespace
  }


instance HasField "identity" ScheduleClient Text where
  getField :: ScheduleClient -> Text
getField ScheduleClient
c = (Client -> ClientConfig
clientConfig ScheduleClient
c.scheduleClient).identity


data CreateScheduleRequest = CreateScheduleRequest
  { CreateScheduleRequest -> ScheduleId
scheduleId :: !ScheduleId
  -- ^ The id of the new schedule.
  , CreateScheduleRequest -> Schedule
schedule :: !Schedule
  -- ^ The schedule spec, policies, action, and initial state.
  , CreateScheduleRequest -> Maybe SchedulePatch
initialPatch :: !(Maybe SchedulePatch)
  -- ^ Optional initial patch (e.g. to run the action once immediately).
  , CreateScheduleRequest -> Map Text Payload
memo :: !(Map Text Payload)
  -- ^ Memo attached to the schedule itself.
  , CreateScheduleRequest -> Text
requestId :: !Text
  -- ^ A unique identifier for this create request for idempotence. Typically UUIDv4.
  , CreateScheduleRequest -> Map SearchAttributeKey SearchAttributeType
searchAttributes :: !(Map SearchAttributeKey SearchAttributeType)
  -- ^ Search attributes attached to the schedule itself.
  }
  deriving stock (Int -> CreateScheduleRequest -> ShowS
[CreateScheduleRequest] -> ShowS
CreateScheduleRequest -> String
(Int -> CreateScheduleRequest -> ShowS)
-> (CreateScheduleRequest -> String)
-> ([CreateScheduleRequest] -> ShowS)
-> Show CreateScheduleRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateScheduleRequest -> ShowS
showsPrec :: Int -> CreateScheduleRequest -> ShowS
$cshow :: CreateScheduleRequest -> String
show :: CreateScheduleRequest -> String
$cshowList :: [CreateScheduleRequest] -> ShowS
showList :: [CreateScheduleRequest] -> ShowS
Show, CreateScheduleRequest -> CreateScheduleRequest -> Bool
(CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> (CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> Eq CreateScheduleRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
== :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
$c/= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
/= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
Eq, Eq CreateScheduleRequest
Eq CreateScheduleRequest =>
(CreateScheduleRequest -> CreateScheduleRequest -> Ordering)
-> (CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> (CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> (CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> (CreateScheduleRequest -> CreateScheduleRequest -> Bool)
-> (CreateScheduleRequest
    -> CreateScheduleRequest -> CreateScheduleRequest)
-> (CreateScheduleRequest
    -> CreateScheduleRequest -> CreateScheduleRequest)
-> Ord CreateScheduleRequest
CreateScheduleRequest -> CreateScheduleRequest -> Bool
CreateScheduleRequest -> CreateScheduleRequest -> Ordering
CreateScheduleRequest
-> CreateScheduleRequest -> CreateScheduleRequest
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 :: CreateScheduleRequest -> CreateScheduleRequest -> Ordering
compare :: CreateScheduleRequest -> CreateScheduleRequest -> Ordering
$c< :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
< :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
$c<= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
<= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
$c> :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
> :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
$c>= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
>= :: CreateScheduleRequest -> CreateScheduleRequest -> Bool
$cmax :: CreateScheduleRequest
-> CreateScheduleRequest -> CreateScheduleRequest
max :: CreateScheduleRequest
-> CreateScheduleRequest -> CreateScheduleRequest
$cmin :: CreateScheduleRequest
-> CreateScheduleRequest -> CreateScheduleRequest
min :: CreateScheduleRequest
-> CreateScheduleRequest -> CreateScheduleRequest
Ord, (forall x. CreateScheduleRequest -> Rep CreateScheduleRequest x)
-> (forall x. Rep CreateScheduleRequest x -> CreateScheduleRequest)
-> Generic CreateScheduleRequest
forall x. Rep CreateScheduleRequest x -> CreateScheduleRequest
forall x. CreateScheduleRequest -> Rep CreateScheduleRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateScheduleRequest -> Rep CreateScheduleRequest x
from :: forall x. CreateScheduleRequest -> Rep CreateScheduleRequest x
$cto :: forall x. Rep CreateScheduleRequest x -> CreateScheduleRequest
to :: forall x. Rep CreateScheduleRequest x -> CreateScheduleRequest
Generic)


-- | Creates a new schedule.
createSchedule
  :: MonadIO m
  => ScheduleClient
  -> CreateScheduleRequest
  -> m ByteString
createSchedule :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient -> CreateScheduleRequest -> m ByteString
createSchedule ScheduleClient
s CreateScheduleRequest
opts = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
  searchAttributes <- Map SearchAttributeKey SearchAttributeType -> IO (Map Text Payload)
searchAttributesToProto CreateScheduleRequest
opts.searchAttributes
  resp <-
    throwEither $
      Core.createSchedule
        (scheduleClient s)
        ( defMessage
            & WF.namespace .~ rawNamespace s.scheduleClientNamespace
            & WF.scheduleId .~ rawScheduleId opts.scheduleId
            & WF.schedule .~ scheduleToProto opts.schedule
            & WF.identity .~ s.identity
            & WF.maybe'initialPatch .~ fmap schedulePatchToProto opts.initialPatch
            & WF.memo .~ convertToProtoMemo opts.memo
            & WF.requestId .~ opts.requestId
            & WF.searchAttributes .~ (defMessage & C.indexedFields .~ searchAttributes)
        )
  pure $ resp ^. WF.conflictToken


-- | Deletes a schedule, removing it from the system.
deleteSchedule
  :: MonadIO m
  => ScheduleClient
  -> ScheduleId
  -> m ()
deleteSchedule :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient -> ScheduleId -> m ()
deleteSchedule ScheduleClient
c ScheduleId
sId = do
  _resp <-
    IO DeleteScheduleResponse -> m DeleteScheduleResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeleteScheduleResponse -> m DeleteScheduleResponse)
-> IO DeleteScheduleResponse -> m DeleteScheduleResponse
forall a b. (a -> b) -> a -> b
$
      IO (Either RpcError DeleteScheduleResponse)
-> IO DeleteScheduleResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError DeleteScheduleResponse)
 -> IO DeleteScheduleResponse)
-> IO (Either RpcError DeleteScheduleResponse)
-> IO DeleteScheduleResponse
forall a b. (a -> b) -> a -> b
$
        Client
-> DeleteScheduleRequest
-> IO (Either RpcError DeleteScheduleResponse)
Core.deleteSchedule
          ScheduleClient
c.scheduleClient
          ( DeleteScheduleRequest
forall msg. Message msg => msg
defMessage
              DeleteScheduleRequest
-> (DeleteScheduleRequest -> DeleteScheduleRequest)
-> DeleteScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f DeleteScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f DeleteScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f DeleteScheduleRequest Text)
-> Text -> DeleteScheduleRequest -> DeleteScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
              DeleteScheduleRequest
-> (DeleteScheduleRequest -> DeleteScheduleRequest)
-> DeleteScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f DeleteScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f DeleteScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "identity" a) =>
LensLike' f s a
WF.identity (forall {f :: * -> *}.
 Identical f =>
 LensLike' f DeleteScheduleRequest Text)
-> Text -> DeleteScheduleRequest -> DeleteScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleClient
c.identity
              DeleteScheduleRequest
-> (DeleteScheduleRequest -> DeleteScheduleRequest)
-> DeleteScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f DeleteScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f DeleteScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleId" a) =>
LensLike' f s a
WF.scheduleId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f DeleteScheduleRequest Text)
-> Text -> DeleteScheduleRequest -> DeleteScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleId -> Text
rawScheduleId ScheduleId
sId
          )
  pure ()


data ListSchedulesOptions = ListSchedulesOptions
  { ListSchedulesOptions -> Int32
maximumPageSize :: Int32
  }
  deriving stock (Int -> ListSchedulesOptions -> ShowS
[ListSchedulesOptions] -> ShowS
ListSchedulesOptions -> String
(Int -> ListSchedulesOptions -> ShowS)
-> (ListSchedulesOptions -> String)
-> ([ListSchedulesOptions] -> ShowS)
-> Show ListSchedulesOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListSchedulesOptions -> ShowS
showsPrec :: Int -> ListSchedulesOptions -> ShowS
$cshow :: ListSchedulesOptions -> String
show :: ListSchedulesOptions -> String
$cshowList :: [ListSchedulesOptions] -> ShowS
showList :: [ListSchedulesOptions] -> ShowS
Show, ListSchedulesOptions -> ListSchedulesOptions -> Bool
(ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> (ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> Eq ListSchedulesOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
== :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
$c/= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
/= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
Eq, Eq ListSchedulesOptions
Eq ListSchedulesOptions =>
(ListSchedulesOptions -> ListSchedulesOptions -> Ordering)
-> (ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> (ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> (ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> (ListSchedulesOptions -> ListSchedulesOptions -> Bool)
-> (ListSchedulesOptions
    -> ListSchedulesOptions -> ListSchedulesOptions)
-> (ListSchedulesOptions
    -> ListSchedulesOptions -> ListSchedulesOptions)
-> Ord ListSchedulesOptions
ListSchedulesOptions -> ListSchedulesOptions -> Bool
ListSchedulesOptions -> ListSchedulesOptions -> Ordering
ListSchedulesOptions
-> ListSchedulesOptions -> ListSchedulesOptions
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 :: ListSchedulesOptions -> ListSchedulesOptions -> Ordering
compare :: ListSchedulesOptions -> ListSchedulesOptions -> Ordering
$c< :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
< :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
$c<= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
<= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
$c> :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
> :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
$c>= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
>= :: ListSchedulesOptions -> ListSchedulesOptions -> Bool
$cmax :: ListSchedulesOptions
-> ListSchedulesOptions -> ListSchedulesOptions
max :: ListSchedulesOptions
-> ListSchedulesOptions -> ListSchedulesOptions
$cmin :: ListSchedulesOptions
-> ListSchedulesOptions -> ListSchedulesOptions
min :: ListSchedulesOptions
-> ListSchedulesOptions -> ListSchedulesOptions
Ord, (forall x. ListSchedulesOptions -> Rep ListSchedulesOptions x)
-> (forall x. Rep ListSchedulesOptions x -> ListSchedulesOptions)
-> Generic ListSchedulesOptions
forall x. Rep ListSchedulesOptions x -> ListSchedulesOptions
forall x. ListSchedulesOptions -> Rep ListSchedulesOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListSchedulesOptions -> Rep ListSchedulesOptions x
from :: forall x. ListSchedulesOptions -> Rep ListSchedulesOptions x
$cto :: forall x. Rep ListSchedulesOptions x -> ListSchedulesOptions
to :: forall x. Rep ListSchedulesOptions x -> ListSchedulesOptions
Generic)


data WorkflowExecution = WorkflowExecution
  { WorkflowExecution -> WorkflowId
workflowId :: !WorkflowId
  , WorkflowExecution -> RunId
runId :: !RunId
  }
  deriving stock (Int -> WorkflowExecution -> ShowS
[WorkflowExecution] -> ShowS
WorkflowExecution -> String
(Int -> WorkflowExecution -> ShowS)
-> (WorkflowExecution -> String)
-> ([WorkflowExecution] -> ShowS)
-> Show WorkflowExecution
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecution -> ShowS
showsPrec :: Int -> WorkflowExecution -> ShowS
$cshow :: WorkflowExecution -> String
show :: WorkflowExecution -> String
$cshowList :: [WorkflowExecution] -> ShowS
showList :: [WorkflowExecution] -> ShowS
Show, WorkflowExecution -> WorkflowExecution -> Bool
(WorkflowExecution -> WorkflowExecution -> Bool)
-> (WorkflowExecution -> WorkflowExecution -> Bool)
-> Eq WorkflowExecution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecution -> WorkflowExecution -> Bool
== :: WorkflowExecution -> WorkflowExecution -> Bool
$c/= :: WorkflowExecution -> WorkflowExecution -> Bool
/= :: WorkflowExecution -> WorkflowExecution -> Bool
Eq, Eq WorkflowExecution
Eq WorkflowExecution =>
(WorkflowExecution -> WorkflowExecution -> Ordering)
-> (WorkflowExecution -> WorkflowExecution -> Bool)
-> (WorkflowExecution -> WorkflowExecution -> Bool)
-> (WorkflowExecution -> WorkflowExecution -> Bool)
-> (WorkflowExecution -> WorkflowExecution -> Bool)
-> (WorkflowExecution -> WorkflowExecution -> WorkflowExecution)
-> (WorkflowExecution -> WorkflowExecution -> WorkflowExecution)
-> Ord WorkflowExecution
WorkflowExecution -> WorkflowExecution -> Bool
WorkflowExecution -> WorkflowExecution -> Ordering
WorkflowExecution -> WorkflowExecution -> WorkflowExecution
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 :: WorkflowExecution -> WorkflowExecution -> Ordering
compare :: WorkflowExecution -> WorkflowExecution -> Ordering
$c< :: WorkflowExecution -> WorkflowExecution -> Bool
< :: WorkflowExecution -> WorkflowExecution -> Bool
$c<= :: WorkflowExecution -> WorkflowExecution -> Bool
<= :: WorkflowExecution -> WorkflowExecution -> Bool
$c> :: WorkflowExecution -> WorkflowExecution -> Bool
> :: WorkflowExecution -> WorkflowExecution -> Bool
$c>= :: WorkflowExecution -> WorkflowExecution -> Bool
>= :: WorkflowExecution -> WorkflowExecution -> Bool
$cmax :: WorkflowExecution -> WorkflowExecution -> WorkflowExecution
max :: WorkflowExecution -> WorkflowExecution -> WorkflowExecution
$cmin :: WorkflowExecution -> WorkflowExecution -> WorkflowExecution
min :: WorkflowExecution -> WorkflowExecution -> WorkflowExecution
Ord, (forall x. WorkflowExecution -> Rep WorkflowExecution x)
-> (forall x. Rep WorkflowExecution x -> WorkflowExecution)
-> Generic WorkflowExecution
forall x. Rep WorkflowExecution x -> WorkflowExecution
forall x. WorkflowExecution -> Rep WorkflowExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WorkflowExecution -> Rep WorkflowExecution x
from :: forall x. WorkflowExecution -> Rep WorkflowExecution x
$cto :: forall x. Rep WorkflowExecution x -> WorkflowExecution
to :: forall x. Rep WorkflowExecution x -> WorkflowExecution
Generic)


workflowExecutionFromProto :: C.WorkflowExecution -> WorkflowExecution
workflowExecutionFromProto :: WorkflowExecution -> WorkflowExecution
workflowExecutionFromProto WorkflowExecution
p =
  WorkflowExecution
    { workflowId :: WorkflowId
workflowId = Text -> WorkflowId
WorkflowId (WorkflowExecution
p WorkflowExecution
-> FoldLike Text WorkflowExecution WorkflowExecution Text Text
-> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text WorkflowExecution WorkflowExecution Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowId" a) =>
LensLike' f s a
C.workflowId)
    , runId :: RunId
runId = Text -> RunId
RunId (WorkflowExecution
p WorkflowExecution
-> FoldLike Text WorkflowExecution WorkflowExecution Text Text
-> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text WorkflowExecution WorkflowExecution Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "runId" a) =>
LensLike' f s a
C.runId)
    }


data ScheduleListInfo = ScheduleListInfo
  { ScheduleListInfo -> Maybe ScheduleSpec
spec :: !(Maybe ScheduleSpec)
  , ScheduleListInfo -> WorkflowType
workflowType :: !WorkflowType
  , ScheduleListInfo -> Text
notes :: !Text
  , ScheduleListInfo -> Bool
paused :: !Bool
  , ScheduleListInfo -> [ScheduleActionResult]
recentActions :: ![ScheduleActionResult]
  , ScheduleListInfo -> [SystemTime]
futureActionTimes :: ![SystemTime]
  }
  deriving stock (Int -> ScheduleListInfo -> ShowS
[ScheduleListInfo] -> ShowS
ScheduleListInfo -> String
(Int -> ScheduleListInfo -> ShowS)
-> (ScheduleListInfo -> String)
-> ([ScheduleListInfo] -> ShowS)
-> Show ScheduleListInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleListInfo -> ShowS
showsPrec :: Int -> ScheduleListInfo -> ShowS
$cshow :: ScheduleListInfo -> String
show :: ScheduleListInfo -> String
$cshowList :: [ScheduleListInfo] -> ShowS
showList :: [ScheduleListInfo] -> ShowS
Show, ScheduleListInfo -> ScheduleListInfo -> Bool
(ScheduleListInfo -> ScheduleListInfo -> Bool)
-> (ScheduleListInfo -> ScheduleListInfo -> Bool)
-> Eq ScheduleListInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleListInfo -> ScheduleListInfo -> Bool
== :: ScheduleListInfo -> ScheduleListInfo -> Bool
$c/= :: ScheduleListInfo -> ScheduleListInfo -> Bool
/= :: ScheduleListInfo -> ScheduleListInfo -> Bool
Eq, Eq ScheduleListInfo
Eq ScheduleListInfo =>
(ScheduleListInfo -> ScheduleListInfo -> Ordering)
-> (ScheduleListInfo -> ScheduleListInfo -> Bool)
-> (ScheduleListInfo -> ScheduleListInfo -> Bool)
-> (ScheduleListInfo -> ScheduleListInfo -> Bool)
-> (ScheduleListInfo -> ScheduleListInfo -> Bool)
-> (ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo)
-> (ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo)
-> Ord ScheduleListInfo
ScheduleListInfo -> ScheduleListInfo -> Bool
ScheduleListInfo -> ScheduleListInfo -> Ordering
ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo
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 :: ScheduleListInfo -> ScheduleListInfo -> Ordering
compare :: ScheduleListInfo -> ScheduleListInfo -> Ordering
$c< :: ScheduleListInfo -> ScheduleListInfo -> Bool
< :: ScheduleListInfo -> ScheduleListInfo -> Bool
$c<= :: ScheduleListInfo -> ScheduleListInfo -> Bool
<= :: ScheduleListInfo -> ScheduleListInfo -> Bool
$c> :: ScheduleListInfo -> ScheduleListInfo -> Bool
> :: ScheduleListInfo -> ScheduleListInfo -> Bool
$c>= :: ScheduleListInfo -> ScheduleListInfo -> Bool
>= :: ScheduleListInfo -> ScheduleListInfo -> Bool
$cmax :: ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo
max :: ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo
$cmin :: ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo
min :: ScheduleListInfo -> ScheduleListInfo -> ScheduleListInfo
Ord, (forall x. ScheduleListInfo -> Rep ScheduleListInfo x)
-> (forall x. Rep ScheduleListInfo x -> ScheduleListInfo)
-> Generic ScheduleListInfo
forall x. Rep ScheduleListInfo x -> ScheduleListInfo
forall x. ScheduleListInfo -> Rep ScheduleListInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleListInfo -> Rep ScheduleListInfo x
from :: forall x. ScheduleListInfo -> Rep ScheduleListInfo x
$cto :: forall x. Rep ScheduleListInfo x -> ScheduleListInfo
to :: forall x. Rep ScheduleListInfo x -> ScheduleListInfo
Generic)


data ScheduleListEntry = ScheduleListEntry
  { ScheduleListEntry -> ScheduleId
scheduleId :: !ScheduleId
  , ScheduleListEntry -> Map Text Payload
memo :: !(Map Text Payload)
  , ScheduleListEntry -> Map SearchAttributeKey SearchAttributeType
searchAttributes :: !(Map SearchAttributeKey SearchAttributeType)
  , ScheduleListEntry -> Maybe ScheduleListInfo
info :: !(Maybe ScheduleListInfo)
  }
  deriving stock (Int -> ScheduleListEntry -> ShowS
[ScheduleListEntry] -> ShowS
ScheduleListEntry -> String
(Int -> ScheduleListEntry -> ShowS)
-> (ScheduleListEntry -> String)
-> ([ScheduleListEntry] -> ShowS)
-> Show ScheduleListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleListEntry -> ShowS
showsPrec :: Int -> ScheduleListEntry -> ShowS
$cshow :: ScheduleListEntry -> String
show :: ScheduleListEntry -> String
$cshowList :: [ScheduleListEntry] -> ShowS
showList :: [ScheduleListEntry] -> ShowS
Show, ScheduleListEntry -> ScheduleListEntry -> Bool
(ScheduleListEntry -> ScheduleListEntry -> Bool)
-> (ScheduleListEntry -> ScheduleListEntry -> Bool)
-> Eq ScheduleListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleListEntry -> ScheduleListEntry -> Bool
== :: ScheduleListEntry -> ScheduleListEntry -> Bool
$c/= :: ScheduleListEntry -> ScheduleListEntry -> Bool
/= :: ScheduleListEntry -> ScheduleListEntry -> Bool
Eq, Eq ScheduleListEntry
Eq ScheduleListEntry =>
(ScheduleListEntry -> ScheduleListEntry -> Ordering)
-> (ScheduleListEntry -> ScheduleListEntry -> Bool)
-> (ScheduleListEntry -> ScheduleListEntry -> Bool)
-> (ScheduleListEntry -> ScheduleListEntry -> Bool)
-> (ScheduleListEntry -> ScheduleListEntry -> Bool)
-> (ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry)
-> (ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry)
-> Ord ScheduleListEntry
ScheduleListEntry -> ScheduleListEntry -> Bool
ScheduleListEntry -> ScheduleListEntry -> Ordering
ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry
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 :: ScheduleListEntry -> ScheduleListEntry -> Ordering
compare :: ScheduleListEntry -> ScheduleListEntry -> Ordering
$c< :: ScheduleListEntry -> ScheduleListEntry -> Bool
< :: ScheduleListEntry -> ScheduleListEntry -> Bool
$c<= :: ScheduleListEntry -> ScheduleListEntry -> Bool
<= :: ScheduleListEntry -> ScheduleListEntry -> Bool
$c> :: ScheduleListEntry -> ScheduleListEntry -> Bool
> :: ScheduleListEntry -> ScheduleListEntry -> Bool
$c>= :: ScheduleListEntry -> ScheduleListEntry -> Bool
>= :: ScheduleListEntry -> ScheduleListEntry -> Bool
$cmax :: ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry
max :: ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry
$cmin :: ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry
min :: ScheduleListEntry -> ScheduleListEntry -> ScheduleListEntry
Ord, (forall x. ScheduleListEntry -> Rep ScheduleListEntry x)
-> (forall x. Rep ScheduleListEntry x -> ScheduleListEntry)
-> Generic ScheduleListEntry
forall x. Rep ScheduleListEntry x -> ScheduleListEntry
forall x. ScheduleListEntry -> Rep ScheduleListEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleListEntry -> Rep ScheduleListEntry x
from :: forall x. ScheduleListEntry -> Rep ScheduleListEntry x
$cto :: forall x. Rep ScheduleListEntry x -> ScheduleListEntry
to :: forall x. Rep ScheduleListEntry x -> ScheduleListEntry
Generic)


scheduleListInfoFromProto :: S.ScheduleListInfo -> ScheduleListInfo
scheduleListInfoFromProto :: ScheduleListInfo -> ScheduleListInfo
scheduleListInfoFromProto ScheduleListInfo
p =
  ScheduleListInfo
    { spec :: Maybe ScheduleSpec
spec = (ScheduleSpec -> ScheduleSpec)
-> Maybe ScheduleSpec -> Maybe ScheduleSpec
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScheduleSpec -> ScheduleSpec
scheduleSpecFromProto (ScheduleListInfo
p ScheduleListInfo
-> FoldLike
     (Maybe ScheduleSpec)
     ScheduleListInfo
     ScheduleListInfo
     (Maybe ScheduleSpec)
     (Maybe ScheduleSpec)
-> Maybe ScheduleSpec
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe ScheduleSpec)
  ScheduleListInfo
  ScheduleListInfo
  (Maybe ScheduleSpec)
  (Maybe ScheduleSpec)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'spec" a) =>
LensLike' f s a
S.maybe'spec)
    , workflowType :: WorkflowType
workflowType = Text -> WorkflowType
WorkflowType (ScheduleListInfo
p ScheduleListInfo
-> FoldLike Text ScheduleListInfo ScheduleListInfo Text Text
-> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike' (Constant Text) ScheduleListInfo WorkflowType
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowType" a) =>
LensLike' f s a
S.workflowType LensLike' (Constant Text) ScheduleListInfo WorkflowType
-> ((Text -> Constant Text Text)
    -> WorkflowType -> Constant Text WorkflowType)
-> FoldLike Text ScheduleListInfo ScheduleListInfo Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Constant Text Text)
-> WorkflowType -> Constant Text WorkflowType
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
C.name)
    , notes :: Text
notes = ScheduleListInfo
p ScheduleListInfo
-> FoldLike Text ScheduleListInfo ScheduleListInfo Text Text
-> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ScheduleListInfo ScheduleListInfo Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "notes" a) =>
LensLike' f s a
S.notes
    , paused :: Bool
paused = ScheduleListInfo
p ScheduleListInfo
-> FoldLike Bool ScheduleListInfo ScheduleListInfo Bool Bool
-> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Bool ScheduleListInfo ScheduleListInfo Bool Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "paused" a) =>
LensLike' f s a
S.paused
    , recentActions :: [ScheduleActionResult]
recentActions = (ScheduleActionResult -> ScheduleActionResult)
-> [ScheduleActionResult] -> [ScheduleActionResult]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScheduleActionResult -> ScheduleActionResult
scheduleActionResultFromProto (ScheduleListInfo
p ScheduleListInfo
-> FoldLike
     [ScheduleActionResult]
     ScheduleListInfo
     ScheduleListInfo
     [ScheduleActionResult]
     [ScheduleActionResult]
-> [ScheduleActionResult]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [ScheduleActionResult]
  ScheduleListInfo
  ScheduleListInfo
  [ScheduleActionResult]
  [ScheduleActionResult]
forall (f :: * -> *) s a.
(Functor f, HasField s "recentActions" a) =>
LensLike' f s a
S.recentActions)
    , futureActionTimes :: [SystemTime]
futureActionTimes = (Timestamp -> SystemTime) -> [Timestamp] -> [SystemTime]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleListInfo
p ScheduleListInfo
-> FoldLike
     [Timestamp]
     ScheduleListInfo
     ScheduleListInfo
     [Timestamp]
     [Timestamp]
-> [Timestamp]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Timestamp]
  ScheduleListInfo
  ScheduleListInfo
  [Timestamp]
  [Timestamp]
forall (f :: * -> *) s a.
(Functor f, HasField s "futureActionTimes" a) =>
LensLike' f s a
S.futureActionTimes)
    }


scheduleListEntryFromProto :: S.ScheduleListEntry -> IO ScheduleListEntry
scheduleListEntryFromProto :: ScheduleListEntry -> IO ScheduleListEntry
scheduleListEntryFromProto ScheduleListEntry
p = do
  let searchAttrs :: Map Text C.Payload
      searchAttrs :: Map Text Payload
searchAttrs = ScheduleListEntry
p ScheduleListEntry
-> FoldLike
     (Map Text Payload)
     ScheduleListEntry
     ScheduleListEntry
     (Map Text Payload)
     (Map Text Payload)
-> Map Text Payload
forall s a t b. s -> FoldLike a s t a b -> a
^. LensLike'
  (Constant (Map Text Payload)) ScheduleListEntry SearchAttributes
forall (f :: * -> *) s a.
(Functor f, HasField s "searchAttributes" a) =>
LensLike' f s a
S.searchAttributes LensLike'
  (Constant (Map Text Payload)) ScheduleListEntry SearchAttributes
-> ((Map Text Payload
     -> Constant (Map Text Payload) (Map Text Payload))
    -> SearchAttributes
    -> Constant (Map Text Payload) SearchAttributes)
-> FoldLike
     (Map Text Payload)
     ScheduleListEntry
     ScheduleListEntry
     (Map Text Payload)
     (Map Text Payload)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text Payload
 -> Constant (Map Text Payload) (Map Text Payload))
-> SearchAttributes -> Constant (Map Text Payload) SearchAttributes
forall (f :: * -> *) s a.
(Functor f, HasField s "indexedFields" a) =>
LensLike' f s a
C.indexedFields
  searchAttributes <- IO (Either ValueError (Map SearchAttributeKey SearchAttributeType))
-> IO (Map SearchAttributeKey SearchAttributeType)
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO
   (Either ValueError (Map SearchAttributeKey SearchAttributeType))
 -> IO (Map SearchAttributeKey SearchAttributeType))
-> IO
     (Either ValueError (Map SearchAttributeKey SearchAttributeType))
-> IO (Map SearchAttributeKey SearchAttributeType)
forall a b. (a -> b) -> a -> b
$ do
    res <- Map Text Payload
-> IO (Either String (Map SearchAttributeKey SearchAttributeType))
searchAttributesFromProto Map Text Payload
searchAttrs
    pure $ first ValueError res

  pure $
    ScheduleListEntry
      { info = fmap scheduleListInfoFromProto (p ^. S.maybe'info)
      , scheduleId = ScheduleId (p ^. S.scheduleId)
      , memo = convertFromProtoMemo (p ^. S.memo)
      , ..
      }


-- | List all schedules in a namespace.
listSchedules
  :: MonadIO m
  => ScheduleClient
  -> ListSchedulesOptions
  -> ConduitT () (Vector ScheduleListEntry) m ()
listSchedules :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient
-> ListSchedulesOptions
-> ConduitT () (Vector ScheduleListEntry) m ()
listSchedules ScheduleClient
c ListSchedulesOptions
opts = ByteString -> ConduitT () (Vector ScheduleListEntry) m ()
go ByteString
""
  where
    go :: ByteString -> ConduitT () (Vector ScheduleListEntry) m ()
go ByteString
tok = do
      resp <-
        IO ListSchedulesResponse
-> ConduitT () (Vector ScheduleListEntry) m ListSchedulesResponse
forall a. IO a -> ConduitT () (Vector ScheduleListEntry) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListSchedulesResponse
 -> ConduitT () (Vector ScheduleListEntry) m ListSchedulesResponse)
-> IO ListSchedulesResponse
-> ConduitT () (Vector ScheduleListEntry) m ListSchedulesResponse
forall a b. (a -> b) -> a -> b
$
          IO (Either RpcError ListSchedulesResponse)
-> IO ListSchedulesResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError ListSchedulesResponse)
 -> IO ListSchedulesResponse)
-> IO (Either RpcError ListSchedulesResponse)
-> IO ListSchedulesResponse
forall a b. (a -> b) -> a -> b
$
            Client
-> ListSchedulesRequest
-> IO (Either RpcError ListSchedulesResponse)
Core.listSchedules
              ScheduleClient
c.scheduleClient
              ( ListSchedulesRequest
forall msg. Message msg => msg
defMessage
                  ListSchedulesRequest
-> (ListSchedulesRequest -> ListSchedulesRequest)
-> ListSchedulesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListSchedulesRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ListSchedulesRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListSchedulesRequest Text)
-> Text -> ListSchedulesRequest -> ListSchedulesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
                  ListSchedulesRequest
-> (ListSchedulesRequest -> ListSchedulesRequest)
-> ListSchedulesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListSchedulesRequest Int32
forall {f :: * -> *}.
Identical f =>
LensLike' f ListSchedulesRequest Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "maximumPageSize" a) =>
LensLike' f s a
WF.maximumPageSize (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListSchedulesRequest Int32)
-> Int32 -> ListSchedulesRequest -> ListSchedulesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ListSchedulesOptions
opts.maximumPageSize
                  ListSchedulesRequest
-> (ListSchedulesRequest -> ListSchedulesRequest)
-> ListSchedulesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListSchedulesRequest ByteString
forall {f :: * -> *}.
Identical f =>
LensLike' f ListSchedulesRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "nextPageToken" a) =>
LensLike' f s a
WF.nextPageToken (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListSchedulesRequest ByteString)
-> ByteString -> ListSchedulesRequest -> ListSchedulesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ByteString
tok
              )
      unless (V.null (resp ^. WF.vec'schedules)) $ do
        liftIO (traverse scheduleListEntryFromProto (resp ^. WF.vec'schedules)) >>= yield
      if resp ^. WF.nextPageToken == "" || V.null (resp ^. WF.vec'schedules)
        then pure ()
        else go (resp ^. WF.nextPageToken)


data ListScheduleMatchingTimesOptions = ListScheduleMatchingTimesOptions
  { ListScheduleMatchingTimesOptions -> ScheduleId
scheduleId :: !ScheduleId
  , ListScheduleMatchingTimesOptions -> SystemTime
startTime :: !SystemTime
  , ListScheduleMatchingTimesOptions -> SystemTime
endTime :: !SystemTime
  }
  deriving stock (Int -> ListScheduleMatchingTimesOptions -> ShowS
[ListScheduleMatchingTimesOptions] -> ShowS
ListScheduleMatchingTimesOptions -> String
(Int -> ListScheduleMatchingTimesOptions -> ShowS)
-> (ListScheduleMatchingTimesOptions -> String)
-> ([ListScheduleMatchingTimesOptions] -> ShowS)
-> Show ListScheduleMatchingTimesOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListScheduleMatchingTimesOptions -> ShowS
showsPrec :: Int -> ListScheduleMatchingTimesOptions -> ShowS
$cshow :: ListScheduleMatchingTimesOptions -> String
show :: ListScheduleMatchingTimesOptions -> String
$cshowList :: [ListScheduleMatchingTimesOptions] -> ShowS
showList :: [ListScheduleMatchingTimesOptions] -> ShowS
Show, ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
(ListScheduleMatchingTimesOptions
 -> ListScheduleMatchingTimesOptions -> Bool)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions -> Bool)
-> Eq ListScheduleMatchingTimesOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
== :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
$c/= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
/= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
Eq, Eq ListScheduleMatchingTimesOptions
Eq ListScheduleMatchingTimesOptions =>
(ListScheduleMatchingTimesOptions
 -> ListScheduleMatchingTimesOptions -> Ordering)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions -> Bool)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions -> Bool)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions -> Bool)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions -> Bool)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions)
-> (ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions
    -> ListScheduleMatchingTimesOptions)
-> Ord ListScheduleMatchingTimesOptions
ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Ordering
ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
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 :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Ordering
compare :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Ordering
$c< :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
< :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
$c<= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
<= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
$c> :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
> :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
$c>= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
>= :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions -> Bool
$cmax :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
max :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
$cmin :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
min :: ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
-> ListScheduleMatchingTimesOptions
Ord, (forall x.
 ListScheduleMatchingTimesOptions
 -> Rep ListScheduleMatchingTimesOptions x)
-> (forall x.
    Rep ListScheduleMatchingTimesOptions x
    -> ListScheduleMatchingTimesOptions)
-> Generic ListScheduleMatchingTimesOptions
forall x.
Rep ListScheduleMatchingTimesOptions x
-> ListScheduleMatchingTimesOptions
forall x.
ListScheduleMatchingTimesOptions
-> Rep ListScheduleMatchingTimesOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ListScheduleMatchingTimesOptions
-> Rep ListScheduleMatchingTimesOptions x
from :: forall x.
ListScheduleMatchingTimesOptions
-> Rep ListScheduleMatchingTimesOptions x
$cto :: forall x.
Rep ListScheduleMatchingTimesOptions x
-> ListScheduleMatchingTimesOptions
to :: forall x.
Rep ListScheduleMatchingTimesOptions x
-> ListScheduleMatchingTimesOptions
Generic)


-- | Lists matching times within a range.
listScheduleMatchingTimes
  :: MonadIO m
  => ScheduleClient
  -> ListScheduleMatchingTimesOptions
  -> m (Vector SystemTime)
listScheduleMatchingTimes :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient
-> ListScheduleMatchingTimesOptions -> m (Vector SystemTime)
listScheduleMatchingTimes ScheduleClient
c ListScheduleMatchingTimesOptions
opts = do
  resp <-
    IO ListScheduleMatchingTimesResponse
-> m ListScheduleMatchingTimesResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListScheduleMatchingTimesResponse
 -> m ListScheduleMatchingTimesResponse)
-> IO ListScheduleMatchingTimesResponse
-> m ListScheduleMatchingTimesResponse
forall a b. (a -> b) -> a -> b
$
      IO (Either RpcError ListScheduleMatchingTimesResponse)
-> IO ListScheduleMatchingTimesResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError ListScheduleMatchingTimesResponse)
 -> IO ListScheduleMatchingTimesResponse)
-> IO (Either RpcError ListScheduleMatchingTimesResponse)
-> IO ListScheduleMatchingTimesResponse
forall a b. (a -> b) -> a -> b
$
        Client
-> ListScheduleMatchingTimesRequest
-> IO (Either RpcError ListScheduleMatchingTimesResponse)
Core.listScheduleMatchingTimes
          ScheduleClient
c.scheduleClient
          ( ListScheduleMatchingTimesRequest
forall msg. Message msg => msg
defMessage
              ListScheduleMatchingTimesRequest
-> (ListScheduleMatchingTimesRequest
    -> ListScheduleMatchingTimesRequest)
-> ListScheduleMatchingTimesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListScheduleMatchingTimesRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ListScheduleMatchingTimesRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListScheduleMatchingTimesRequest Text)
-> Text
-> ListScheduleMatchingTimesRequest
-> ListScheduleMatchingTimesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
              ListScheduleMatchingTimesRequest
-> (ListScheduleMatchingTimesRequest
    -> ListScheduleMatchingTimesRequest)
-> ListScheduleMatchingTimesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListScheduleMatchingTimesRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ListScheduleMatchingTimesRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleId" a) =>
LensLike' f s a
WF.scheduleId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListScheduleMatchingTimesRequest Text)
-> Text
-> ListScheduleMatchingTimesRequest
-> ListScheduleMatchingTimesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleId -> Text
rawScheduleId ListScheduleMatchingTimesOptions
opts.scheduleId
              ListScheduleMatchingTimesRequest
-> (ListScheduleMatchingTimesRequest
    -> ListScheduleMatchingTimesRequest)
-> ListScheduleMatchingTimesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListScheduleMatchingTimesRequest Timestamp
forall {f :: * -> *}.
Identical f =>
LensLike' f ListScheduleMatchingTimesRequest Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "startTime" a) =>
LensLike' f s a
WF.startTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListScheduleMatchingTimesRequest Timestamp)
-> Timestamp
-> ListScheduleMatchingTimesRequest
-> ListScheduleMatchingTimesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Timestamp
timespecToTimestamp ListScheduleMatchingTimesOptions
opts.startTime
              ListScheduleMatchingTimesRequest
-> (ListScheduleMatchingTimesRequest
    -> ListScheduleMatchingTimesRequest)
-> ListScheduleMatchingTimesRequest
forall s t. s -> (s -> t) -> t
& LensLike' f ListScheduleMatchingTimesRequest Timestamp
forall {f :: * -> *}.
Identical f =>
LensLike' f ListScheduleMatchingTimesRequest Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "endTime" a) =>
LensLike' f s a
WF.endTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ListScheduleMatchingTimesRequest Timestamp)
-> Timestamp
-> ListScheduleMatchingTimesRequest
-> ListScheduleMatchingTimesRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Timestamp
timespecToTimestamp ListScheduleMatchingTimesOptions
opts.endTime
          )
  pure $ fmap timespecFromTimestamp (resp ^. WF.vec'startTime)


data ScheduleActionResult = ScheduleActionResult
  { ScheduleActionResult -> SystemTime
scheduleTime :: !SystemTime
  , ScheduleActionResult -> SystemTime
actualTime :: !SystemTime
  , ScheduleActionResult -> WorkflowExecution
startWorkflowResult :: !WorkflowExecution
  }
  deriving stock (Int -> ScheduleActionResult -> ShowS
[ScheduleActionResult] -> ShowS
ScheduleActionResult -> String
(Int -> ScheduleActionResult -> ShowS)
-> (ScheduleActionResult -> String)
-> ([ScheduleActionResult] -> ShowS)
-> Show ScheduleActionResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleActionResult -> ShowS
showsPrec :: Int -> ScheduleActionResult -> ShowS
$cshow :: ScheduleActionResult -> String
show :: ScheduleActionResult -> String
$cshowList :: [ScheduleActionResult] -> ShowS
showList :: [ScheduleActionResult] -> ShowS
Show, ScheduleActionResult -> ScheduleActionResult -> Bool
(ScheduleActionResult -> ScheduleActionResult -> Bool)
-> (ScheduleActionResult -> ScheduleActionResult -> Bool)
-> Eq ScheduleActionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleActionResult -> ScheduleActionResult -> Bool
== :: ScheduleActionResult -> ScheduleActionResult -> Bool
$c/= :: ScheduleActionResult -> ScheduleActionResult -> Bool
/= :: ScheduleActionResult -> ScheduleActionResult -> Bool
Eq, Eq ScheduleActionResult
Eq ScheduleActionResult =>
(ScheduleActionResult -> ScheduleActionResult -> Ordering)
-> (ScheduleActionResult -> ScheduleActionResult -> Bool)
-> (ScheduleActionResult -> ScheduleActionResult -> Bool)
-> (ScheduleActionResult -> ScheduleActionResult -> Bool)
-> (ScheduleActionResult -> ScheduleActionResult -> Bool)
-> (ScheduleActionResult
    -> ScheduleActionResult -> ScheduleActionResult)
-> (ScheduleActionResult
    -> ScheduleActionResult -> ScheduleActionResult)
-> Ord ScheduleActionResult
ScheduleActionResult -> ScheduleActionResult -> Bool
ScheduleActionResult -> ScheduleActionResult -> Ordering
ScheduleActionResult
-> ScheduleActionResult -> ScheduleActionResult
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 :: ScheduleActionResult -> ScheduleActionResult -> Ordering
compare :: ScheduleActionResult -> ScheduleActionResult -> Ordering
$c< :: ScheduleActionResult -> ScheduleActionResult -> Bool
< :: ScheduleActionResult -> ScheduleActionResult -> Bool
$c<= :: ScheduleActionResult -> ScheduleActionResult -> Bool
<= :: ScheduleActionResult -> ScheduleActionResult -> Bool
$c> :: ScheduleActionResult -> ScheduleActionResult -> Bool
> :: ScheduleActionResult -> ScheduleActionResult -> Bool
$c>= :: ScheduleActionResult -> ScheduleActionResult -> Bool
>= :: ScheduleActionResult -> ScheduleActionResult -> Bool
$cmax :: ScheduleActionResult
-> ScheduleActionResult -> ScheduleActionResult
max :: ScheduleActionResult
-> ScheduleActionResult -> ScheduleActionResult
$cmin :: ScheduleActionResult
-> ScheduleActionResult -> ScheduleActionResult
min :: ScheduleActionResult
-> ScheduleActionResult -> ScheduleActionResult
Ord, (forall x. ScheduleActionResult -> Rep ScheduleActionResult x)
-> (forall x. Rep ScheduleActionResult x -> ScheduleActionResult)
-> Generic ScheduleActionResult
forall x. Rep ScheduleActionResult x -> ScheduleActionResult
forall x. ScheduleActionResult -> Rep ScheduleActionResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleActionResult -> Rep ScheduleActionResult x
from :: forall x. ScheduleActionResult -> Rep ScheduleActionResult x
$cto :: forall x. Rep ScheduleActionResult x -> ScheduleActionResult
to :: forall x. Rep ScheduleActionResult x -> ScheduleActionResult
Generic)


scheduleActionResultFromProto :: S.ScheduleActionResult -> ScheduleActionResult
scheduleActionResultFromProto :: ScheduleActionResult -> ScheduleActionResult
scheduleActionResultFromProto ScheduleActionResult
p =
  ScheduleActionResult
    { scheduleTime :: SystemTime
scheduleTime = Timestamp -> SystemTime
timespecFromTimestamp (ScheduleActionResult
p ScheduleActionResult
-> FoldLike
     Timestamp
     ScheduleActionResult
     ScheduleActionResult
     Timestamp
     Timestamp
-> Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  Timestamp
  ScheduleActionResult
  ScheduleActionResult
  Timestamp
  Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleTime" a) =>
LensLike' f s a
S.scheduleTime)
    , actualTime :: SystemTime
actualTime = Timestamp -> SystemTime
timespecFromTimestamp (ScheduleActionResult
p ScheduleActionResult
-> FoldLike
     Timestamp
     ScheduleActionResult
     ScheduleActionResult
     Timestamp
     Timestamp
-> Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  Timestamp
  ScheduleActionResult
  ScheduleActionResult
  Timestamp
  Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "actualTime" a) =>
LensLike' f s a
S.actualTime)
    , startWorkflowResult :: WorkflowExecution
startWorkflowResult = WorkflowExecution -> WorkflowExecution
workflowExecutionFromProto (ScheduleActionResult
p ScheduleActionResult
-> FoldLike
     WorkflowExecution
     ScheduleActionResult
     ScheduleActionResult
     WorkflowExecution
     WorkflowExecution
-> WorkflowExecution
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  WorkflowExecution
  ScheduleActionResult
  ScheduleActionResult
  WorkflowExecution
  WorkflowExecution
forall (f :: * -> *) s a.
(Functor f, HasField s "startWorkflowResult" a) =>
LensLike' f s a
S.startWorkflowResult)
    }


data ScheduleInfo = ScheduleInfo
  { ScheduleInfo -> Int64
actionCount :: !Int64
  -- ^ Number of actions taken so far.
  , ScheduleInfo -> Int64
missedCatchupWindow :: !Int64
  -- ^ Number of times a scheduled action was skipped due to missing the catchup window.
  , ScheduleInfo -> Int64
overlapSkipped :: !Int64
  -- ^ Number of skipped actions due to overlap.
  , ScheduleInfo -> [WorkflowExecution]
runningWorkflows :: [WorkflowExecution]
  -- ^ Currently-running workflows started by this schedule. (There might be
  -- more than one if the overlap policy allows overlaps.)
  -- Note that the run_ids in here are the original execution run ids as
  -- started by the schedule. If the workflows retried, did continue-as-new,
  -- or were reset, they might still be running but with a different run_id.
  , ScheduleInfo -> [ScheduleActionResult]
recentActions :: [ScheduleActionResult]
  -- ^ Most recent ten actual action times (including manual triggers).
  , ScheduleInfo -> [SystemTime]
futureActionTimes :: [SystemTime]
  -- ^ Next ten scheduled action times.
  , ScheduleInfo -> Maybe SystemTime
createTime :: !(Maybe SystemTime)
  -- ^ Timestamp of schedule creation.
  , ScheduleInfo -> Maybe SystemTime
updateTime :: !(Maybe SystemTime)
  -- ^ Timestamp of last update.
  , ScheduleInfo -> Text
invalidScheduleError :: !Text
  -- ^ deprecated
  }
  deriving stock (Int -> ScheduleInfo -> ShowS
[ScheduleInfo] -> ShowS
ScheduleInfo -> String
(Int -> ScheduleInfo -> ShowS)
-> (ScheduleInfo -> String)
-> ([ScheduleInfo] -> ShowS)
-> Show ScheduleInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleInfo -> ShowS
showsPrec :: Int -> ScheduleInfo -> ShowS
$cshow :: ScheduleInfo -> String
show :: ScheduleInfo -> String
$cshowList :: [ScheduleInfo] -> ShowS
showList :: [ScheduleInfo] -> ShowS
Show, ScheduleInfo -> ScheduleInfo -> Bool
(ScheduleInfo -> ScheduleInfo -> Bool)
-> (ScheduleInfo -> ScheduleInfo -> Bool) -> Eq ScheduleInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleInfo -> ScheduleInfo -> Bool
== :: ScheduleInfo -> ScheduleInfo -> Bool
$c/= :: ScheduleInfo -> ScheduleInfo -> Bool
/= :: ScheduleInfo -> ScheduleInfo -> Bool
Eq, (forall x. ScheduleInfo -> Rep ScheduleInfo x)
-> (forall x. Rep ScheduleInfo x -> ScheduleInfo)
-> Generic ScheduleInfo
forall x. Rep ScheduleInfo x -> ScheduleInfo
forall x. ScheduleInfo -> Rep ScheduleInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleInfo -> Rep ScheduleInfo x
from :: forall x. ScheduleInfo -> Rep ScheduleInfo x
$cto :: forall x. Rep ScheduleInfo x -> ScheduleInfo
to :: forall x. Rep ScheduleInfo x -> ScheduleInfo
Generic)


scheduleInfoFromProto :: S.ScheduleInfo -> ScheduleInfo
scheduleInfoFromProto :: ScheduleInfo -> ScheduleInfo
scheduleInfoFromProto ScheduleInfo
p =
  ScheduleInfo
    { actionCount :: Int64
actionCount = ScheduleInfo
p ScheduleInfo
-> FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "actionCount" a) =>
LensLike' f s a
S.actionCount
    , missedCatchupWindow :: Int64
missedCatchupWindow = ScheduleInfo
p ScheduleInfo
-> FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "missedCatchupWindow" a) =>
LensLike' f s a
S.missedCatchupWindow
    , overlapSkipped :: Int64
overlapSkipped = ScheduleInfo
p ScheduleInfo
-> FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int64 ScheduleInfo ScheduleInfo Int64 Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "overlapSkipped" a) =>
LensLike' f s a
S.overlapSkipped
    , runningWorkflows :: [WorkflowExecution]
runningWorkflows = (WorkflowExecution -> WorkflowExecution)
-> [WorkflowExecution] -> [WorkflowExecution]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WorkflowExecution -> WorkflowExecution
workflowExecutionFromProto (ScheduleInfo
p ScheduleInfo
-> FoldLike
     [WorkflowExecution]
     ScheduleInfo
     ScheduleInfo
     [WorkflowExecution]
     [WorkflowExecution]
-> [WorkflowExecution]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [WorkflowExecution]
  ScheduleInfo
  ScheduleInfo
  [WorkflowExecution]
  [WorkflowExecution]
forall (f :: * -> *) s a.
(Functor f, HasField s "runningWorkflows" a) =>
LensLike' f s a
S.runningWorkflows)
    , recentActions :: [ScheduleActionResult]
recentActions = (ScheduleActionResult -> ScheduleActionResult)
-> [ScheduleActionResult] -> [ScheduleActionResult]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScheduleActionResult -> ScheduleActionResult
scheduleActionResultFromProto (ScheduleInfo
p ScheduleInfo
-> FoldLike
     [ScheduleActionResult]
     ScheduleInfo
     ScheduleInfo
     [ScheduleActionResult]
     [ScheduleActionResult]
-> [ScheduleActionResult]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [ScheduleActionResult]
  ScheduleInfo
  ScheduleInfo
  [ScheduleActionResult]
  [ScheduleActionResult]
forall (f :: * -> *) s a.
(Functor f, HasField s "recentActions" a) =>
LensLike' f s a
S.recentActions)
    , futureActionTimes :: [SystemTime]
futureActionTimes = (Timestamp -> SystemTime) -> [Timestamp] -> [SystemTime]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleInfo
p ScheduleInfo
-> FoldLike
     [Timestamp] ScheduleInfo ScheduleInfo [Timestamp] [Timestamp]
-> [Timestamp]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Timestamp] ScheduleInfo ScheduleInfo [Timestamp] [Timestamp]
forall (f :: * -> *) s a.
(Functor f, HasField s "futureActionTimes" a) =>
LensLike' f s a
S.futureActionTimes)
    , createTime :: Maybe SystemTime
createTime = (Timestamp -> SystemTime) -> Maybe Timestamp -> Maybe SystemTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleInfo
p ScheduleInfo
-> FoldLike
     (Maybe Timestamp)
     ScheduleInfo
     ScheduleInfo
     (Maybe Timestamp)
     (Maybe Timestamp)
-> Maybe Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Timestamp)
  ScheduleInfo
  ScheduleInfo
  (Maybe Timestamp)
  (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'createTime" a) =>
LensLike' f s a
S.maybe'createTime)
    , updateTime :: Maybe SystemTime
updateTime = (Timestamp -> SystemTime) -> Maybe Timestamp -> Maybe SystemTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleInfo
p ScheduleInfo
-> FoldLike
     (Maybe Timestamp)
     ScheduleInfo
     ScheduleInfo
     (Maybe Timestamp)
     (Maybe Timestamp)
-> Maybe Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Timestamp)
  ScheduleInfo
  ScheduleInfo
  (Maybe Timestamp)
  (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'updateTime" a) =>
LensLike' f s a
S.maybe'updateTime)
    , invalidScheduleError :: Text
invalidScheduleError = ScheduleInfo
p ScheduleInfo
-> FoldLike Text ScheduleInfo ScheduleInfo Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ScheduleInfo ScheduleInfo Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "invalidScheduleError" a) =>
LensLike' f s a
S.invalidScheduleError
    }


data Schedule = Schedule
  { Schedule -> ScheduleSpec
spec :: !ScheduleSpec
  , Schedule -> ScheduleAction
action :: !ScheduleAction
  , Schedule -> SchedulePolicies
policies :: !SchedulePolicies
  , Schedule -> ScheduleState
state :: !ScheduleState
  }
  deriving stock (Int -> Schedule -> ShowS
[Schedule] -> ShowS
Schedule -> String
(Int -> Schedule -> ShowS)
-> (Schedule -> String) -> ([Schedule] -> ShowS) -> Show Schedule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Schedule -> ShowS
showsPrec :: Int -> Schedule -> ShowS
$cshow :: Schedule -> String
show :: Schedule -> String
$cshowList :: [Schedule] -> ShowS
showList :: [Schedule] -> ShowS
Show, Schedule -> Schedule -> Bool
(Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool) -> Eq Schedule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Schedule -> Schedule -> Bool
== :: Schedule -> Schedule -> Bool
$c/= :: Schedule -> Schedule -> Bool
/= :: Schedule -> Schedule -> Bool
Eq, Eq Schedule
Eq Schedule =>
(Schedule -> Schedule -> Ordering)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Bool)
-> (Schedule -> Schedule -> Schedule)
-> (Schedule -> Schedule -> Schedule)
-> Ord Schedule
Schedule -> Schedule -> Bool
Schedule -> Schedule -> Ordering
Schedule -> Schedule -> Schedule
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 :: Schedule -> Schedule -> Ordering
compare :: Schedule -> Schedule -> Ordering
$c< :: Schedule -> Schedule -> Bool
< :: Schedule -> Schedule -> Bool
$c<= :: Schedule -> Schedule -> Bool
<= :: Schedule -> Schedule -> Bool
$c> :: Schedule -> Schedule -> Bool
> :: Schedule -> Schedule -> Bool
$c>= :: Schedule -> Schedule -> Bool
>= :: Schedule -> Schedule -> Bool
$cmax :: Schedule -> Schedule -> Schedule
max :: Schedule -> Schedule -> Schedule
$cmin :: Schedule -> Schedule -> Schedule
min :: Schedule -> Schedule -> Schedule
Ord, (forall x. Schedule -> Rep Schedule x)
-> (forall x. Rep Schedule x -> Schedule) -> Generic Schedule
forall x. Rep Schedule x -> Schedule
forall x. Schedule -> Rep Schedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Schedule -> Rep Schedule x
from :: forall x. Schedule -> Rep Schedule x
$cto :: forall x. Rep Schedule x -> Schedule
to :: forall x. Rep Schedule x -> Schedule
Generic)


scheduleToProto :: Schedule -> S.Schedule
scheduleToProto :: Schedule -> Schedule
scheduleToProto Schedule
p =
  Schedule
forall msg. Message msg => msg
defMessage
    Schedule -> (Schedule -> Schedule) -> Schedule
forall s t. s -> (s -> t) -> t
& LensLike' f Schedule ScheduleSpec
forall {f :: * -> *}.
Identical f =>
LensLike' f Schedule ScheduleSpec
forall (f :: * -> *) s a.
(Functor f, HasField s "spec" a) =>
LensLike' f s a
S.spec (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Schedule ScheduleSpec)
-> ScheduleSpec -> Schedule -> Schedule
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleSpec -> ScheduleSpec
scheduleSpecToProto Schedule
p.spec
    Schedule -> (Schedule -> Schedule) -> Schedule
forall s t. s -> (s -> t) -> t
& LensLike' f Schedule ScheduleAction
forall {f :: * -> *}.
Identical f =>
LensLike' f Schedule ScheduleAction
forall (f :: * -> *) s a.
(Functor f, HasField s "action" a) =>
LensLike' f s a
S.action (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Schedule ScheduleAction)
-> ScheduleAction -> Schedule -> Schedule
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleAction -> ScheduleAction
scheduleActionToProto Schedule
p.action
    Schedule -> (Schedule -> Schedule) -> Schedule
forall s t. s -> (s -> t) -> t
& LensLike' f Schedule SchedulePolicies
forall {f :: * -> *}.
Identical f =>
LensLike' f Schedule SchedulePolicies
forall (f :: * -> *) s a.
(Functor f, HasField s "policies" a) =>
LensLike' f s a
S.policies (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Schedule SchedulePolicies)
-> SchedulePolicies -> Schedule -> Schedule
forall s t a b. Setter s t a b -> b -> s -> t
.~ SchedulePolicies -> SchedulePolicies
schedulePoliciesToProto Schedule
p.policies
    Schedule -> (Schedule -> Schedule) -> Schedule
forall s t. s -> (s -> t) -> t
& LensLike' f Schedule ScheduleState
forall {f :: * -> *}.
Identical f =>
LensLike' f Schedule ScheduleState
forall (f :: * -> *) s a.
(Functor f, HasField s "state" a) =>
LensLike' f s a
S.state (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Schedule ScheduleState)
-> ScheduleState -> Schedule -> Schedule
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleState -> ScheduleState
scheduleStateToProto Schedule
p.state


data SchedulePolicies = SchedulePolicies
  { SchedulePolicies -> OverlapPolicy
overlapPolicy :: !OverlapPolicy
  -- ^ Policy for overlaps.
  -- Note that this can be changed after a schedule has taken some actions,
  -- and some changes might produce unintuitive results. In general, the later
  -- policy overrides the earlier policy.
  , SchedulePolicies -> Maybe Duration
catchupWindow :: !(Maybe Duration)
  -- ^ Policy for catchups:
  -- If the Temporal server misses an action due to one or more components
  -- being down, and comes back up, the action will be run if the scheduled
  -- time is within this window from the current time.
  -- This value defaults to 60 seconds, and can't be less than 10 seconds.
  , SchedulePolicies -> Bool
pauseOnFailure :: !Bool
  -- ^ If true, and a workflow run fails or times out, turn on "paused".
  -- This applies after retry policies: the full chain of retries must fail to
  -- trigger a pause here.
  }
  deriving stock (Int -> SchedulePolicies -> ShowS
[SchedulePolicies] -> ShowS
SchedulePolicies -> String
(Int -> SchedulePolicies -> ShowS)
-> (SchedulePolicies -> String)
-> ([SchedulePolicies] -> ShowS)
-> Show SchedulePolicies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchedulePolicies -> ShowS
showsPrec :: Int -> SchedulePolicies -> ShowS
$cshow :: SchedulePolicies -> String
show :: SchedulePolicies -> String
$cshowList :: [SchedulePolicies] -> ShowS
showList :: [SchedulePolicies] -> ShowS
Show, SchedulePolicies -> SchedulePolicies -> Bool
(SchedulePolicies -> SchedulePolicies -> Bool)
-> (SchedulePolicies -> SchedulePolicies -> Bool)
-> Eq SchedulePolicies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchedulePolicies -> SchedulePolicies -> Bool
== :: SchedulePolicies -> SchedulePolicies -> Bool
$c/= :: SchedulePolicies -> SchedulePolicies -> Bool
/= :: SchedulePolicies -> SchedulePolicies -> Bool
Eq, Eq SchedulePolicies
Eq SchedulePolicies =>
(SchedulePolicies -> SchedulePolicies -> Ordering)
-> (SchedulePolicies -> SchedulePolicies -> Bool)
-> (SchedulePolicies -> SchedulePolicies -> Bool)
-> (SchedulePolicies -> SchedulePolicies -> Bool)
-> (SchedulePolicies -> SchedulePolicies -> Bool)
-> (SchedulePolicies -> SchedulePolicies -> SchedulePolicies)
-> (SchedulePolicies -> SchedulePolicies -> SchedulePolicies)
-> Ord SchedulePolicies
SchedulePolicies -> SchedulePolicies -> Bool
SchedulePolicies -> SchedulePolicies -> Ordering
SchedulePolicies -> SchedulePolicies -> SchedulePolicies
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 :: SchedulePolicies -> SchedulePolicies -> Ordering
compare :: SchedulePolicies -> SchedulePolicies -> Ordering
$c< :: SchedulePolicies -> SchedulePolicies -> Bool
< :: SchedulePolicies -> SchedulePolicies -> Bool
$c<= :: SchedulePolicies -> SchedulePolicies -> Bool
<= :: SchedulePolicies -> SchedulePolicies -> Bool
$c> :: SchedulePolicies -> SchedulePolicies -> Bool
> :: SchedulePolicies -> SchedulePolicies -> Bool
$c>= :: SchedulePolicies -> SchedulePolicies -> Bool
>= :: SchedulePolicies -> SchedulePolicies -> Bool
$cmax :: SchedulePolicies -> SchedulePolicies -> SchedulePolicies
max :: SchedulePolicies -> SchedulePolicies -> SchedulePolicies
$cmin :: SchedulePolicies -> SchedulePolicies -> SchedulePolicies
min :: SchedulePolicies -> SchedulePolicies -> SchedulePolicies
Ord, (forall x. SchedulePolicies -> Rep SchedulePolicies x)
-> (forall x. Rep SchedulePolicies x -> SchedulePolicies)
-> Generic SchedulePolicies
forall x. Rep SchedulePolicies x -> SchedulePolicies
forall x. SchedulePolicies -> Rep SchedulePolicies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchedulePolicies -> Rep SchedulePolicies x
from :: forall x. SchedulePolicies -> Rep SchedulePolicies x
$cto :: forall x. Rep SchedulePolicies x -> SchedulePolicies
to :: forall x. Rep SchedulePolicies x -> SchedulePolicies
Generic)


schedulePoliciesToProto :: SchedulePolicies -> S.SchedulePolicies
schedulePoliciesToProto :: SchedulePolicies -> SchedulePolicies
schedulePoliciesToProto SchedulePolicies
p =
  SchedulePolicies
forall msg. Message msg => msg
defMessage
    SchedulePolicies
-> (SchedulePolicies -> SchedulePolicies) -> SchedulePolicies
forall s t. s -> (s -> t) -> t
& LensLike' f SchedulePolicies ScheduleOverlapPolicy
forall {f :: * -> *}.
Identical f =>
LensLike' f SchedulePolicies ScheduleOverlapPolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "overlapPolicy" a) =>
LensLike' f s a
S.overlapPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePolicies ScheduleOverlapPolicy)
-> ScheduleOverlapPolicy -> SchedulePolicies -> SchedulePolicies
forall s t a b. Setter s t a b -> b -> s -> t
.~ OverlapPolicy -> ScheduleOverlapPolicy
overlapPolicyToProto SchedulePolicies
p.overlapPolicy
    SchedulePolicies
-> (SchedulePolicies -> SchedulePolicies) -> SchedulePolicies
forall s t. s -> (s -> t) -> t
& LensLike' f SchedulePolicies (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f SchedulePolicies (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'catchupWindow" a) =>
LensLike' f s a
S.maybe'catchupWindow (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePolicies (Maybe Duration))
-> Maybe Duration -> SchedulePolicies -> SchedulePolicies
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto SchedulePolicies
p.catchupWindow
    SchedulePolicies
-> (SchedulePolicies -> SchedulePolicies) -> SchedulePolicies
forall s t. s -> (s -> t) -> t
& LensLike' f SchedulePolicies Bool
forall {f :: * -> *}.
Identical f =>
LensLike' f SchedulePolicies Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "pauseOnFailure" a) =>
LensLike' f s a
S.pauseOnFailure (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePolicies Bool)
-> Bool -> SchedulePolicies -> SchedulePolicies
forall s t a b. Setter s t a b -> b -> s -> t
.~ SchedulePolicies
p.pauseOnFailure


schedulePoliciesFromProto :: S.SchedulePolicies -> SchedulePolicies
schedulePoliciesFromProto :: SchedulePolicies -> SchedulePolicies
schedulePoliciesFromProto SchedulePolicies
p =
  SchedulePolicies
    { overlapPolicy :: OverlapPolicy
overlapPolicy = ScheduleOverlapPolicy -> OverlapPolicy
overlapPolicyFromProto (SchedulePolicies
p SchedulePolicies
-> FoldLike
     ScheduleOverlapPolicy
     SchedulePolicies
     SchedulePolicies
     ScheduleOverlapPolicy
     ScheduleOverlapPolicy
-> ScheduleOverlapPolicy
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  ScheduleOverlapPolicy
  SchedulePolicies
  SchedulePolicies
  ScheduleOverlapPolicy
  ScheduleOverlapPolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "overlapPolicy" a) =>
LensLike' f s a
S.overlapPolicy)
    , catchupWindow :: Maybe Duration
catchupWindow = (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationFromProto (SchedulePolicies
p SchedulePolicies
-> FoldLike
     (Maybe Duration)
     SchedulePolicies
     SchedulePolicies
     (Maybe Duration)
     (Maybe Duration)
-> Maybe Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Duration)
  SchedulePolicies
  SchedulePolicies
  (Maybe Duration)
  (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'catchupWindow" a) =>
LensLike' f s a
S.maybe'catchupWindow)
    , pauseOnFailure :: Bool
pauseOnFailure = SchedulePolicies
p SchedulePolicies
-> FoldLike Bool SchedulePolicies SchedulePolicies Bool Bool
-> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Bool SchedulePolicies SchedulePolicies Bool Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "pauseOnFailure" a) =>
LensLike' f s a
S.pauseOnFailure
    }


data OverlapPolicy
  = Unspecified
  | -- | Skip (default) means don't start anything. When the
    -- workflow completes, the next scheduled event after that time will be considered.
    Skip
  | -- | BufferOne means start the workflow again soon as the
    -- current one completes, but only buffer one start in this way. If another start is
    -- supposed to happen when the workflow is running, and one is already buffered, then
    -- only the first one will be started after the running workflow finishes.
    BufferOne
  | -- | BufferAll means buffer up any number of starts to all
    -- happen sequentially, immediately after the running workflow completes.
    BufferAll
  | -- | CancelOther means that if there is another workflow
    -- running, cancel it, and start the new one after the old one completes cancellation.
    CancelOther
  | -- | TerminateOther means that if there is another workflow
    -- running, terminate it and start the new one immediately.
    TerminateOther
  | -- | AllowAll means start any number of concurrent workflows.
    -- Note that with this policy, last completion result and last failure will not be
    -- available since workflows are not sequential.
    AllowAll
  | OverlapPolicyUnrecognized
  deriving stock (Int -> OverlapPolicy -> ShowS
[OverlapPolicy] -> ShowS
OverlapPolicy -> String
(Int -> OverlapPolicy -> ShowS)
-> (OverlapPolicy -> String)
-> ([OverlapPolicy] -> ShowS)
-> Show OverlapPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OverlapPolicy -> ShowS
showsPrec :: Int -> OverlapPolicy -> ShowS
$cshow :: OverlapPolicy -> String
show :: OverlapPolicy -> String
$cshowList :: [OverlapPolicy] -> ShowS
showList :: [OverlapPolicy] -> ShowS
Show, OverlapPolicy -> OverlapPolicy -> Bool
(OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> Bool) -> Eq OverlapPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverlapPolicy -> OverlapPolicy -> Bool
== :: OverlapPolicy -> OverlapPolicy -> Bool
$c/= :: OverlapPolicy -> OverlapPolicy -> Bool
/= :: OverlapPolicy -> OverlapPolicy -> Bool
Eq, Eq OverlapPolicy
Eq OverlapPolicy =>
(OverlapPolicy -> OverlapPolicy -> Ordering)
-> (OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> Bool)
-> (OverlapPolicy -> OverlapPolicy -> OverlapPolicy)
-> (OverlapPolicy -> OverlapPolicy -> OverlapPolicy)
-> Ord OverlapPolicy
OverlapPolicy -> OverlapPolicy -> Bool
OverlapPolicy -> OverlapPolicy -> Ordering
OverlapPolicy -> OverlapPolicy -> OverlapPolicy
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 :: OverlapPolicy -> OverlapPolicy -> Ordering
compare :: OverlapPolicy -> OverlapPolicy -> Ordering
$c< :: OverlapPolicy -> OverlapPolicy -> Bool
< :: OverlapPolicy -> OverlapPolicy -> Bool
$c<= :: OverlapPolicy -> OverlapPolicy -> Bool
<= :: OverlapPolicy -> OverlapPolicy -> Bool
$c> :: OverlapPolicy -> OverlapPolicy -> Bool
> :: OverlapPolicy -> OverlapPolicy -> Bool
$c>= :: OverlapPolicy -> OverlapPolicy -> Bool
>= :: OverlapPolicy -> OverlapPolicy -> Bool
$cmax :: OverlapPolicy -> OverlapPolicy -> OverlapPolicy
max :: OverlapPolicy -> OverlapPolicy -> OverlapPolicy
$cmin :: OverlapPolicy -> OverlapPolicy -> OverlapPolicy
min :: OverlapPolicy -> OverlapPolicy -> OverlapPolicy
Ord, (forall x. OverlapPolicy -> Rep OverlapPolicy x)
-> (forall x. Rep OverlapPolicy x -> OverlapPolicy)
-> Generic OverlapPolicy
forall x. Rep OverlapPolicy x -> OverlapPolicy
forall x. OverlapPolicy -> Rep OverlapPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OverlapPolicy -> Rep OverlapPolicy x
from :: forall x. OverlapPolicy -> Rep OverlapPolicy x
$cto :: forall x. Rep OverlapPolicy x -> OverlapPolicy
to :: forall x. Rep OverlapPolicy x -> OverlapPolicy
Generic)


overlapPolicyToProto :: OverlapPolicy -> S.ScheduleOverlapPolicy
overlapPolicyToProto :: OverlapPolicy -> ScheduleOverlapPolicy
overlapPolicyToProto OverlapPolicy
p = case OverlapPolicy
p of
  OverlapPolicy
Unspecified -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_UNSPECIFIED
  OverlapPolicy
Skip -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_SKIP
  OverlapPolicy
BufferOne -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_BUFFER_ONE
  OverlapPolicy
BufferAll -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_BUFFER_ALL
  OverlapPolicy
CancelOther -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_CANCEL_OTHER
  OverlapPolicy
TerminateOther -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_TERMINATE_OTHER
  OverlapPolicy
AllowAll -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_ALLOW_ALL
  OverlapPolicy
OverlapPolicyUnrecognized -> ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_UNSPECIFIED


overlapPolicyFromProto :: S.ScheduleOverlapPolicy -> OverlapPolicy
overlapPolicyFromProto :: ScheduleOverlapPolicy -> OverlapPolicy
overlapPolicyFromProto ScheduleOverlapPolicy
p = case ScheduleOverlapPolicy
p of
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_UNSPECIFIED -> OverlapPolicy
Unspecified
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_SKIP -> OverlapPolicy
Skip
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_BUFFER_ONE -> OverlapPolicy
BufferOne
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_BUFFER_ALL -> OverlapPolicy
BufferAll
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_CANCEL_OTHER -> OverlapPolicy
CancelOther
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_TERMINATE_OTHER -> OverlapPolicy
TerminateOther
  ScheduleOverlapPolicy
S.SCHEDULE_OVERLAP_POLICY_ALLOW_ALL -> OverlapPolicy
AllowAll
  ScheduleOverlapPolicy
_ -> OverlapPolicy
OverlapPolicyUnrecognized


data ScheduleState = ScheduleState
  { ScheduleState -> Text
notes :: !Text
  -- ^ Informative human-readable message with contextual notes, e.g. the reason
  -- a schedule is paused. The system may overwrite this message on certain
  -- conditions, e.g. when pause-on-failure happens.
  , ScheduleState -> Bool
paused :: !Bool
  -- ^ If true, do not take any actions based on the schedule spec.
  , ScheduleState -> Bool
limitedActions :: !Bool
  -- ^ If limited_actions is true, decrement remaining_actions after each
  -- action, and do not take any more scheduled actions if remaining_actions
  -- is zero. Actions may still be taken by explicit request (i.e. trigger
  -- immediately or backfill). Skipped actions (due to overlap policy) do not
  -- count against remaining actions.
  , ScheduleState -> Int64
remainingActions :: !Int64
  }
  deriving stock (Int -> ScheduleState -> ShowS
[ScheduleState] -> ShowS
ScheduleState -> String
(Int -> ScheduleState -> ShowS)
-> (ScheduleState -> String)
-> ([ScheduleState] -> ShowS)
-> Show ScheduleState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleState -> ShowS
showsPrec :: Int -> ScheduleState -> ShowS
$cshow :: ScheduleState -> String
show :: ScheduleState -> String
$cshowList :: [ScheduleState] -> ShowS
showList :: [ScheduleState] -> ShowS
Show, ScheduleState -> ScheduleState -> Bool
(ScheduleState -> ScheduleState -> Bool)
-> (ScheduleState -> ScheduleState -> Bool) -> Eq ScheduleState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleState -> ScheduleState -> Bool
== :: ScheduleState -> ScheduleState -> Bool
$c/= :: ScheduleState -> ScheduleState -> Bool
/= :: ScheduleState -> ScheduleState -> Bool
Eq, Eq ScheduleState
Eq ScheduleState =>
(ScheduleState -> ScheduleState -> Ordering)
-> (ScheduleState -> ScheduleState -> Bool)
-> (ScheduleState -> ScheduleState -> Bool)
-> (ScheduleState -> ScheduleState -> Bool)
-> (ScheduleState -> ScheduleState -> Bool)
-> (ScheduleState -> ScheduleState -> ScheduleState)
-> (ScheduleState -> ScheduleState -> ScheduleState)
-> Ord ScheduleState
ScheduleState -> ScheduleState -> Bool
ScheduleState -> ScheduleState -> Ordering
ScheduleState -> ScheduleState -> ScheduleState
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 :: ScheduleState -> ScheduleState -> Ordering
compare :: ScheduleState -> ScheduleState -> Ordering
$c< :: ScheduleState -> ScheduleState -> Bool
< :: ScheduleState -> ScheduleState -> Bool
$c<= :: ScheduleState -> ScheduleState -> Bool
<= :: ScheduleState -> ScheduleState -> Bool
$c> :: ScheduleState -> ScheduleState -> Bool
> :: ScheduleState -> ScheduleState -> Bool
$c>= :: ScheduleState -> ScheduleState -> Bool
>= :: ScheduleState -> ScheduleState -> Bool
$cmax :: ScheduleState -> ScheduleState -> ScheduleState
max :: ScheduleState -> ScheduleState -> ScheduleState
$cmin :: ScheduleState -> ScheduleState -> ScheduleState
min :: ScheduleState -> ScheduleState -> ScheduleState
Ord, (forall x. ScheduleState -> Rep ScheduleState x)
-> (forall x. Rep ScheduleState x -> ScheduleState)
-> Generic ScheduleState
forall x. Rep ScheduleState x -> ScheduleState
forall x. ScheduleState -> Rep ScheduleState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleState -> Rep ScheduleState x
from :: forall x. ScheduleState -> Rep ScheduleState x
$cto :: forall x. Rep ScheduleState x -> ScheduleState
to :: forall x. Rep ScheduleState x -> ScheduleState
Generic)


scheduleStateToProto :: ScheduleState -> S.ScheduleState
scheduleStateToProto :: ScheduleState -> ScheduleState
scheduleStateToProto ScheduleState
p =
  ScheduleState
forall msg. Message msg => msg
defMessage
    ScheduleState -> (ScheduleState -> ScheduleState) -> ScheduleState
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleState Text
forall {f :: * -> *}. Identical f => LensLike' f ScheduleState Text
forall (f :: * -> *) s a.
(Functor f, HasField s "notes" a) =>
LensLike' f s a
S.notes (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleState Text)
-> Text -> ScheduleState -> ScheduleState
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleState
p.notes
    ScheduleState -> (ScheduleState -> ScheduleState) -> ScheduleState
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleState Bool
forall {f :: * -> *}. Identical f => LensLike' f ScheduleState Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "paused" a) =>
LensLike' f s a
S.paused (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleState Bool)
-> Bool -> ScheduleState -> ScheduleState
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleState
p.paused
    ScheduleState -> (ScheduleState -> ScheduleState) -> ScheduleState
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleState Bool
forall {f :: * -> *}. Identical f => LensLike' f ScheduleState Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "limitedActions" a) =>
LensLike' f s a
S.limitedActions (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleState Bool)
-> Bool -> ScheduleState -> ScheduleState
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleState
p.limitedActions
    ScheduleState -> (ScheduleState -> ScheduleState) -> ScheduleState
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleState Int64
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleState Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "remainingActions" a) =>
LensLike' f s a
S.remainingActions (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleState Int64)
-> Int64 -> ScheduleState -> ScheduleState
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleState
p.remainingActions


scheduleStateFromProto :: S.ScheduleState -> ScheduleState
scheduleStateFromProto :: ScheduleState -> ScheduleState
scheduleStateFromProto ScheduleState
p =
  ScheduleState
    { notes :: Text
notes = ScheduleState
p ScheduleState
-> FoldLike Text ScheduleState ScheduleState Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ScheduleState ScheduleState Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "notes" a) =>
LensLike' f s a
S.notes
    , paused :: Bool
paused = ScheduleState
p ScheduleState
-> FoldLike Bool ScheduleState ScheduleState Bool Bool -> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Bool ScheduleState ScheduleState Bool Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "paused" a) =>
LensLike' f s a
S.paused
    , limitedActions :: Bool
limitedActions = ScheduleState
p ScheduleState
-> FoldLike Bool ScheduleState ScheduleState Bool Bool -> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Bool ScheduleState ScheduleState Bool Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "limitedActions" a) =>
LensLike' f s a
S.limitedActions
    , remainingActions :: Int64
remainingActions = ScheduleState
p ScheduleState
-> FoldLike Int64 ScheduleState ScheduleState Int64 Int64 -> Int64
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int64 ScheduleState ScheduleState Int64 Int64
forall (f :: * -> *) s a.
(Functor f, HasField s "remainingActions" a) =>
LensLike' f s a
S.remainingActions
    }


data ScheduleAction
  = StartWorkflow W.NewWorkflowExecutionInfo
  | ScheduleActionUnrecognized
  deriving stock (ScheduleAction -> ScheduleAction -> Bool
(ScheduleAction -> ScheduleAction -> Bool)
-> (ScheduleAction -> ScheduleAction -> Bool) -> Eq ScheduleAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleAction -> ScheduleAction -> Bool
== :: ScheduleAction -> ScheduleAction -> Bool
$c/= :: ScheduleAction -> ScheduleAction -> Bool
/= :: ScheduleAction -> ScheduleAction -> Bool
Eq, Eq ScheduleAction
Eq ScheduleAction =>
(ScheduleAction -> ScheduleAction -> Ordering)
-> (ScheduleAction -> ScheduleAction -> Bool)
-> (ScheduleAction -> ScheduleAction -> Bool)
-> (ScheduleAction -> ScheduleAction -> Bool)
-> (ScheduleAction -> ScheduleAction -> Bool)
-> (ScheduleAction -> ScheduleAction -> ScheduleAction)
-> (ScheduleAction -> ScheduleAction -> ScheduleAction)
-> Ord ScheduleAction
ScheduleAction -> ScheduleAction -> Bool
ScheduleAction -> ScheduleAction -> Ordering
ScheduleAction -> ScheduleAction -> ScheduleAction
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 :: ScheduleAction -> ScheduleAction -> Ordering
compare :: ScheduleAction -> ScheduleAction -> Ordering
$c< :: ScheduleAction -> ScheduleAction -> Bool
< :: ScheduleAction -> ScheduleAction -> Bool
$c<= :: ScheduleAction -> ScheduleAction -> Bool
<= :: ScheduleAction -> ScheduleAction -> Bool
$c> :: ScheduleAction -> ScheduleAction -> Bool
> :: ScheduleAction -> ScheduleAction -> Bool
$c>= :: ScheduleAction -> ScheduleAction -> Bool
>= :: ScheduleAction -> ScheduleAction -> Bool
$cmax :: ScheduleAction -> ScheduleAction -> ScheduleAction
max :: ScheduleAction -> ScheduleAction -> ScheduleAction
$cmin :: ScheduleAction -> ScheduleAction -> ScheduleAction
min :: ScheduleAction -> ScheduleAction -> ScheduleAction
Ord, Int -> ScheduleAction -> ShowS
[ScheduleAction] -> ShowS
ScheduleAction -> String
(Int -> ScheduleAction -> ShowS)
-> (ScheduleAction -> String)
-> ([ScheduleAction] -> ShowS)
-> Show ScheduleAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleAction -> ShowS
showsPrec :: Int -> ScheduleAction -> ShowS
$cshow :: ScheduleAction -> String
show :: ScheduleAction -> String
$cshowList :: [ScheduleAction] -> ShowS
showList :: [ScheduleAction] -> ShowS
Show)


mkScheduleAction
  :: forall wf m
   . (MonadIO m, WorkflowRef wf)
  => wf
  -> WorkflowId
  -- ^ Unlike other uses of WorkflowId, this will be used as a prefix for the
  -- actual workflow id, which will be unique.
  -> StartWorkflowOptions
  -- ^ All fields of 'StartWorkflowOptions' are valid except for the workflow id reuse policy and cron string.
  --
  -- The workflow id will generally have a timestamp appended for uniqueness.
  -> (WorkflowArgs wf :->: m ScheduleAction)
mkScheduleAction :: forall wf (m :: * -> *).
(MonadIO m, WorkflowRef wf) =>
wf
-> WorkflowId
-> StartWorkflowOptions
-> WorkflowArgs wf :->: m ScheduleAction
mkScheduleAction (wf -> KnownWorkflow (WorkflowArgs wf) (WorkflowResult wf)
forall f.
WorkflowRef f =>
f -> KnownWorkflow (WorkflowArgs f) (WorkflowResult f)
workflowRef -> KnownWorkflow codec
codec Text
wfName) (WorkflowId Text
wfId) StartWorkflowOptions
opts = forall (args :: [*]) result codec.
(VarArgs args, AllArgs (Codec codec) args) =>
codec -> (Vector UnencodedPayload -> result) -> args :->: result
withArgs @(WorkflowArgs wf) @(m ScheduleAction) codec
codec ((Vector UnencodedPayload -> m ScheduleAction)
 -> WorkflowArgs wf :->: m ScheduleAction)
-> (Vector UnencodedPayload -> m ScheduleAction)
-> WorkflowArgs wf :->: m ScheduleAction
forall a b. (a -> b) -> a -> b
$ \Vector UnencodedPayload
inputs -> IO ScheduleAction -> m ScheduleAction
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ScheduleAction -> m ScheduleAction)
-> IO ScheduleAction -> m ScheduleAction
forall a b. (a -> b) -> a -> b
$ do
  searchAttrs <- Map SearchAttributeKey SearchAttributeType -> IO (Map Text Payload)
searchAttributesToProto StartWorkflowOptions
opts.searchAttributes
  inputs' <- sequence inputs
  let tq = TaskQueue -> Text
rawTaskQueue StartWorkflowOptions
opts.taskQueue
      executionInfo =
        NewWorkflowExecutionInfo
forall msg. Message msg => msg
defMessage
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo Text
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo Text
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowId" a) =>
LensLike' f s a
W.workflowId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo Text)
-> Text -> NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
wfId
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo WorkflowType
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo WorkflowType
forall (f :: * -> *) s a.
(Functor f, HasField s "workflowType" a) =>
LensLike' f s a
W.workflowType (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo WorkflowType)
-> WorkflowType
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (WorkflowType
forall msg. Message msg => msg
defMessage WorkflowType -> (WorkflowType -> WorkflowType) -> WorkflowType
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowType Text
forall {f :: * -> *}. Identical f => LensLike' f WorkflowType Text
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
C.name (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowType Text)
-> Text -> WorkflowType -> WorkflowType
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
wfName)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo TaskQueue
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo TaskQueue
forall (f :: * -> *) s a.
(Functor f, HasField s "taskQueue" a) =>
LensLike' f s a
W.taskQueue
            (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo TaskQueue)
-> TaskQueue
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( TaskQueue
forall msg. Message msg => msg
defMessage
                  TaskQueue -> (TaskQueue -> TaskQueue) -> TaskQueue
forall s t. s -> (s -> t) -> t
& LensLike' f TaskQueue Text
forall {f :: * -> *}. Identical f => LensLike' f TaskQueue Text
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
C.name (forall {f :: * -> *}. Identical f => LensLike' f TaskQueue Text)
-> Text -> TaskQueue -> TaskQueue
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
tq
                  TaskQueue -> (TaskQueue -> TaskQueue) -> TaskQueue
forall s t. s -> (s -> t) -> t
& LensLike' f TaskQueue TaskQueueKind
forall {f :: * -> *}.
Identical f =>
LensLike' f TaskQueue TaskQueueKind
forall (f :: * -> *) s a.
(Functor f, HasField s "kind" a) =>
LensLike' f s a
TQ.kind (forall {f :: * -> *}.
 Identical f =>
 LensLike' f TaskQueue TaskQueueKind)
-> TaskQueueKind -> TaskQueue -> TaskQueue
forall s t a b. Setter s t a b -> b -> s -> t
.~ TaskQueueKind
TASK_QUEUE_KIND_UNSPECIFIED
               )
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo Payloads
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo Payloads
forall (f :: * -> *) s a.
(Functor f, HasField s "input" a) =>
LensLike' f s a
W.input (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo Payloads)
-> Payloads -> NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payloads
forall msg. Message msg => msg
defMessage Payloads -> (Payloads -> Payloads) -> Payloads
forall s t. s -> (s -> t) -> t
& LensLike' f Payloads (Vector Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f Payloads (Vector Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "vec'payloads" a) =>
LensLike' f s a
C.vec'payloads (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Payloads (Vector Payload))
-> Vector Payload -> Payloads -> Payloads
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Vector Payload -> Vector Payload
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload Vector Payload
inputs')
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowExecutionTimeout" a) =>
LensLike' f s a
W.maybe'workflowExecutionTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo (Maybe Duration))
-> Maybe Duration
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartWorkflowOptions
opts.timeouts.executionTimeout)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowRunTimeout" a) =>
LensLike' f s a
W.maybe'workflowRunTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo (Maybe Duration))
-> Maybe Duration
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartWorkflowOptions
opts.timeouts.runTimeout)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'workflowTaskTimeout" a) =>
LensLike' f s a
W.maybe'workflowTaskTimeout (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo (Maybe Duration))
-> Maybe Duration
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration
durationToProto (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartWorkflowOptions
opts.timeouts.taskTimeout)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo (Maybe RetryPolicy)
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo (Maybe RetryPolicy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'retryPolicy" a) =>
LensLike' f s a
W.maybe'retryPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo (Maybe RetryPolicy))
-> Maybe RetryPolicy
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (RetryPolicy -> RetryPolicy
retryPolicyToProto (RetryPolicy -> RetryPolicy)
-> Maybe RetryPolicy -> Maybe RetryPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StartWorkflowOptions
opts.retryPolicy)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo Memo
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo Memo
forall (f :: * -> *) s a.
(Functor f, HasField s "memo" a) =>
LensLike' f s a
W.memo (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo Memo)
-> Memo -> NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload -> Memo
convertToProtoMemo StartWorkflowOptions
opts.memo
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo SearchAttributes
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo SearchAttributes
forall (f :: * -> *) s a.
(Functor f, HasField s "searchAttributes" a) =>
LensLike' f s a
W.searchAttributes (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo SearchAttributes)
-> SearchAttributes
-> NewWorkflowExecutionInfo
-> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (SearchAttributes
forall msg. Message msg => msg
defMessage SearchAttributes
-> (SearchAttributes -> SearchAttributes) -> SearchAttributes
forall s t. s -> (s -> t) -> t
& LensLike' f SearchAttributes (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f SearchAttributes (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "indexedFields" a) =>
LensLike' f s a
C.indexedFields (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SearchAttributes (Map Text Payload))
-> Map Text Payload -> SearchAttributes -> SearchAttributes
forall s t a b. Setter s t a b -> b -> s -> t
.~ Map Text Payload
searchAttrs)
          NewWorkflowExecutionInfo
-> (NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo)
-> NewWorkflowExecutionInfo
forall s t. s -> (s -> t) -> t
& LensLike' f NewWorkflowExecutionInfo Header
forall {f :: * -> *}.
Identical f =>
LensLike' f NewWorkflowExecutionInfo Header
forall (f :: * -> *) s a.
(Functor f, HasField s "header" a) =>
LensLike' f s a
W.header (forall {f :: * -> *}.
 Identical f =>
 LensLike' f NewWorkflowExecutionInfo Header)
-> Header -> NewWorkflowExecutionInfo -> NewWorkflowExecutionInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Header
forall msg. Message msg => msg
defMessage Header -> (Header -> Header) -> Header
forall s t. s -> (s -> t) -> t
& LensLike' f Header (Map Text Payload)
forall {f :: * -> *}.
Identical f =>
LensLike' f Header (Map Text Payload)
forall (f :: * -> *) s a.
(Functor f, HasField s "fields" a) =>
LensLike' f s a
C.fields (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Header (Map Text Payload))
-> Map Text Payload -> Header -> Header
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> Map Text Payload -> Map Text Payload
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload StartWorkflowOptions
opts.headers)
  pure $ StartWorkflow executionInfo


scheduleActionToProto :: ScheduleAction -> S.ScheduleAction
scheduleActionToProto :: ScheduleAction -> ScheduleAction
scheduleActionToProto ScheduleAction
a = case ScheduleAction
a of
  StartWorkflow NewWorkflowExecutionInfo
wf -> ScheduleAction
forall msg. Message msg => msg
defMessage ScheduleAction
-> (ScheduleAction -> ScheduleAction) -> ScheduleAction
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleAction (Maybe ScheduleAction'Action)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleAction (Maybe ScheduleAction'Action)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'action" a) =>
LensLike' f s a
S.maybe'action (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleAction (Maybe ScheduleAction'Action))
-> Maybe ScheduleAction'Action -> ScheduleAction -> ScheduleAction
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleAction'Action -> Maybe ScheduleAction'Action
forall a. a -> Maybe a
Just (NewWorkflowExecutionInfo -> ScheduleAction'Action
S.ScheduleAction'StartWorkflow NewWorkflowExecutionInfo
wf)
  ScheduleAction
ScheduleActionUnrecognized -> ScheduleAction
forall msg. Message msg => msg
defMessage


scheduleActionFromProto :: S.ScheduleAction -> ScheduleAction
scheduleActionFromProto :: ScheduleAction -> ScheduleAction
scheduleActionFromProto ScheduleAction
a = case ScheduleAction
a ScheduleAction
-> FoldLike
     (Maybe ScheduleAction'Action)
     ScheduleAction
     ScheduleAction
     (Maybe ScheduleAction'Action)
     (Maybe ScheduleAction'Action)
-> Maybe ScheduleAction'Action
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe ScheduleAction'Action)
  ScheduleAction
  ScheduleAction
  (Maybe ScheduleAction'Action)
  (Maybe ScheduleAction'Action)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'action" a) =>
LensLike' f s a
S.maybe'action of
  Maybe ScheduleAction'Action
Nothing -> ScheduleAction
ScheduleActionUnrecognized
  Just ScheduleAction'Action
a' -> case ScheduleAction'Action
a' of
    S.ScheduleAction'StartWorkflow NewWorkflowExecutionInfo
wf -> NewWorkflowExecutionInfo -> ScheduleAction
StartWorkflow NewWorkflowExecutionInfo
wf


scheduleFromProto :: S.Schedule -> Schedule
scheduleFromProto :: Schedule -> Schedule
scheduleFromProto Schedule
p =
  Schedule
    { spec :: ScheduleSpec
spec = ScheduleSpec -> ScheduleSpec
scheduleSpecFromProto (Schedule
p Schedule
-> FoldLike
     ScheduleSpec Schedule Schedule ScheduleSpec ScheduleSpec
-> ScheduleSpec
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike ScheduleSpec Schedule Schedule ScheduleSpec ScheduleSpec
forall (f :: * -> *) s a.
(Functor f, HasField s "spec" a) =>
LensLike' f s a
S.spec)
    , action :: ScheduleAction
action = ScheduleAction -> ScheduleAction
scheduleActionFromProto (Schedule
p Schedule
-> FoldLike
     ScheduleAction Schedule Schedule ScheduleAction ScheduleAction
-> ScheduleAction
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  ScheduleAction Schedule Schedule ScheduleAction ScheduleAction
forall (f :: * -> *) s a.
(Functor f, HasField s "action" a) =>
LensLike' f s a
S.action)
    , policies :: SchedulePolicies
policies = SchedulePolicies -> SchedulePolicies
schedulePoliciesFromProto (Schedule
p Schedule
-> FoldLike
     SchedulePolicies
     Schedule
     Schedule
     SchedulePolicies
     SchedulePolicies
-> SchedulePolicies
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  SchedulePolicies
  Schedule
  Schedule
  SchedulePolicies
  SchedulePolicies
forall (f :: * -> *) s a.
(Functor f, HasField s "policies" a) =>
LensLike' f s a
S.policies)
    , state :: ScheduleState
state = ScheduleState -> ScheduleState
scheduleStateFromProto (Schedule
p Schedule
-> FoldLike
     ScheduleState Schedule Schedule ScheduleState ScheduleState
-> ScheduleState
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  ScheduleState Schedule Schedule ScheduleState ScheduleState
forall (f :: * -> *) s a.
(Functor f, HasField s "state" a) =>
LensLike' f s a
S.state)
    }


data DescribeScheduleResponse = DescribeScheduleResponse
  { DescribeScheduleResponse -> Schedule
schedule :: !Schedule
  -- ^
  -- The complete current schedule details. This may not match the schedule as
  -- created because:
  -- - some types of schedule specs may get compiled into others (e.g. CronString into StructuredCalendarSpec)
  -- - some unspecified fields may be replaced by defaults
  -- - some fields in the state are modified automatically
  -- - the schedule may have been modified by UpdateSchedule or PatchSchedule
  , DescribeScheduleResponse -> ScheduleInfo
info :: !ScheduleInfo
  -- ^ Extra schedule state info.
  , DescribeScheduleResponse -> Map Text Payload
memo :: !(Map Text Payload)
  -- ^ The memo that the schedule was created with.
  , DescribeScheduleResponse
-> Map SearchAttributeKey SearchAttributeType
searchAttributes :: !(Map SearchAttributeKey SearchAttributeType)
  -- ^ The search attributes that the schedule was created with.
  , DescribeScheduleResponse -> ByteString
conflictToken :: !ByteString
  -- ^ This value can be passed back to UpdateSchedule to ensure that the
  -- schedule was not modified between a Describe and an Update, which could
  -- lead to lost updates and other confusion.
  }
  deriving stock (Int -> DescribeScheduleResponse -> ShowS
[DescribeScheduleResponse] -> ShowS
DescribeScheduleResponse -> String
(Int -> DescribeScheduleResponse -> ShowS)
-> (DescribeScheduleResponse -> String)
-> ([DescribeScheduleResponse] -> ShowS)
-> Show DescribeScheduleResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DescribeScheduleResponse -> ShowS
showsPrec :: Int -> DescribeScheduleResponse -> ShowS
$cshow :: DescribeScheduleResponse -> String
show :: DescribeScheduleResponse -> String
$cshowList :: [DescribeScheduleResponse] -> ShowS
showList :: [DescribeScheduleResponse] -> ShowS
Show, DescribeScheduleResponse -> DescribeScheduleResponse -> Bool
(DescribeScheduleResponse -> DescribeScheduleResponse -> Bool)
-> (DescribeScheduleResponse -> DescribeScheduleResponse -> Bool)
-> Eq DescribeScheduleResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DescribeScheduleResponse -> DescribeScheduleResponse -> Bool
== :: DescribeScheduleResponse -> DescribeScheduleResponse -> Bool
$c/= :: DescribeScheduleResponse -> DescribeScheduleResponse -> Bool
/= :: DescribeScheduleResponse -> DescribeScheduleResponse -> Bool
Eq, (forall x.
 DescribeScheduleResponse -> Rep DescribeScheduleResponse x)
-> (forall x.
    Rep DescribeScheduleResponse x -> DescribeScheduleResponse)
-> Generic DescribeScheduleResponse
forall x.
Rep DescribeScheduleResponse x -> DescribeScheduleResponse
forall x.
DescribeScheduleResponse -> Rep DescribeScheduleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DescribeScheduleResponse -> Rep DescribeScheduleResponse x
from :: forall x.
DescribeScheduleResponse -> Rep DescribeScheduleResponse x
$cto :: forall x.
Rep DescribeScheduleResponse x -> DescribeScheduleResponse
to :: forall x.
Rep DescribeScheduleResponse x -> DescribeScheduleResponse
Generic)


-- | Returns the schedule description and current state of an existing schedule.
describeSchedule
  :: MonadIO m
  => ScheduleClient
  -> ScheduleId
  -> m DescribeScheduleResponse
describeSchedule :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient -> ScheduleId -> m DescribeScheduleResponse
describeSchedule ScheduleClient
c (ScheduleId Text
s) = IO DescribeScheduleResponse -> m DescribeScheduleResponse
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DescribeScheduleResponse -> m DescribeScheduleResponse)
-> IO DescribeScheduleResponse -> m DescribeScheduleResponse
forall a b. (a -> b) -> a -> b
$ do
  res <-
    IO (Either RpcError DescribeScheduleResponse)
-> IO DescribeScheduleResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError DescribeScheduleResponse)
 -> IO DescribeScheduleResponse)
-> IO (Either RpcError DescribeScheduleResponse)
-> IO DescribeScheduleResponse
forall a b. (a -> b) -> a -> b
$
      Client
-> DescribeScheduleRequest
-> IO (Either RpcError DescribeScheduleResponse)
Core.describeSchedule
        ScheduleClient
c.scheduleClient
        ( DescribeScheduleRequest
forall msg. Message msg => msg
defMessage
            DescribeScheduleRequest
-> (DescribeScheduleRequest -> DescribeScheduleRequest)
-> DescribeScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f DescribeScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f DescribeScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f DescribeScheduleRequest Text)
-> Text -> DescribeScheduleRequest -> DescribeScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
            DescribeScheduleRequest
-> (DescribeScheduleRequest -> DescribeScheduleRequest)
-> DescribeScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f DescribeScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f DescribeScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleId" a) =>
LensLike' f s a
WF.scheduleId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f DescribeScheduleRequest Text)
-> Text -> DescribeScheduleRequest -> DescribeScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
s
        )
  searchAttributes <- throwEither $ do
    resp <- searchAttributesFromProto (res ^. S.searchAttributes . C.indexedFields)
    pure $ first ValueError resp
  pure $
    DescribeScheduleResponse
      { schedule = scheduleFromProto (res ^. WF.schedule)
      , info = scheduleInfoFromProto (res ^. S.info)
      , memo = convertFromProtoMemo (res ^. WF.memo)
      , searchAttributes = searchAttributes
      , conflictToken = res ^. WF.conflictToken
      }


data TriggerImmediatelyRequest = TriggerImmediatelyRequest
  { TriggerImmediatelyRequest -> OverlapPolicy
overlapPolicy :: !OverlapPolicy
  }
  deriving stock (Int -> TriggerImmediatelyRequest -> ShowS
[TriggerImmediatelyRequest] -> ShowS
TriggerImmediatelyRequest -> String
(Int -> TriggerImmediatelyRequest -> ShowS)
-> (TriggerImmediatelyRequest -> String)
-> ([TriggerImmediatelyRequest] -> ShowS)
-> Show TriggerImmediatelyRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TriggerImmediatelyRequest -> ShowS
showsPrec :: Int -> TriggerImmediatelyRequest -> ShowS
$cshow :: TriggerImmediatelyRequest -> String
show :: TriggerImmediatelyRequest -> String
$cshowList :: [TriggerImmediatelyRequest] -> ShowS
showList :: [TriggerImmediatelyRequest] -> ShowS
Show, TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
(TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> Eq TriggerImmediatelyRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
== :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
$c/= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
/= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
Eq, Eq TriggerImmediatelyRequest
Eq TriggerImmediatelyRequest =>
(TriggerImmediatelyRequest
 -> TriggerImmediatelyRequest -> Ordering)
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool)
-> (TriggerImmediatelyRequest
    -> TriggerImmediatelyRequest -> TriggerImmediatelyRequest)
-> (TriggerImmediatelyRequest
    -> TriggerImmediatelyRequest -> TriggerImmediatelyRequest)
-> Ord TriggerImmediatelyRequest
TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Ordering
TriggerImmediatelyRequest
-> TriggerImmediatelyRequest -> TriggerImmediatelyRequest
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 :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Ordering
compare :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Ordering
$c< :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
< :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
$c<= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
<= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
$c> :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
> :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
$c>= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
>= :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest -> Bool
$cmax :: TriggerImmediatelyRequest
-> TriggerImmediatelyRequest -> TriggerImmediatelyRequest
max :: TriggerImmediatelyRequest
-> TriggerImmediatelyRequest -> TriggerImmediatelyRequest
$cmin :: TriggerImmediatelyRequest
-> TriggerImmediatelyRequest -> TriggerImmediatelyRequest
min :: TriggerImmediatelyRequest
-> TriggerImmediatelyRequest -> TriggerImmediatelyRequest
Ord, (forall x.
 TriggerImmediatelyRequest -> Rep TriggerImmediatelyRequest x)
-> (forall x.
    Rep TriggerImmediatelyRequest x -> TriggerImmediatelyRequest)
-> Generic TriggerImmediatelyRequest
forall x.
Rep TriggerImmediatelyRequest x -> TriggerImmediatelyRequest
forall x.
TriggerImmediatelyRequest -> Rep TriggerImmediatelyRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TriggerImmediatelyRequest -> Rep TriggerImmediatelyRequest x
from :: forall x.
TriggerImmediatelyRequest -> Rep TriggerImmediatelyRequest x
$cto :: forall x.
Rep TriggerImmediatelyRequest x -> TriggerImmediatelyRequest
to :: forall x.
Rep TriggerImmediatelyRequest x -> TriggerImmediatelyRequest
Generic)


triggerImmediatelyRequestToProto :: TriggerImmediatelyRequest -> S.TriggerImmediatelyRequest
triggerImmediatelyRequestToProto :: TriggerImmediatelyRequest -> TriggerImmediatelyRequest
triggerImmediatelyRequestToProto TriggerImmediatelyRequest
p =
  TriggerImmediatelyRequest
forall msg. Message msg => msg
defMessage
    TriggerImmediatelyRequest
-> (TriggerImmediatelyRequest -> TriggerImmediatelyRequest)
-> TriggerImmediatelyRequest
forall s t. s -> (s -> t) -> t
& LensLike' f TriggerImmediatelyRequest ScheduleOverlapPolicy
forall {f :: * -> *}.
Identical f =>
LensLike' f TriggerImmediatelyRequest ScheduleOverlapPolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "overlapPolicy" a) =>
LensLike' f s a
S.overlapPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f TriggerImmediatelyRequest ScheduleOverlapPolicy)
-> ScheduleOverlapPolicy
-> TriggerImmediatelyRequest
-> TriggerImmediatelyRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ OverlapPolicy -> ScheduleOverlapPolicy
overlapPolicyToProto TriggerImmediatelyRequest
p.overlapPolicy


-- triggerImmediatelyRequestFromProto :: S.TriggerImmediatelyRequest -> TriggerImmediatelyRequest
-- triggerImmediatelyRequestFromProto p = TriggerImmediatelyRequest
--   { overlapPolicy = overlapPolicyFromProto (p ^. S.overlapPolicy)
--   }

data BackfillRequest = BackfillRequest
  { BackfillRequest -> SystemTime
startTime :: !SystemTime
  -- ^ Start of time range to evaluate schedule in.
  , BackfillRequest -> SystemTime
endTime :: !SystemTime
  -- ^ End of time range to evaluate schedule in.
  , BackfillRequest -> OverlapPolicy
overlapPolicy :: !OverlapPolicy
  -- ^ Override overlap policy for this request.
  }
  deriving stock (Int -> BackfillRequest -> ShowS
[BackfillRequest] -> ShowS
BackfillRequest -> String
(Int -> BackfillRequest -> ShowS)
-> (BackfillRequest -> String)
-> ([BackfillRequest] -> ShowS)
-> Show BackfillRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackfillRequest -> ShowS
showsPrec :: Int -> BackfillRequest -> ShowS
$cshow :: BackfillRequest -> String
show :: BackfillRequest -> String
$cshowList :: [BackfillRequest] -> ShowS
showList :: [BackfillRequest] -> ShowS
Show, BackfillRequest -> BackfillRequest -> Bool
(BackfillRequest -> BackfillRequest -> Bool)
-> (BackfillRequest -> BackfillRequest -> Bool)
-> Eq BackfillRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackfillRequest -> BackfillRequest -> Bool
== :: BackfillRequest -> BackfillRequest -> Bool
$c/= :: BackfillRequest -> BackfillRequest -> Bool
/= :: BackfillRequest -> BackfillRequest -> Bool
Eq, Eq BackfillRequest
Eq BackfillRequest =>
(BackfillRequest -> BackfillRequest -> Ordering)
-> (BackfillRequest -> BackfillRequest -> Bool)
-> (BackfillRequest -> BackfillRequest -> Bool)
-> (BackfillRequest -> BackfillRequest -> Bool)
-> (BackfillRequest -> BackfillRequest -> Bool)
-> (BackfillRequest -> BackfillRequest -> BackfillRequest)
-> (BackfillRequest -> BackfillRequest -> BackfillRequest)
-> Ord BackfillRequest
BackfillRequest -> BackfillRequest -> Bool
BackfillRequest -> BackfillRequest -> Ordering
BackfillRequest -> BackfillRequest -> BackfillRequest
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 :: BackfillRequest -> BackfillRequest -> Ordering
compare :: BackfillRequest -> BackfillRequest -> Ordering
$c< :: BackfillRequest -> BackfillRequest -> Bool
< :: BackfillRequest -> BackfillRequest -> Bool
$c<= :: BackfillRequest -> BackfillRequest -> Bool
<= :: BackfillRequest -> BackfillRequest -> Bool
$c> :: BackfillRequest -> BackfillRequest -> Bool
> :: BackfillRequest -> BackfillRequest -> Bool
$c>= :: BackfillRequest -> BackfillRequest -> Bool
>= :: BackfillRequest -> BackfillRequest -> Bool
$cmax :: BackfillRequest -> BackfillRequest -> BackfillRequest
max :: BackfillRequest -> BackfillRequest -> BackfillRequest
$cmin :: BackfillRequest -> BackfillRequest -> BackfillRequest
min :: BackfillRequest -> BackfillRequest -> BackfillRequest
Ord, (forall x. BackfillRequest -> Rep BackfillRequest x)
-> (forall x. Rep BackfillRequest x -> BackfillRequest)
-> Generic BackfillRequest
forall x. Rep BackfillRequest x -> BackfillRequest
forall x. BackfillRequest -> Rep BackfillRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackfillRequest -> Rep BackfillRequest x
from :: forall x. BackfillRequest -> Rep BackfillRequest x
$cto :: forall x. Rep BackfillRequest x -> BackfillRequest
to :: forall x. Rep BackfillRequest x -> BackfillRequest
Generic)


backfillRequestToProto :: BackfillRequest -> S.BackfillRequest
backfillRequestToProto :: BackfillRequest -> BackfillRequest
backfillRequestToProto BackfillRequest
p =
  BackfillRequest
forall msg. Message msg => msg
defMessage
    BackfillRequest
-> (BackfillRequest -> BackfillRequest) -> BackfillRequest
forall s t. s -> (s -> t) -> t
& LensLike' f BackfillRequest Timestamp
forall {f :: * -> *}.
Identical f =>
LensLike' f BackfillRequest Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "startTime" a) =>
LensLike' f s a
S.startTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f BackfillRequest Timestamp)
-> Timestamp -> BackfillRequest -> BackfillRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Timestamp
timespecToTimestamp BackfillRequest
p.startTime
    BackfillRequest
-> (BackfillRequest -> BackfillRequest) -> BackfillRequest
forall s t. s -> (s -> t) -> t
& LensLike' f BackfillRequest Timestamp
forall {f :: * -> *}.
Identical f =>
LensLike' f BackfillRequest Timestamp
forall (f :: * -> *) s a.
(Functor f, HasField s "endTime" a) =>
LensLike' f s a
S.endTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f BackfillRequest Timestamp)
-> Timestamp -> BackfillRequest -> BackfillRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SystemTime -> Timestamp
timespecToTimestamp BackfillRequest
p.endTime
    BackfillRequest
-> (BackfillRequest -> BackfillRequest) -> BackfillRequest
forall s t. s -> (s -> t) -> t
& LensLike' f BackfillRequest ScheduleOverlapPolicy
forall {f :: * -> *}.
Identical f =>
LensLike' f BackfillRequest ScheduleOverlapPolicy
forall (f :: * -> *) s a.
(Functor f, HasField s "overlapPolicy" a) =>
LensLike' f s a
S.overlapPolicy (forall {f :: * -> *}.
 Identical f =>
 LensLike' f BackfillRequest ScheduleOverlapPolicy)
-> ScheduleOverlapPolicy -> BackfillRequest -> BackfillRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ OverlapPolicy -> ScheduleOverlapPolicy
overlapPolicyToProto BackfillRequest
p.overlapPolicy


-- backfillRequestFromProto :: S.BackfillRequest -> BackfillRequest
-- backfillRequestFromProto p = BackfillRequest
--   { startTime = timespecFromTimestamp (p ^. S.startTime)
--   , endTime = timespecFromTimestamp (p ^. S.endTime)
--   , overlapPolicy = overlapPolicyFromProto (p ^. S.overlapPolicy)
--   }

data PauseState = Unpause !Text | Pause !Text
  deriving stock (Int -> PauseState -> ShowS
[PauseState] -> ShowS
PauseState -> String
(Int -> PauseState -> ShowS)
-> (PauseState -> String)
-> ([PauseState] -> ShowS)
-> Show PauseState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PauseState -> ShowS
showsPrec :: Int -> PauseState -> ShowS
$cshow :: PauseState -> String
show :: PauseState -> String
$cshowList :: [PauseState] -> ShowS
showList :: [PauseState] -> ShowS
Show, PauseState -> PauseState -> Bool
(PauseState -> PauseState -> Bool)
-> (PauseState -> PauseState -> Bool) -> Eq PauseState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PauseState -> PauseState -> Bool
== :: PauseState -> PauseState -> Bool
$c/= :: PauseState -> PauseState -> Bool
/= :: PauseState -> PauseState -> Bool
Eq, Eq PauseState
Eq PauseState =>
(PauseState -> PauseState -> Ordering)
-> (PauseState -> PauseState -> Bool)
-> (PauseState -> PauseState -> Bool)
-> (PauseState -> PauseState -> Bool)
-> (PauseState -> PauseState -> Bool)
-> (PauseState -> PauseState -> PauseState)
-> (PauseState -> PauseState -> PauseState)
-> Ord PauseState
PauseState -> PauseState -> Bool
PauseState -> PauseState -> Ordering
PauseState -> PauseState -> PauseState
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 :: PauseState -> PauseState -> Ordering
compare :: PauseState -> PauseState -> Ordering
$c< :: PauseState -> PauseState -> Bool
< :: PauseState -> PauseState -> Bool
$c<= :: PauseState -> PauseState -> Bool
<= :: PauseState -> PauseState -> Bool
$c> :: PauseState -> PauseState -> Bool
> :: PauseState -> PauseState -> Bool
$c>= :: PauseState -> PauseState -> Bool
>= :: PauseState -> PauseState -> Bool
$cmax :: PauseState -> PauseState -> PauseState
max :: PauseState -> PauseState -> PauseState
$cmin :: PauseState -> PauseState -> PauseState
min :: PauseState -> PauseState -> PauseState
Ord, (forall x. PauseState -> Rep PauseState x)
-> (forall x. Rep PauseState x -> PauseState) -> Generic PauseState
forall x. Rep PauseState x -> PauseState
forall x. PauseState -> Rep PauseState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PauseState -> Rep PauseState x
from :: forall x. PauseState -> Rep PauseState x
$cto :: forall x. Rep PauseState x -> PauseState
to :: forall x. Rep PauseState x -> PauseState
Generic)


data SchedulePatch = SchedulePatch
  { SchedulePatch -> Maybe TriggerImmediatelyRequest
triggerImmediately :: !(Maybe TriggerImmediatelyRequest)
  -- ^ If set, trigger one action immediately.
  , SchedulePatch -> [BackfillRequest]
backfillRequest :: ![BackfillRequest]
  -- ^ If set, runs though the specified time period(s) and takes actions as if that time
  -- passed by right now, all at once. The overlap policy can be overridden for the
  -- scope of the backfill.
  , SchedulePatch -> Maybe PauseState
pauseState :: !(Maybe PauseState)
  -- ^ If set, change the state and set the
  -- notes field to the value of the string.
  , SchedulePatch -> Text
requestId :: !Text
  }
  deriving stock (Int -> SchedulePatch -> ShowS
[SchedulePatch] -> ShowS
SchedulePatch -> String
(Int -> SchedulePatch -> ShowS)
-> (SchedulePatch -> String)
-> ([SchedulePatch] -> ShowS)
-> Show SchedulePatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchedulePatch -> ShowS
showsPrec :: Int -> SchedulePatch -> ShowS
$cshow :: SchedulePatch -> String
show :: SchedulePatch -> String
$cshowList :: [SchedulePatch] -> ShowS
showList :: [SchedulePatch] -> ShowS
Show, SchedulePatch -> SchedulePatch -> Bool
(SchedulePatch -> SchedulePatch -> Bool)
-> (SchedulePatch -> SchedulePatch -> Bool) -> Eq SchedulePatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchedulePatch -> SchedulePatch -> Bool
== :: SchedulePatch -> SchedulePatch -> Bool
$c/= :: SchedulePatch -> SchedulePatch -> Bool
/= :: SchedulePatch -> SchedulePatch -> Bool
Eq, Eq SchedulePatch
Eq SchedulePatch =>
(SchedulePatch -> SchedulePatch -> Ordering)
-> (SchedulePatch -> SchedulePatch -> Bool)
-> (SchedulePatch -> SchedulePatch -> Bool)
-> (SchedulePatch -> SchedulePatch -> Bool)
-> (SchedulePatch -> SchedulePatch -> Bool)
-> (SchedulePatch -> SchedulePatch -> SchedulePatch)
-> (SchedulePatch -> SchedulePatch -> SchedulePatch)
-> Ord SchedulePatch
SchedulePatch -> SchedulePatch -> Bool
SchedulePatch -> SchedulePatch -> Ordering
SchedulePatch -> SchedulePatch -> SchedulePatch
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 :: SchedulePatch -> SchedulePatch -> Ordering
compare :: SchedulePatch -> SchedulePatch -> Ordering
$c< :: SchedulePatch -> SchedulePatch -> Bool
< :: SchedulePatch -> SchedulePatch -> Bool
$c<= :: SchedulePatch -> SchedulePatch -> Bool
<= :: SchedulePatch -> SchedulePatch -> Bool
$c> :: SchedulePatch -> SchedulePatch -> Bool
> :: SchedulePatch -> SchedulePatch -> Bool
$c>= :: SchedulePatch -> SchedulePatch -> Bool
>= :: SchedulePatch -> SchedulePatch -> Bool
$cmax :: SchedulePatch -> SchedulePatch -> SchedulePatch
max :: SchedulePatch -> SchedulePatch -> SchedulePatch
$cmin :: SchedulePatch -> SchedulePatch -> SchedulePatch
min :: SchedulePatch -> SchedulePatch -> SchedulePatch
Ord, (forall x. SchedulePatch -> Rep SchedulePatch x)
-> (forall x. Rep SchedulePatch x -> SchedulePatch)
-> Generic SchedulePatch
forall x. Rep SchedulePatch x -> SchedulePatch
forall x. SchedulePatch -> Rep SchedulePatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchedulePatch -> Rep SchedulePatch x
from :: forall x. SchedulePatch -> Rep SchedulePatch x
$cto :: forall x. Rep SchedulePatch x -> SchedulePatch
to :: forall x. Rep SchedulePatch x -> SchedulePatch
Generic)


schedulePatchToProto :: SchedulePatch -> S.SchedulePatch
schedulePatchToProto :: SchedulePatch -> SchedulePatch
schedulePatchToProto SchedulePatch
p =
  SchedulePatch
forall msg. Message msg => msg
defMessage
    SchedulePatch -> (SchedulePatch -> SchedulePatch) -> SchedulePatch
forall s t. s -> (s -> t) -> t
& LensLike' f SchedulePatch (Maybe TriggerImmediatelyRequest)
forall {f :: * -> *}.
Identical f =>
LensLike' f SchedulePatch (Maybe TriggerImmediatelyRequest)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'triggerImmediately" a) =>
LensLike' f s a
S.maybe'triggerImmediately (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePatch (Maybe TriggerImmediatelyRequest))
-> Maybe TriggerImmediatelyRequest
-> SchedulePatch
-> SchedulePatch
forall s t a b. Setter s t a b -> b -> s -> t
.~ (TriggerImmediatelyRequest -> TriggerImmediatelyRequest)
-> Maybe TriggerImmediatelyRequest
-> Maybe TriggerImmediatelyRequest
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TriggerImmediatelyRequest -> TriggerImmediatelyRequest
triggerImmediatelyRequestToProto SchedulePatch
p.triggerImmediately
    SchedulePatch -> (SchedulePatch -> SchedulePatch) -> SchedulePatch
forall s t. s -> (s -> t) -> t
& LensLike' f SchedulePatch [BackfillRequest]
forall {f :: * -> *}.
Identical f =>
LensLike' f SchedulePatch [BackfillRequest]
forall (f :: * -> *) s a.
(Functor f, HasField s "backfillRequest" a) =>
LensLike' f s a
S.backfillRequest (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePatch [BackfillRequest])
-> [BackfillRequest] -> SchedulePatch -> SchedulePatch
forall s t a b. Setter s t a b -> b -> s -> t
.~ (BackfillRequest -> BackfillRequest)
-> [BackfillRequest] -> [BackfillRequest]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BackfillRequest -> BackfillRequest
backfillRequestToProto SchedulePatch
p.backfillRequest
    SchedulePatch -> (SchedulePatch -> SchedulePatch) -> SchedulePatch
forall s t. s -> (s -> t) -> t
& case SchedulePatch
p.pauseState of
      Maybe PauseState
Nothing -> SchedulePatch -> SchedulePatch
forall a. a -> a
id
      Just (Unpause Text
s) -> LensLike' f SchedulePatch Text
forall {f :: * -> *}. Identical f => LensLike' f SchedulePatch Text
forall (f :: * -> *) s a.
(Functor f, HasField s "unpause" a) =>
LensLike' f s a
S.unpause (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePatch Text)
-> Text -> SchedulePatch -> SchedulePatch
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
s
      Just (Pause Text
s) -> LensLike' f SchedulePatch Text
forall {f :: * -> *}. Identical f => LensLike' f SchedulePatch Text
forall (f :: * -> *) s a.
(Functor f, HasField s "pause" a) =>
LensLike' f s a
S.pause (forall {f :: * -> *}.
 Identical f =>
 LensLike' f SchedulePatch Text)
-> Text -> SchedulePatch -> SchedulePatch
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
s


-- | Makes a specific change to a schedule or triggers an immediate action.
patchSchedule
  :: MonadIO m
  => ScheduleClient
  -> ScheduleId
  -> SchedulePatch
  -> m ()
patchSchedule :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient -> ScheduleId -> SchedulePatch -> m ()
patchSchedule ScheduleClient
c (ScheduleId Text
s) SchedulePatch
p = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  _resp <-
    IO (Either RpcError PatchScheduleResponse)
-> IO PatchScheduleResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError PatchScheduleResponse)
 -> IO PatchScheduleResponse)
-> IO (Either RpcError PatchScheduleResponse)
-> IO PatchScheduleResponse
forall a b. (a -> b) -> a -> b
$
      Client
-> PatchScheduleRequest
-> IO (Either RpcError PatchScheduleResponse)
Core.patchSchedule
        ScheduleClient
c.scheduleClient
        ( PatchScheduleRequest
forall msg. Message msg => msg
defMessage
            PatchScheduleRequest
-> (PatchScheduleRequest -> PatchScheduleRequest)
-> PatchScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f PatchScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f PatchScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f PatchScheduleRequest Text)
-> Text -> PatchScheduleRequest -> PatchScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
            PatchScheduleRequest
-> (PatchScheduleRequest -> PatchScheduleRequest)
-> PatchScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f PatchScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f PatchScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleId" a) =>
LensLike' f s a
WF.scheduleId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f PatchScheduleRequest Text)
-> Text -> PatchScheduleRequest -> PatchScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
s
            PatchScheduleRequest
-> (PatchScheduleRequest -> PatchScheduleRequest)
-> PatchScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f PatchScheduleRequest SchedulePatch
forall {f :: * -> *}.
Identical f =>
LensLike' f PatchScheduleRequest SchedulePatch
forall (f :: * -> *) s a.
(Functor f, HasField s "patch" a) =>
LensLike' f s a
WF.patch (forall {f :: * -> *}.
 Identical f =>
 LensLike' f PatchScheduleRequest SchedulePatch)
-> SchedulePatch -> PatchScheduleRequest -> PatchScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SchedulePatch -> SchedulePatch
schedulePatchToProto SchedulePatch
p
            PatchScheduleRequest
-> (PatchScheduleRequest -> PatchScheduleRequest)
-> PatchScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f PatchScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f PatchScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "identity" a) =>
LensLike' f s a
WF.identity (forall {f :: * -> *}.
 Identical f =>
 LensLike' f PatchScheduleRequest Text)
-> Text -> PatchScheduleRequest -> PatchScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleClient
c.identity
            -- TODO
            PatchScheduleRequest
-> (PatchScheduleRequest -> PatchScheduleRequest)
-> PatchScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f PatchScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f PatchScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "requestId" a) =>
LensLike' f s a
WF.requestId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f PatchScheduleRequest Text)
-> Text -> PatchScheduleRequest -> PatchScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ SchedulePatch
p.requestId
        )
  pure ()


data UpdateScheduleRequest = UpdateScheduleRequest
  { UpdateScheduleRequest -> Schedule
schedule :: !Schedule
  -- ^ The new schedule. The four main fields of the schedule (spec, action,
  -- policies, state) are replaced completely by the values in this message.
  , UpdateScheduleRequest -> Maybe ByteString
conflictToken :: !(Maybe ByteString)
  -- ^ This can be the value of conflict_token from a DescribeScheduleResponse,
  -- which will cause this request to fail if the schedule has been modified
  -- between the Describe and this Update.
  -- If missing, the schedule will be updated unconditionally.
  , UpdateScheduleRequest -> Text
requestId :: !Text
  -- ^ A unique identifier for this update request for idempotence. Typically UUIDv4.
  }
  deriving stock (Int -> UpdateScheduleRequest -> ShowS
[UpdateScheduleRequest] -> ShowS
UpdateScheduleRequest -> String
(Int -> UpdateScheduleRequest -> ShowS)
-> (UpdateScheduleRequest -> String)
-> ([UpdateScheduleRequest] -> ShowS)
-> Show UpdateScheduleRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateScheduleRequest -> ShowS
showsPrec :: Int -> UpdateScheduleRequest -> ShowS
$cshow :: UpdateScheduleRequest -> String
show :: UpdateScheduleRequest -> String
$cshowList :: [UpdateScheduleRequest] -> ShowS
showList :: [UpdateScheduleRequest] -> ShowS
Show, UpdateScheduleRequest -> UpdateScheduleRequest -> Bool
(UpdateScheduleRequest -> UpdateScheduleRequest -> Bool)
-> (UpdateScheduleRequest -> UpdateScheduleRequest -> Bool)
-> Eq UpdateScheduleRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateScheduleRequest -> UpdateScheduleRequest -> Bool
== :: UpdateScheduleRequest -> UpdateScheduleRequest -> Bool
$c/= :: UpdateScheduleRequest -> UpdateScheduleRequest -> Bool
/= :: UpdateScheduleRequest -> UpdateScheduleRequest -> Bool
Eq, (forall x. UpdateScheduleRequest -> Rep UpdateScheduleRequest x)
-> (forall x. Rep UpdateScheduleRequest x -> UpdateScheduleRequest)
-> Generic UpdateScheduleRequest
forall x. Rep UpdateScheduleRequest x -> UpdateScheduleRequest
forall x. UpdateScheduleRequest -> Rep UpdateScheduleRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateScheduleRequest -> Rep UpdateScheduleRequest x
from :: forall x. UpdateScheduleRequest -> Rep UpdateScheduleRequest x
$cto :: forall x. Rep UpdateScheduleRequest x -> UpdateScheduleRequest
to :: forall x. Rep UpdateScheduleRequest x -> UpdateScheduleRequest
Generic)


updateSchedule
  :: MonadIO m
  => ScheduleClient
  -> ScheduleId
  -> UpdateScheduleRequest
  -> m ()
updateSchedule :: forall (m :: * -> *).
MonadIO m =>
ScheduleClient -> ScheduleId -> UpdateScheduleRequest -> m ()
updateSchedule ScheduleClient
c (ScheduleId Text
s) UpdateScheduleRequest
u = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  _resp <-
    IO (Either RpcError UpdateScheduleResponse)
-> IO UpdateScheduleResponse
forall (m :: * -> *) e a.
(MonadIO m, Exception e) =>
m (Either e a) -> m a
throwEither (IO (Either RpcError UpdateScheduleResponse)
 -> IO UpdateScheduleResponse)
-> IO (Either RpcError UpdateScheduleResponse)
-> IO UpdateScheduleResponse
forall a b. (a -> b) -> a -> b
$
      Client
-> UpdateScheduleRequest
-> IO (Either RpcError UpdateScheduleResponse)
Core.updateSchedule
        ScheduleClient
c.scheduleClient
        ( UpdateScheduleRequest
forall msg. Message msg => msg
defMessage
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "namespace" a) =>
LensLike' f s a
WF.namespace (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest Text)
-> Text -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Namespace -> Text
rawNamespace ScheduleClient
c.scheduleClientNamespace
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "scheduleId" a) =>
LensLike' f s a
WF.scheduleId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest Text)
-> Text -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
s
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest Schedule
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest Schedule
forall (f :: * -> *) s a.
(Functor f, HasField s "schedule" a) =>
LensLike' f s a
WF.schedule (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest Schedule)
-> Schedule -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ Schedule -> Schedule
scheduleToProto UpdateScheduleRequest
u.schedule
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest ByteString
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "conflictToken" a) =>
LensLike' f s a
WF.conflictToken (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest ByteString)
-> ByteString -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" UpdateScheduleRequest
u.conflictToken
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "identity" a) =>
LensLike' f s a
WF.identity (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest Text)
-> Text -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleClient
c.identity
            UpdateScheduleRequest
-> (UpdateScheduleRequest -> UpdateScheduleRequest)
-> UpdateScheduleRequest
forall s t. s -> (s -> t) -> t
& LensLike' f UpdateScheduleRequest Text
forall {f :: * -> *}.
Identical f =>
LensLike' f UpdateScheduleRequest Text
forall (f :: * -> *) s a.
(Functor f, HasField s "requestId" a) =>
LensLike' f s a
WF.requestId (forall {f :: * -> *}.
 Identical f =>
 LensLike' f UpdateScheduleRequest Text)
-> Text -> UpdateScheduleRequest -> UpdateScheduleRequest
forall s t a b. Setter s t a b -> b -> s -> t
.~ UpdateScheduleRequest
u.requestId
        )
  pure ()


scheduleSpec :: ScheduleSpec
scheduleSpec :: ScheduleSpec
scheduleSpec =
  ScheduleSpec
    { structuredCalendar :: [StructuredCalendarSpec]
structuredCalendar = [StructuredCalendarSpec]
forall a. Monoid a => a
mempty
    , cronString :: [Text]
cronString = [Text]
forall a. Monoid a => a
mempty
    , calendar :: [CalendarSpec]
calendar = [CalendarSpec]
forall a. Monoid a => a
mempty
    , interval :: [IntervalSpec]
interval = [IntervalSpec]
forall a. Monoid a => a
mempty
    , excludeCalendar :: [CalendarSpec]
excludeCalendar = [CalendarSpec]
forall a. Monoid a => a
mempty
    , excludeStructuredCalendar :: [StructuredCalendarSpec]
excludeStructuredCalendar = [StructuredCalendarSpec]
forall a. Monoid a => a
mempty
    , startTime :: Maybe SystemTime
startTime = Maybe SystemTime
forall a. Maybe a
Nothing
    , endTime :: Maybe SystemTime
endTime = Maybe SystemTime
forall a. Maybe a
Nothing
    , jitter :: Maybe Duration
jitter = Maybe Duration
forall a. Maybe a
Nothing
    , timezoneName :: Text
timezoneName = Text
"UTC"
    , timezoneData :: Maybe ByteString
timezoneData = Maybe ByteString
forall a. Maybe a
Nothing
    }


{- | ScheduleSpec is a complete description of a set of absolute timestamps
(possibly infinite) that an action should occur at. The meaning of a
ScheduleSpec depends only on its contents and never changes, except that the
definition of a time zone can change over time (most commonly, when daylight
saving time policy changes for an area). To create a totally self-contained
ScheduleSpec, use UTC or include timezone_data.

For input, you can provide zero or more of: structured_calendar, calendar,
cron_string, interval, and exclude_structured_calendar, and all of them will
be used (the schedule will take action at the union of all of their times,
minus the ones that match exclude_structured_calendar).

On input, calendar and cron_string fields will be compiled into
structured_calendar (and maybe interval and timezone_name), so if you
Describe a schedule, you'll see only structured_calendar, interval, etc.
-}
data ScheduleSpec = ScheduleSpec
  { ScheduleSpec -> [StructuredCalendarSpec]
structuredCalendar :: [StructuredCalendarSpec]
  -- ^ Calendar-based specifications of times.
  , ScheduleSpec -> [Text]
cronString :: [Text]
  -- ^ cron_string holds a traditional cron specification as a string. It
  -- accepts 5, 6, or 7 fields, separated by spaces, and interprets them the
  -- same way as CalendarSpec.
  --
  -- * 5 fields:         minute, hour, day_of_month, month, day_of_week
  -- * 6 fields:         minute, hour, day_of_month, month, day_of_week, year
  -- * 7 fields: second, minute, hour, day_of_month, month, day_of_week, year
  --
  -- If year is not given, it defaults to *. If second is not given, it
  -- defaults to 0.
  --
  -- Shorthands @yearly, @monthly, @weekly, @daily, and @hourly are also
  -- accepted instead of the 5-7 time fields.
  --
  -- Optionally, the string can be preceded by CRON_TZ=<timezone name> or
  -- TZ=<timezone name>, which will get copied to timezone_name. (There must
  -- not also be a timezone_name present.)
  -- Optionally "#" followed by a comment can appear at the end of the string.
  -- Note that the special case that some cron implementations have for
  -- treating day_of_month and day_of_week as "or" instead of "and" when both
  -- are set is not implemented.
  -- @every <interval>[/<phase>] is accepted and gets compiled into an
  -- IntervalSpec instead. <interval> and <phase> should be a decimal integer
  -- with a unit suffix s, m, h, or d.
  , ScheduleSpec -> [CalendarSpec]
calendar :: [CalendarSpec]
  -- ^ Calendar-based specifications of times.
  , ScheduleSpec -> [IntervalSpec]
interval :: [IntervalSpec]
  -- ^ Interval-based specifications of times.
  , ScheduleSpec -> [CalendarSpec]
excludeCalendar :: [CalendarSpec]
  -- ^ Any timestamps matching any of exclude_* will be skipped.
  , ScheduleSpec -> [StructuredCalendarSpec]
excludeStructuredCalendar :: [StructuredCalendarSpec]
  -- ^ Any timestamps matching any of exclude_* will be skipped.
  , ScheduleSpec -> Maybe SystemTime
startTime :: Maybe SystemTime
  -- ^ If startTime is set, any timestamps before startTime will be skipped.
  -- (Together, startTime and endTime make an inclusive interval.)
  , ScheduleSpec -> Maybe SystemTime
endTime :: Maybe SystemTime
  -- ^ If endTime is set, any timestamps after endTime will be skipped.
  , ScheduleSpec -> Maybe Duration
jitter :: Maybe Duration
  -- ^ All timestamps will be incremented by a random value from 0 to this
  -- amount of jitter. Default: 0
  , ScheduleSpec -> Text
timezoneName :: Text
  -- ^ Time zone to interpret all calendar-based specs in.
  --
  -- If unset, defaults to UTC. We recommend using UTC for your application if
  -- at all possible, to avoid various surprising properties of time zones.
  --
  -- Time zones may be provided by name, corresponding to names in the IANA
  -- time zone database (see https://www.iana.org/time-zones). The definition
  -- will be loaded by the Temporal server from the environment it runs in.
  --
  -- If your application requires more control over the time zone definition
  -- used, it may pass in a complete definition in the form of a TZif file
  -- from the time zone database. If present, this will be used instead of
  -- loading anything from the environment. You are then responsible for
  -- updating timezone_data when the definition changes.
  --
  -- Calendar spec matching is based on literal matching of the clock time
  -- with no special handling of DST: if you write a calendar spec that fires
  -- at 2:30am and specify a time zone that follows DST, that action will not
  -- be triggered on the day that has no 2:30am. Similarly, an action that
  -- fires at 1:30am will be triggered twice on the day that has two 1:30s.
  --
  -- Also note that no actions are taken on leap-seconds (e.g. 23:59:60 UTC).
  , ScheduleSpec -> Maybe ByteString
timezoneData :: Maybe ByteString
  -- ^ Some time zone definitions are not available in the IANA database, or
  -- are not available in the version of the database that the Temporal
  -- server is using. In this case, you can provide a complete definition in
  -- the form of a TZif file from the time zone database. If present, this
  -- will be used instead of loading anything from the environment. You are
  -- then responsible for updating timezone_data when the definition changes.
  }
  deriving stock (ScheduleSpec -> ScheduleSpec -> Bool
(ScheduleSpec -> ScheduleSpec -> Bool)
-> (ScheduleSpec -> ScheduleSpec -> Bool) -> Eq ScheduleSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScheduleSpec -> ScheduleSpec -> Bool
== :: ScheduleSpec -> ScheduleSpec -> Bool
$c/= :: ScheduleSpec -> ScheduleSpec -> Bool
/= :: ScheduleSpec -> ScheduleSpec -> Bool
Eq, Eq ScheduleSpec
Eq ScheduleSpec =>
(ScheduleSpec -> ScheduleSpec -> Ordering)
-> (ScheduleSpec -> ScheduleSpec -> Bool)
-> (ScheduleSpec -> ScheduleSpec -> Bool)
-> (ScheduleSpec -> ScheduleSpec -> Bool)
-> (ScheduleSpec -> ScheduleSpec -> Bool)
-> (ScheduleSpec -> ScheduleSpec -> ScheduleSpec)
-> (ScheduleSpec -> ScheduleSpec -> ScheduleSpec)
-> Ord ScheduleSpec
ScheduleSpec -> ScheduleSpec -> Bool
ScheduleSpec -> ScheduleSpec -> Ordering
ScheduleSpec -> ScheduleSpec -> ScheduleSpec
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 :: ScheduleSpec -> ScheduleSpec -> Ordering
compare :: ScheduleSpec -> ScheduleSpec -> Ordering
$c< :: ScheduleSpec -> ScheduleSpec -> Bool
< :: ScheduleSpec -> ScheduleSpec -> Bool
$c<= :: ScheduleSpec -> ScheduleSpec -> Bool
<= :: ScheduleSpec -> ScheduleSpec -> Bool
$c> :: ScheduleSpec -> ScheduleSpec -> Bool
> :: ScheduleSpec -> ScheduleSpec -> Bool
$c>= :: ScheduleSpec -> ScheduleSpec -> Bool
>= :: ScheduleSpec -> ScheduleSpec -> Bool
$cmax :: ScheduleSpec -> ScheduleSpec -> ScheduleSpec
max :: ScheduleSpec -> ScheduleSpec -> ScheduleSpec
$cmin :: ScheduleSpec -> ScheduleSpec -> ScheduleSpec
min :: ScheduleSpec -> ScheduleSpec -> ScheduleSpec
Ord, Int -> ScheduleSpec -> ShowS
[ScheduleSpec] -> ShowS
ScheduleSpec -> String
(Int -> ScheduleSpec -> ShowS)
-> (ScheduleSpec -> String)
-> ([ScheduleSpec] -> ShowS)
-> Show ScheduleSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScheduleSpec -> ShowS
showsPrec :: Int -> ScheduleSpec -> ShowS
$cshow :: ScheduleSpec -> String
show :: ScheduleSpec -> String
$cshowList :: [ScheduleSpec] -> ShowS
showList :: [ScheduleSpec] -> ShowS
Show, (forall x. ScheduleSpec -> Rep ScheduleSpec x)
-> (forall x. Rep ScheduleSpec x -> ScheduleSpec)
-> Generic ScheduleSpec
forall x. Rep ScheduleSpec x -> ScheduleSpec
forall x. ScheduleSpec -> Rep ScheduleSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScheduleSpec -> Rep ScheduleSpec x
from :: forall x. ScheduleSpec -> Rep ScheduleSpec x
$cto :: forall x. Rep ScheduleSpec x -> ScheduleSpec
to :: forall x. Rep ScheduleSpec x -> ScheduleSpec
Generic)


scheduleSpecToProto :: ScheduleSpec -> S.ScheduleSpec
scheduleSpecToProto :: ScheduleSpec -> ScheduleSpec
scheduleSpecToProto ScheduleSpec
p =
  ScheduleSpec
forall msg. Message msg => msg
defMessage
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [StructuredCalendarSpec]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [StructuredCalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "structuredCalendar" a) =>
LensLike' f s a
S.structuredCalendar (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [StructuredCalendarSpec])
-> [StructuredCalendarSpec] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (StructuredCalendarSpec -> StructuredCalendarSpec)
-> [StructuredCalendarSpec] -> [StructuredCalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecToProto ScheduleSpec
p.structuredCalendar
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [Text]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [Text]
forall (f :: * -> *) s a.
(Functor f, HasField s "cronString" a) =>
LensLike' f s a
S.cronString (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [Text])
-> [Text] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleSpec
p.cronString
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [CalendarSpec]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [CalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "calendar" a) =>
LensLike' f s a
S.calendar (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [CalendarSpec])
-> [CalendarSpec] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (CalendarSpec -> CalendarSpec) -> [CalendarSpec] -> [CalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarSpec -> CalendarSpec
calendarSpecToProto ScheduleSpec
p.calendar
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [IntervalSpec]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [IntervalSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "interval" a) =>
LensLike' f s a
S.interval (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [IntervalSpec])
-> [IntervalSpec] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (IntervalSpec -> IntervalSpec) -> [IntervalSpec] -> [IntervalSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntervalSpec -> IntervalSpec
intervalSpecToProto ScheduleSpec
p.interval
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [CalendarSpec]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [CalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "excludeCalendar" a) =>
LensLike' f s a
S.excludeCalendar (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [CalendarSpec])
-> [CalendarSpec] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (CalendarSpec -> CalendarSpec) -> [CalendarSpec] -> [CalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarSpec -> CalendarSpec
calendarSpecToProto ScheduleSpec
p.excludeCalendar
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec [StructuredCalendarSpec]
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec [StructuredCalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "excludeStructuredCalendar" a) =>
LensLike' f s a
S.excludeStructuredCalendar (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec [StructuredCalendarSpec])
-> [StructuredCalendarSpec] -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (StructuredCalendarSpec -> StructuredCalendarSpec)
-> [StructuredCalendarSpec] -> [StructuredCalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecToProto ScheduleSpec
p.excludeStructuredCalendar
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec (Maybe Timestamp)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'startTime" a) =>
LensLike' f s a
S.maybe'startTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec (Maybe Timestamp))
-> Maybe Timestamp -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (SystemTime -> Timestamp) -> Maybe SystemTime -> Maybe Timestamp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemTime -> Timestamp
timespecToTimestamp ScheduleSpec
p.startTime
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec (Maybe Timestamp)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'endTime" a) =>
LensLike' f s a
S.maybe'endTime (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec (Maybe Timestamp))
-> Maybe Timestamp -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (SystemTime -> Timestamp) -> Maybe SystemTime -> Maybe Timestamp
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SystemTime -> Timestamp
timespecToTimestamp ScheduleSpec
p.endTime
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'jitter" a) =>
LensLike' f s a
S.maybe'jitter (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec (Maybe Duration))
-> Maybe Duration -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto ScheduleSpec
p.jitter
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec Text
forall {f :: * -> *}. Identical f => LensLike' f ScheduleSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "timezoneName" a) =>
LensLike' f s a
S.timezoneName (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec Text)
-> Text -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ ScheduleSpec
p.timezoneName
    ScheduleSpec -> (ScheduleSpec -> ScheduleSpec) -> ScheduleSpec
forall s t. s -> (s -> t) -> t
& LensLike' f ScheduleSpec ByteString
forall {f :: * -> *}.
Identical f =>
LensLike' f ScheduleSpec ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "timezoneData" a) =>
LensLike' f s a
S.timezoneData (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ScheduleSpec ByteString)
-> ByteString -> ScheduleSpec -> ScheduleSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" ScheduleSpec
p.timezoneData


scheduleSpecFromProto :: S.ScheduleSpec -> ScheduleSpec
scheduleSpecFromProto :: ScheduleSpec -> ScheduleSpec
scheduleSpecFromProto ScheduleSpec
p =
  ScheduleSpec
    { structuredCalendar :: [StructuredCalendarSpec]
structuredCalendar = (StructuredCalendarSpec -> StructuredCalendarSpec)
-> [StructuredCalendarSpec] -> [StructuredCalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     [StructuredCalendarSpec]
     ScheduleSpec
     ScheduleSpec
     [StructuredCalendarSpec]
     [StructuredCalendarSpec]
-> [StructuredCalendarSpec]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [StructuredCalendarSpec]
  ScheduleSpec
  ScheduleSpec
  [StructuredCalendarSpec]
  [StructuredCalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "structuredCalendar" a) =>
LensLike' f s a
S.structuredCalendar)
    , cronString :: [Text]
cronString = ScheduleSpec
p ScheduleSpec
-> FoldLike [Text] ScheduleSpec ScheduleSpec [Text] [Text]
-> [Text]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike [Text] ScheduleSpec ScheduleSpec [Text] [Text]
forall (f :: * -> *) s a.
(Functor f, HasField s "cronString" a) =>
LensLike' f s a
S.cronString
    , calendar :: [CalendarSpec]
calendar = (CalendarSpec -> CalendarSpec) -> [CalendarSpec] -> [CalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarSpec -> CalendarSpec
calendarSpecFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     [CalendarSpec]
     ScheduleSpec
     ScheduleSpec
     [CalendarSpec]
     [CalendarSpec]
-> [CalendarSpec]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [CalendarSpec]
  ScheduleSpec
  ScheduleSpec
  [CalendarSpec]
  [CalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "calendar" a) =>
LensLike' f s a
S.calendar)
    , interval :: [IntervalSpec]
interval = (IntervalSpec -> IntervalSpec) -> [IntervalSpec] -> [IntervalSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IntervalSpec -> IntervalSpec
intervalSpecFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     [IntervalSpec]
     ScheduleSpec
     ScheduleSpec
     [IntervalSpec]
     [IntervalSpec]
-> [IntervalSpec]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [IntervalSpec]
  ScheduleSpec
  ScheduleSpec
  [IntervalSpec]
  [IntervalSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "interval" a) =>
LensLike' f s a
S.interval)
    , excludeCalendar :: [CalendarSpec]
excludeCalendar = (CalendarSpec -> CalendarSpec) -> [CalendarSpec] -> [CalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CalendarSpec -> CalendarSpec
calendarSpecFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     [CalendarSpec]
     ScheduleSpec
     ScheduleSpec
     [CalendarSpec]
     [CalendarSpec]
-> [CalendarSpec]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [CalendarSpec]
  ScheduleSpec
  ScheduleSpec
  [CalendarSpec]
  [CalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "excludeCalendar" a) =>
LensLike' f s a
S.excludeCalendar)
    , excludeStructuredCalendar :: [StructuredCalendarSpec]
excludeStructuredCalendar = (StructuredCalendarSpec -> StructuredCalendarSpec)
-> [StructuredCalendarSpec] -> [StructuredCalendarSpec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     [StructuredCalendarSpec]
     ScheduleSpec
     ScheduleSpec
     [StructuredCalendarSpec]
     [StructuredCalendarSpec]
-> [StructuredCalendarSpec]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [StructuredCalendarSpec]
  ScheduleSpec
  ScheduleSpec
  [StructuredCalendarSpec]
  [StructuredCalendarSpec]
forall (f :: * -> *) s a.
(Functor f, HasField s "excludeStructuredCalendar" a) =>
LensLike' f s a
S.excludeStructuredCalendar)
    , startTime :: Maybe SystemTime
startTime = (Timestamp -> SystemTime) -> Maybe Timestamp -> Maybe SystemTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleSpec
p ScheduleSpec
-> FoldLike
     (Maybe Timestamp)
     ScheduleSpec
     ScheduleSpec
     (Maybe Timestamp)
     (Maybe Timestamp)
-> Maybe Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Timestamp)
  ScheduleSpec
  ScheduleSpec
  (Maybe Timestamp)
  (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'startTime" a) =>
LensLike' f s a
S.maybe'startTime)
    , endTime :: Maybe SystemTime
endTime = (Timestamp -> SystemTime) -> Maybe Timestamp -> Maybe SystemTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Timestamp -> SystemTime
timespecFromTimestamp (ScheduleSpec
p ScheduleSpec
-> FoldLike
     (Maybe Timestamp)
     ScheduleSpec
     ScheduleSpec
     (Maybe Timestamp)
     (Maybe Timestamp)
-> Maybe Timestamp
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Timestamp)
  ScheduleSpec
  ScheduleSpec
  (Maybe Timestamp)
  (Maybe Timestamp)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'endTime" a) =>
LensLike' f s a
S.maybe'endTime)
    , jitter :: Maybe Duration
jitter = (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationFromProto (ScheduleSpec
p ScheduleSpec
-> FoldLike
     (Maybe Duration)
     ScheduleSpec
     ScheduleSpec
     (Maybe Duration)
     (Maybe Duration)
-> Maybe Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Duration)
  ScheduleSpec
  ScheduleSpec
  (Maybe Duration)
  (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'jitter" a) =>
LensLike' f s a
S.maybe'jitter)
    , timezoneName :: Text
timezoneName = ScheduleSpec
p ScheduleSpec
-> FoldLike Text ScheduleSpec ScheduleSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text ScheduleSpec ScheduleSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "timezoneName" a) =>
LensLike' f s a
S.timezoneName
    , timezoneData :: Maybe ByteString
timezoneData =
        if ScheduleSpec
p ScheduleSpec
-> FoldLike
     ByteString ScheduleSpec ScheduleSpec ByteString ByteString
-> ByteString
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike ByteString ScheduleSpec ScheduleSpec ByteString ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "timezoneData" a) =>
LensLike' f s a
S.timezoneData ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
""
          then Maybe ByteString
forall a. Maybe a
Nothing
          else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ScheduleSpec
p ScheduleSpec
-> FoldLike
     ByteString ScheduleSpec ScheduleSpec ByteString ByteString
-> ByteString
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike ByteString ScheduleSpec ScheduleSpec ByteString ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "timezoneData" a) =>
LensLike' f s a
S.timezoneData)
    }


{- | Range represents a set of integer values, used to match fields of a calendar
time in StructuredCalendarSpec. If end < start, then end is interpreted as
equal to start. This means you can use a Range with start set to a value, and
end and step unset (defaulting to 0) to represent a single value.
-}
data Range = Range
  { Range -> Int32
start :: !Int32
  -- ^ Start of range (inclusive).
  , Range -> Int32
end :: !Int32
  -- ^ End of range (inclusive).
  , Range -> Int32
step :: !Int32
  -- ^ Step (optional, default 1).
  }
  deriving stock (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Eq Range
Eq Range =>
(Range -> Range -> Ordering)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Bool)
-> (Range -> Range -> Range)
-> (Range -> Range -> Range)
-> Ord Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
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 :: Range -> Range -> Ordering
compare :: Range -> Range -> Ordering
$c< :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
>= :: Range -> Range -> Bool
$cmax :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
min :: Range -> Range -> Range
Ord, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show, (forall x. Range -> Rep Range x)
-> (forall x. Rep Range x -> Range) -> Generic Range
forall x. Rep Range x -> Range
forall x. Range -> Rep Range x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Range -> Rep Range x
from :: forall x. Range -> Rep Range x
$cto :: forall x. Rep Range x -> Range
to :: forall x. Rep Range x -> Range
Generic)


rangeToProto :: Range -> S.Range
rangeToProto :: Range -> Range
rangeToProto Range
p =
  Range
forall msg. Message msg => msg
defMessage
    Range -> (Range -> Range) -> Range
forall s t. s -> (s -> t) -> t
& LensLike' f Range Int32
forall {f :: * -> *}. Identical f => LensLike' f Range Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "start" a) =>
LensLike' f s a
S.start (forall {f :: * -> *}. Identical f => LensLike' f Range Int32)
-> Int32 -> Range -> Range
forall s t a b. Setter s t a b -> b -> s -> t
.~ Range
p.start
    Range -> (Range -> Range) -> Range
forall s t. s -> (s -> t) -> t
& LensLike' f Range Int32
forall {f :: * -> *}. Identical f => LensLike' f Range Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "end" a) =>
LensLike' f s a
S.end (forall {f :: * -> *}. Identical f => LensLike' f Range Int32)
-> Int32 -> Range -> Range
forall s t a b. Setter s t a b -> b -> s -> t
.~ Range
p.end
    Range -> (Range -> Range) -> Range
forall s t. s -> (s -> t) -> t
& LensLike' f Range Int32
forall {f :: * -> *}. Identical f => LensLike' f Range Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "step" a) =>
LensLike' f s a
S.step (forall {f :: * -> *}. Identical f => LensLike' f Range Int32)
-> Int32 -> Range -> Range
forall s t a b. Setter s t a b -> b -> s -> t
.~ Range
p.step


rangeFromProto :: S.Range -> Range
rangeFromProto :: Range -> Range
rangeFromProto Range
p =
  Range
    { start :: Int32
start = Range
p Range -> FoldLike Int32 Range Range Int32 Int32 -> Int32
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int32 Range Range Int32 Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "start" a) =>
LensLike' f s a
S.start
    , end :: Int32
end = Range
p Range -> FoldLike Int32 Range Range Int32 Int32 -> Int32
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int32 Range Range Int32 Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "end" a) =>
LensLike' f s a
S.end
    , step :: Int32
step = Range
p Range -> FoldLike Int32 Range Range Int32 Int32 -> Int32
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Int32 Range Range Int32 Int32
forall (f :: * -> *) s a.
(Functor f, HasField s "step" a) =>
LensLike' f s a
S.step
    }


{- | StructuredCalendarSpec describes an event specification relative to the
calendar, in a form that's easy to work with programmatically. Each field can
be one or more ranges.

A timestamp matches if at least one range of each field matches the
corresponding fields of the timestamp, except for year: if year is missing,
that means all years match. For all fields besides year, at least one Range
must be present to match anything.
-}
data StructuredCalendarSpec = StructuredCalendarSpec
  { StructuredCalendarSpec -> [Range]
second :: [Range]
  -- ^ Match seconds (0-59)
  , StructuredCalendarSpec -> [Range]
minute :: [Range]
  -- ^ Match minutes (0-59)
  , StructuredCalendarSpec -> [Range]
hour :: [Range]
  -- ^ Match hours (0-23)
  , StructuredCalendarSpec -> [Range]
dayOfMonth :: [Range]
  -- ^ Match days of the month (1-31)
  , StructuredCalendarSpec -> [Range]
month :: [Range]
  -- ^ Match months (1-12)
  , StructuredCalendarSpec -> [Range]
year :: [Range]
  -- ^ Match years.
  , StructuredCalendarSpec -> [Range]
dayOfWeek :: [Range]
  -- ^ Match days of the week (0-6; 0 is Sunday).
  , StructuredCalendarSpec -> Text
comment :: Text
  -- ^ Free-form comment describing the intention of this spec.
  }
  deriving stock (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
(StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> Eq StructuredCalendarSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
== :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
$c/= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
/= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
Eq, Eq StructuredCalendarSpec
Eq StructuredCalendarSpec =>
(StructuredCalendarSpec -> StructuredCalendarSpec -> Ordering)
-> (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> (StructuredCalendarSpec -> StructuredCalendarSpec -> Bool)
-> (StructuredCalendarSpec
    -> StructuredCalendarSpec -> StructuredCalendarSpec)
-> (StructuredCalendarSpec
    -> StructuredCalendarSpec -> StructuredCalendarSpec)
-> Ord StructuredCalendarSpec
StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
StructuredCalendarSpec -> StructuredCalendarSpec -> Ordering
StructuredCalendarSpec
-> StructuredCalendarSpec -> StructuredCalendarSpec
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 :: StructuredCalendarSpec -> StructuredCalendarSpec -> Ordering
compare :: StructuredCalendarSpec -> StructuredCalendarSpec -> Ordering
$c< :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
< :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
$c<= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
<= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
$c> :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
> :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
$c>= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
>= :: StructuredCalendarSpec -> StructuredCalendarSpec -> Bool
$cmax :: StructuredCalendarSpec
-> StructuredCalendarSpec -> StructuredCalendarSpec
max :: StructuredCalendarSpec
-> StructuredCalendarSpec -> StructuredCalendarSpec
$cmin :: StructuredCalendarSpec
-> StructuredCalendarSpec -> StructuredCalendarSpec
min :: StructuredCalendarSpec
-> StructuredCalendarSpec -> StructuredCalendarSpec
Ord, Int -> StructuredCalendarSpec -> ShowS
[StructuredCalendarSpec] -> ShowS
StructuredCalendarSpec -> String
(Int -> StructuredCalendarSpec -> ShowS)
-> (StructuredCalendarSpec -> String)
-> ([StructuredCalendarSpec] -> ShowS)
-> Show StructuredCalendarSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructuredCalendarSpec -> ShowS
showsPrec :: Int -> StructuredCalendarSpec -> ShowS
$cshow :: StructuredCalendarSpec -> String
show :: StructuredCalendarSpec -> String
$cshowList :: [StructuredCalendarSpec] -> ShowS
showList :: [StructuredCalendarSpec] -> ShowS
Show, (forall x. StructuredCalendarSpec -> Rep StructuredCalendarSpec x)
-> (forall x.
    Rep StructuredCalendarSpec x -> StructuredCalendarSpec)
-> Generic StructuredCalendarSpec
forall x. Rep StructuredCalendarSpec x -> StructuredCalendarSpec
forall x. StructuredCalendarSpec -> Rep StructuredCalendarSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StructuredCalendarSpec -> Rep StructuredCalendarSpec x
from :: forall x. StructuredCalendarSpec -> Rep StructuredCalendarSpec x
$cto :: forall x. Rep StructuredCalendarSpec x -> StructuredCalendarSpec
to :: forall x. Rep StructuredCalendarSpec x -> StructuredCalendarSpec
Generic)


structuredCalendarSpec :: StructuredCalendarSpec
structuredCalendarSpec :: StructuredCalendarSpec
structuredCalendarSpec =
  StructuredCalendarSpec
    { second :: [Range]
second = [Range]
forall a. Monoid a => a
mempty
    , minute :: [Range]
minute = [Range]
forall a. Monoid a => a
mempty
    , hour :: [Range]
hour = [Range]
forall a. Monoid a => a
mempty
    , dayOfMonth :: [Range]
dayOfMonth = [Range]
forall a. Monoid a => a
mempty
    , month :: [Range]
month = [Range]
forall a. Monoid a => a
mempty
    , year :: [Range]
year = [Range]
forall a. Monoid a => a
mempty
    , dayOfWeek :: [Range]
dayOfWeek = [Range]
forall a. Monoid a => a
mempty
    , comment :: Text
comment = Text
forall a. Monoid a => a
mempty
    }


structuredCalendarSpecToProto :: StructuredCalendarSpec -> S.StructuredCalendarSpec
structuredCalendarSpecToProto :: StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecToProto StructuredCalendarSpec
p =
  StructuredCalendarSpec
forall msg. Message msg => msg
defMessage
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "second" a) =>
LensLike' f s a
S.second (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.second
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "minute" a) =>
LensLike' f s a
S.minute (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.minute
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "hour" a) =>
LensLike' f s a
S.hour (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.hour
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfMonth" a) =>
LensLike' f s a
S.dayOfMonth (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.dayOfMonth
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "month" a) =>
LensLike' f s a
S.month (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.month
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "year" a) =>
LensLike' f s a
S.year (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.year
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec [Range]
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfWeek" a) =>
LensLike' f s a
S.dayOfWeek (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec [Range])
-> [Range] -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeToProto StructuredCalendarSpec
p.dayOfWeek
    StructuredCalendarSpec
-> (StructuredCalendarSpec -> StructuredCalendarSpec)
-> StructuredCalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f StructuredCalendarSpec Text
forall {f :: * -> *}.
Identical f =>
LensLike' f StructuredCalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "comment" a) =>
LensLike' f s a
S.comment (forall {f :: * -> *}.
 Identical f =>
 LensLike' f StructuredCalendarSpec Text)
-> Text -> StructuredCalendarSpec -> StructuredCalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ StructuredCalendarSpec
p.comment


structuredCalendarSpecFromProto :: S.StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecFromProto :: StructuredCalendarSpec -> StructuredCalendarSpec
structuredCalendarSpecFromProto StructuredCalendarSpec
p =
  StructuredCalendarSpec
    { second :: [Range]
second = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "second" a) =>
LensLike' f s a
S.second)
    , minute :: [Range]
minute = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "minute" a) =>
LensLike' f s a
S.minute)
    , hour :: [Range]
hour = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "hour" a) =>
LensLike' f s a
S.hour)
    , dayOfMonth :: [Range]
dayOfMonth = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfMonth" a) =>
LensLike' f s a
S.dayOfMonth)
    , month :: [Range]
month = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "month" a) =>
LensLike' f s a
S.month)
    , year :: [Range]
year = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "year" a) =>
LensLike' f s a
S.year)
    , dayOfWeek :: [Range]
dayOfWeek = (Range -> Range) -> [Range] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range -> Range
rangeFromProto (StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     [Range]
     StructuredCalendarSpec
     StructuredCalendarSpec
     [Range]
     [Range]
-> [Range]
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  [Range]
  StructuredCalendarSpec
  StructuredCalendarSpec
  [Range]
  [Range]
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfWeek" a) =>
LensLike' f s a
S.dayOfWeek)
    , comment :: Text
comment = StructuredCalendarSpec
p StructuredCalendarSpec
-> FoldLike
     Text StructuredCalendarSpec StructuredCalendarSpec Text Text
-> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  Text StructuredCalendarSpec StructuredCalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "comment" a) =>
LensLike' f s a
S.comment
    }


data CalendarSpec = CalendarSpec
  { CalendarSpec -> Text
second :: !Text
  , -- \^ Expression to match seconds. Default: 0
    CalendarSpec -> Text
minute :: !Text
  -- ^ Expression to match minutes. Default: 0
  , CalendarSpec -> Text
hour :: !Text
  -- ^ Expression to match hours. Default: 0
  , CalendarSpec -> Text
dayOfMonth :: !Text
  -- ^ Expression to match days of the month. Default: *
  , CalendarSpec -> Text
month :: !Text
  -- ^ Expression to match months. Default: *
  , CalendarSpec -> Text
year :: !Text
  -- ^ Expression to match years. Default: *
  , CalendarSpec -> Text
dayOfWeek :: !Text
  -- ^ Expression to match days of the week. Default: *
  , CalendarSpec -> Text
comment :: !Text
  -- ^ Free-form comment describing the intention of this spec.
  }
  deriving stock (CalendarSpec -> CalendarSpec -> Bool
(CalendarSpec -> CalendarSpec -> Bool)
-> (CalendarSpec -> CalendarSpec -> Bool) -> Eq CalendarSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CalendarSpec -> CalendarSpec -> Bool
== :: CalendarSpec -> CalendarSpec -> Bool
$c/= :: CalendarSpec -> CalendarSpec -> Bool
/= :: CalendarSpec -> CalendarSpec -> Bool
Eq, Eq CalendarSpec
Eq CalendarSpec =>
(CalendarSpec -> CalendarSpec -> Ordering)
-> (CalendarSpec -> CalendarSpec -> Bool)
-> (CalendarSpec -> CalendarSpec -> Bool)
-> (CalendarSpec -> CalendarSpec -> Bool)
-> (CalendarSpec -> CalendarSpec -> Bool)
-> (CalendarSpec -> CalendarSpec -> CalendarSpec)
-> (CalendarSpec -> CalendarSpec -> CalendarSpec)
-> Ord CalendarSpec
CalendarSpec -> CalendarSpec -> Bool
CalendarSpec -> CalendarSpec -> Ordering
CalendarSpec -> CalendarSpec -> CalendarSpec
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 :: CalendarSpec -> CalendarSpec -> Ordering
compare :: CalendarSpec -> CalendarSpec -> Ordering
$c< :: CalendarSpec -> CalendarSpec -> Bool
< :: CalendarSpec -> CalendarSpec -> Bool
$c<= :: CalendarSpec -> CalendarSpec -> Bool
<= :: CalendarSpec -> CalendarSpec -> Bool
$c> :: CalendarSpec -> CalendarSpec -> Bool
> :: CalendarSpec -> CalendarSpec -> Bool
$c>= :: CalendarSpec -> CalendarSpec -> Bool
>= :: CalendarSpec -> CalendarSpec -> Bool
$cmax :: CalendarSpec -> CalendarSpec -> CalendarSpec
max :: CalendarSpec -> CalendarSpec -> CalendarSpec
$cmin :: CalendarSpec -> CalendarSpec -> CalendarSpec
min :: CalendarSpec -> CalendarSpec -> CalendarSpec
Ord, Int -> CalendarSpec -> ShowS
[CalendarSpec] -> ShowS
CalendarSpec -> String
(Int -> CalendarSpec -> ShowS)
-> (CalendarSpec -> String)
-> ([CalendarSpec] -> ShowS)
-> Show CalendarSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CalendarSpec -> ShowS
showsPrec :: Int -> CalendarSpec -> ShowS
$cshow :: CalendarSpec -> String
show :: CalendarSpec -> String
$cshowList :: [CalendarSpec] -> ShowS
showList :: [CalendarSpec] -> ShowS
Show, (forall x. CalendarSpec -> Rep CalendarSpec x)
-> (forall x. Rep CalendarSpec x -> CalendarSpec)
-> Generic CalendarSpec
forall x. Rep CalendarSpec x -> CalendarSpec
forall x. CalendarSpec -> Rep CalendarSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CalendarSpec -> Rep CalendarSpec x
from :: forall x. CalendarSpec -> Rep CalendarSpec x
$cto :: forall x. Rep CalendarSpec x -> CalendarSpec
to :: forall x. Rep CalendarSpec x -> CalendarSpec
Generic)


calendarSpec :: CalendarSpec
calendarSpec :: CalendarSpec
calendarSpec =
  CalendarSpec
    { second :: Text
second = Text
"0"
    , minute :: Text
minute = Text
"0"
    , hour :: Text
hour = Text
"0"
    , dayOfMonth :: Text
dayOfMonth = Text
"*"
    , month :: Text
month = Text
"*"
    , year :: Text
year = Text
"*"
    , dayOfWeek :: Text
dayOfWeek = Text
"*"
    , comment :: Text
comment = Text
""
    }


calendarSpecToProto :: CalendarSpec -> S.CalendarSpec
calendarSpecToProto :: CalendarSpec -> CalendarSpec
calendarSpecToProto CalendarSpec
p =
  CalendarSpec
forall msg. Message msg => msg
defMessage
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "second" a) =>
LensLike' f s a
S.second (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.second
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "minute" a) =>
LensLike' f s a
S.minute (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.minute
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "hour" a) =>
LensLike' f s a
S.hour (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.hour
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfMonth" a) =>
LensLike' f s a
S.dayOfMonth (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.dayOfMonth
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "month" a) =>
LensLike' f s a
S.month (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.month
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "year" a) =>
LensLike' f s a
S.year (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.year
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfWeek" a) =>
LensLike' f s a
S.dayOfWeek (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.dayOfWeek
    CalendarSpec -> (CalendarSpec -> CalendarSpec) -> CalendarSpec
forall s t. s -> (s -> t) -> t
& LensLike' f CalendarSpec Text
forall {f :: * -> *}. Identical f => LensLike' f CalendarSpec Text
forall (f :: * -> *) s a.
(Functor f, HasField s "comment" a) =>
LensLike' f s a
S.comment (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CalendarSpec Text)
-> Text -> CalendarSpec -> CalendarSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ CalendarSpec
p.comment


calendarSpecFromProto :: S.CalendarSpec -> CalendarSpec
calendarSpecFromProto :: CalendarSpec -> CalendarSpec
calendarSpecFromProto CalendarSpec
p =
  CalendarSpec
    { second :: Text
second = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "second" a) =>
LensLike' f s a
S.second
    , minute :: Text
minute = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "minute" a) =>
LensLike' f s a
S.minute
    , hour :: Text
hour = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "hour" a) =>
LensLike' f s a
S.hour
    , dayOfMonth :: Text
dayOfMonth = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfMonth" a) =>
LensLike' f s a
S.dayOfMonth
    , month :: Text
month = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "month" a) =>
LensLike' f s a
S.month
    , year :: Text
year = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "year" a) =>
LensLike' f s a
S.year
    , dayOfWeek :: Text
dayOfWeek = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "dayOfWeek" a) =>
LensLike' f s a
S.dayOfWeek
    , comment :: Text
comment = CalendarSpec
p CalendarSpec
-> FoldLike Text CalendarSpec CalendarSpec Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text CalendarSpec CalendarSpec Text Text
forall (f :: * -> *) s a.
(Functor f, HasField s "comment" a) =>
LensLike' f s a
S.comment
    }


{- | IntervalSpec matches times that can be expressed as:

> epoch + n * interval + phase

where n is an integer.
phase defaults to zero if missing. interval is required.
Both interval and phase must be non-negative and are truncated to the nearest
second before any calculations.
For example, an interval of 1 hour with phase of zero would match every hour,
on the hour. The same interval but a phase of 19 minutes would match every
xx:19:00. An interval of 28 days with phase zero would match
2022-02-17T00:00:00Z (among other times). The same interval with a phase of 3
days, 5 hours, and 23 minutes would match 2022-02-20T05:23:00Z instead.
-}
data IntervalSpec = IntervalSpec
  { IntervalSpec -> Duration
interval :: !Duration
  , IntervalSpec -> Maybe Duration
phase :: !(Maybe Duration)
  }
  deriving stock (IntervalSpec -> IntervalSpec -> Bool
(IntervalSpec -> IntervalSpec -> Bool)
-> (IntervalSpec -> IntervalSpec -> Bool) -> Eq IntervalSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntervalSpec -> IntervalSpec -> Bool
== :: IntervalSpec -> IntervalSpec -> Bool
$c/= :: IntervalSpec -> IntervalSpec -> Bool
/= :: IntervalSpec -> IntervalSpec -> Bool
Eq, Int -> IntervalSpec -> ShowS
[IntervalSpec] -> ShowS
IntervalSpec -> String
(Int -> IntervalSpec -> ShowS)
-> (IntervalSpec -> String)
-> ([IntervalSpec] -> ShowS)
-> Show IntervalSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntervalSpec -> ShowS
showsPrec :: Int -> IntervalSpec -> ShowS
$cshow :: IntervalSpec -> String
show :: IntervalSpec -> String
$cshowList :: [IntervalSpec] -> ShowS
showList :: [IntervalSpec] -> ShowS
Show, Eq IntervalSpec
Eq IntervalSpec =>
(IntervalSpec -> IntervalSpec -> Ordering)
-> (IntervalSpec -> IntervalSpec -> Bool)
-> (IntervalSpec -> IntervalSpec -> Bool)
-> (IntervalSpec -> IntervalSpec -> Bool)
-> (IntervalSpec -> IntervalSpec -> Bool)
-> (IntervalSpec -> IntervalSpec -> IntervalSpec)
-> (IntervalSpec -> IntervalSpec -> IntervalSpec)
-> Ord IntervalSpec
IntervalSpec -> IntervalSpec -> Bool
IntervalSpec -> IntervalSpec -> Ordering
IntervalSpec -> IntervalSpec -> IntervalSpec
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 :: IntervalSpec -> IntervalSpec -> Ordering
compare :: IntervalSpec -> IntervalSpec -> Ordering
$c< :: IntervalSpec -> IntervalSpec -> Bool
< :: IntervalSpec -> IntervalSpec -> Bool
$c<= :: IntervalSpec -> IntervalSpec -> Bool
<= :: IntervalSpec -> IntervalSpec -> Bool
$c> :: IntervalSpec -> IntervalSpec -> Bool
> :: IntervalSpec -> IntervalSpec -> Bool
$c>= :: IntervalSpec -> IntervalSpec -> Bool
>= :: IntervalSpec -> IntervalSpec -> Bool
$cmax :: IntervalSpec -> IntervalSpec -> IntervalSpec
max :: IntervalSpec -> IntervalSpec -> IntervalSpec
$cmin :: IntervalSpec -> IntervalSpec -> IntervalSpec
min :: IntervalSpec -> IntervalSpec -> IntervalSpec
Ord, (forall x. IntervalSpec -> Rep IntervalSpec x)
-> (forall x. Rep IntervalSpec x -> IntervalSpec)
-> Generic IntervalSpec
forall x. Rep IntervalSpec x -> IntervalSpec
forall x. IntervalSpec -> Rep IntervalSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IntervalSpec -> Rep IntervalSpec x
from :: forall x. IntervalSpec -> Rep IntervalSpec x
$cto :: forall x. Rep IntervalSpec x -> IntervalSpec
to :: forall x. Rep IntervalSpec x -> IntervalSpec
Generic)


intervalSpecToProto :: IntervalSpec -> S.IntervalSpec
intervalSpecToProto :: IntervalSpec -> IntervalSpec
intervalSpecToProto IntervalSpec
p =
  IntervalSpec
forall msg. Message msg => msg
defMessage
    IntervalSpec -> (IntervalSpec -> IntervalSpec) -> IntervalSpec
forall s t. s -> (s -> t) -> t
& LensLike' f IntervalSpec Duration
forall {f :: * -> *}.
Identical f =>
LensLike' f IntervalSpec Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "interval" a) =>
LensLike' f s a
S.interval (forall {f :: * -> *}.
 Identical f =>
 LensLike' f IntervalSpec Duration)
-> Duration -> IntervalSpec -> IntervalSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ Duration -> Duration
durationToProto IntervalSpec
p.interval
    IntervalSpec -> (IntervalSpec -> IntervalSpec) -> IntervalSpec
forall s t. s -> (s -> t) -> t
& LensLike' f IntervalSpec (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f IntervalSpec (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'phase" a) =>
LensLike' f s a
S.maybe'phase (forall {f :: * -> *}.
 Identical f =>
 LensLike' f IntervalSpec (Maybe Duration))
-> Maybe Duration -> IntervalSpec -> IntervalSpec
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto IntervalSpec
p.phase


intervalSpecFromProto :: S.IntervalSpec -> IntervalSpec
intervalSpecFromProto :: IntervalSpec -> IntervalSpec
intervalSpecFromProto IntervalSpec
p =
  IntervalSpec
    { interval :: Duration
interval = Duration -> Duration
durationFromProto (IntervalSpec
p IntervalSpec
-> FoldLike Duration IntervalSpec IntervalSpec Duration Duration
-> Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Duration IntervalSpec IntervalSpec Duration Duration
forall (f :: * -> *) s a.
(Functor f, HasField s "interval" a) =>
LensLike' f s a
S.interval)
    , phase :: Maybe Duration
phase = (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationFromProto (IntervalSpec
p IntervalSpec
-> FoldLike
     (Maybe Duration)
     IntervalSpec
     IntervalSpec
     (Maybe Duration)
     (Maybe Duration)
-> Maybe Duration
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Duration)
  IntervalSpec
  IntervalSpec
  (Maybe Duration)
  (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'phase" a) =>
LensLike' f s a
S.maybe'phase)
    }