| Copyright | (C) 2014-15 Mark Andrus Roberts |
|---|---|
| License | BSD-style (see the file LICENSE) |
| Maintainer | Mark Andrus Roberts <markandrusroberts@gmail.com> |
| Stability | provisional |
| Safe Haskell | None |
| Language | Haskell98 |
Text.XML.Twiml.Internal.Twiml
Contents
Description
This module defines all of the TwiML verbs and nouns in a single place (mainly due to a few mutually-recursive definitions). This modules also exposeses the internals of each TwiML's attributes.
Prefer the definitions re-exported by the Text.XML.Twiml and Text.XML.Twiml.Verbs modules to those exported here.
- data MessagingTwiml = forall i . MessagingTwiml (IxFree MessagingVerbsF i Void)
- newtype MessagingVerbsF i a = MessagingVerbsF {}
- data VoiceTwiml = forall i . VoiceTwiml (IxFree VoiceVerbsF i Void)
- newtype VoiceVerbsF i a = VoiceVerbsF {}
- type family Base d
- type IsTwimlLike f i = (Functor1 f, Base i `[i]` :<: f `[i]`)
- type TwimlLike f i = TwimlLike' f `[i]`
- type TwimlLike' f = IxFree f
- response :: IxFree VoiceVerbsF i Void -> VoiceTwiml
- data DialNoun = forall i . DialNoun (IxFree DialNounF i Void)
- newtype DialNounF i a = DialNounF {
- getDialNounF :: (ClientF i :+: (ConferenceF i :+: (NumberF i :+: (QueueF i :+: SipF i)))) a
- data Client
- data ClientF i a = (Proxy i ~ Proxy `[Client]`) => ClientF String ClientAttributes
- data ClientAttributes = ClientAttributes {
- _clientUrl :: !(Maybe URL)
- _clientMethod :: !(Maybe Method)
- data Conference
- data ConferenceF i a = (Proxy i ~ Proxy `[Conference]`) => ConferenceF String ConferenceAttributes
- data ConferenceAttributes = ConferenceAttributes {
- _conferenceMuted :: !(Maybe Bool)
- _conferenceBeep :: !(Maybe Bool)
- _conferenceStartOnEnter :: !(Maybe Bool)
- _conferenceEndOnExit :: !(Maybe Bool)
- _conferenceWaitURL :: !(Maybe URL)
- _conferenceWaitMethod :: !(Maybe Method)
- _conferenceMaxParticipants :: !(Maybe Natural)
- data Number
- data NumberF i a = (Proxy i ~ Proxy `[Number]`) => NumberF String NumberAttributes
- data NumberAttributes = NumberAttributes {
- _numberSendDigits :: !(Maybe Digits)
- _numberUrl :: !(Maybe URL)
- _numberMethod :: !(Maybe Method)
- data Queue
- data QueueF i a = (Proxy i ~ Proxy `[Queue]`) => QueueF String QueueAttributes
- data QueueAttributes = QueueAttributes {}
- data Sip
- data SipF i a = (Proxy i ~ Proxy `[Sip]`) => SipF URL SipAttributes
- data SipAttributes = SipAttributes {
- _sipUsername :: !(Maybe String)
- _sipPassword :: !(Maybe String)
- _sipTransport :: !(Maybe Transport)
- _sipHeaders :: !(Maybe String)
- _sipUrl :: !(Maybe URL)
- _sipMethod :: !(Maybe Method)
- data Dial
- data DialF i a = (Proxy i ~ Proxy `[Dial]`) => DialF EitherDialNounString DialAttributes a
- data DialAttributes = DialAttributes {
- _dialAction :: !(Maybe URL)
- _dialMethod :: !(Maybe Method)
- _dialTimeout :: !(Maybe Natural)
- _dialHangupOnStar :: !(Maybe Bool)
- _dialTimeLimit :: !(Maybe Natural)
- _dialCallerId :: !(Maybe String)
- _dialRecord' :: !(Maybe Bool)
- data End
- data EndF i a = (Proxy i ~ Proxy `[End]`) => EndF
- data Enqueue
- data EnqueueF i a = (Proxy i ~ Proxy `[Enqueue]`) => EnqueueF String EnqueueAttributes a
- data EnqueueAttributes = EnqueueAttributes {
- _enqueueAction :: !(Maybe URL)
- _enqueueMethod :: !(Maybe Method)
- _enqueueWaitURL :: !(Maybe URL)
- _enqueueWaitMethod :: !(Maybe Method)
- data Gather
- data GatherF i a where
- GatherF :: Nest i In Gather => GatherAttributes -> IxFree VoiceVerbsF i Void -> a -> GatherF `[Gather]` a
- data GatherAttributes = GatherAttributes {}
- type family Nest a i b
- data In
- data Hangup
- data HangupF i a = (Proxy i ~ Proxy `[Hangup]`) => HangupF
- data Leave
- data LeaveF i a = (Proxy i ~ Proxy `[Leave]`) => LeaveF
- data Message
- data MessageF i a = (Proxy i ~ Proxy `[Message]`) => MessageF String MessageAttributes a
- data MessageAttributes = MessageAttributes {
- _messageTo :: !(Maybe String)
- _messageFrom :: !(Maybe String)
- _messageAction :: !(Maybe URL)
- _messageMethod :: !(Maybe Method)
- _messageStatusCallback :: !(Maybe URL)
- data Pause
- data PauseF i a = (Proxy i ~ Proxy `[Pause]`) => PauseF PauseAttributes a
- data PauseAttributes = PauseAttributes {
- _pauseDuration :: !(Maybe Natural)
- data Play
- data PlayF i a = (Proxy i ~ Proxy `[Play]`) => PlayF MaybeURL PlayAttributes a
- data PlayAttributes = PlayAttributes {
- _playLoop :: !(Maybe Natural)
- _playDigits :: !(Maybe Digits)
- data Record
- data RecordF i a = (Proxy i ~ Proxy `[Record]`) => RecordF RecordAttributes a
- data RecordAttributes = RecordAttributes {
- _recordAction :: !(Maybe URL)
- _recordMethod :: !(Maybe Method)
- _recordTimeout :: !(Maybe Natural)
- _recordFinishOnKey :: !(Maybe Key)
- _recordMaxLength :: !(Maybe Natural)
- _recordTranscribe :: !(Maybe Bool)
- _recordTranscribeCallback :: !(Maybe URL)
- _recordPlayBeep :: !(Maybe Bool)
- data Redirect
- data RedirectF i a = (Proxy i ~ Proxy `[Redirect]`) => RedirectF URL RedirectAttributes
- data RedirectAttributes = RedirectAttributes {
- _redirectMethod :: !(Maybe Method)
- data Reject
- data RejectF i a = (Proxy i ~ Proxy `[Reject]`) => RejectF RejectAttributes
- data RejectAttributes = RejectAttributes {
- _rejectReason :: !(Maybe Reason)
- data Say
- data SayF i a = (Proxy i ~ Proxy `[Say]`) => SayF String SayAttributes a
- data SayAttributes = SayAttributes {}
- data Sms
- data SmsF i a = (Proxy i ~ Proxy `[Sms]`) => SmsF String SmsAttributes a
- data SmsAttributes = SmsAttributes {
- _smsTo :: !(Maybe String)
- _smsFrom :: !(Maybe String)
- _smsAction :: !(Maybe URL)
- _smsMethod :: !(Maybe Method)
- _smsStatusCallback :: !(Maybe URL)
TwiML
data MessagingTwiml Source
Constructors
| forall i . MessagingTwiml (IxFree MessagingVerbsF i Void) |
Instances
newtype MessagingVerbsF i a Source
Constructors
| MessagingVerbsF | |
Instances
| Functor (MessagingVerbsF i) Source | |
| Show1 [*] MessagingVerbsF Source | |
| Functor1 [*] MessagingVerbsF Source | |
| (:<:) (f i) ((:+:) * (MessageF i) ((:+:) * (RedirectF i) ((:+:) * (SmsF i) (EndF i)))) => (f i) :<: (MessagingVerbsF i) Source | |
| Show a => Show (MessagingVerbsF i a) Source | |
| Generic (MessagingVerbsF i a) Source | |
| ToXML a => ToXML (MessagingVerbsF i a) Source | |
| ToXML (IxFree * MessagingVerbsF i Void) Source | |
| type Rep (MessagingVerbsF i a) Source |
newtype VoiceVerbsF i a Source
Constructors
| VoiceVerbsF | |
Instances
| Functor (VoiceVerbsF i) Source | |
| Show1 [*] VoiceVerbsF Source | |
| Functor1 [*] VoiceVerbsF Source | |
| (:<:) (f i) ((:+:) * (SayF i) ((:+:) * (PlayF i) ((:+:) * (GatherF i) ((:+:) * (SmsF i) ((:+:) * (DialF i) ((:+:) * (EnqueueF i) ((:+:) * (LeaveF i) ((:+:) * (HangupF i) ((:+:) * (RecordF i) ((:+:) * (RedirectF i) ((:+:) * (RejectF i) ((:+:) * (PauseF i) (EndF i))))))))))))) => (f i) :<: (VoiceVerbsF i) Source | |
| Show a => Show (VoiceVerbsF i a) Source | |
| Generic (VoiceVerbsF i a) Source | |
| ToXML a => ToXML (VoiceVerbsF i a) Source | |
| ToXML (IxFree * VoiceVerbsF i Void) Source | |
| type Rep (VoiceVerbsF i a) Source |
Base maps the empty data declaration for a TwiML verb to its
corresponding base functor.
Equations
| Base Dial = DialF | |
| Base End = EndF | |
| Base Enqueue = EnqueueF | |
| Base Gather = GatherF | |
| Base Hangup = HangupF | |
| Base Leave = LeaveF | |
| Base Message = MessageF | |
| Base Pause = PauseF | |
| Base Play = PlayF | |
| Base Record = RecordF | |
| Base Redirect = RedirectF | |
| Base Reject = RejectF | |
| Base Say = SayF | |
| Base Sms = SmsF | |
| Base Client = ClientF | |
| Base Conference = ConferenceF | |
| Base Number = NumberF | |
| Base Queue = QueueF | |
| Base Sip = SipF |
type IsTwimlLike f i = (Functor1 f, Base i `[i]` :<: f `[i]`) Source
type TwimlLike f i = TwimlLike' f `[i]` Source
type TwimlLike' f = IxFree f Source
response :: IxFree VoiceVerbsF i Void -> VoiceTwiml Source
Nouns
Constructors
| DialNounF | |
Fields
| |
Instances
| Functor (DialNounF i) Source | |
| Show1 [*] DialNounF Source | |
| Functor1 [*] DialNounF Source | |
| (:<:) (f i) ((:+:) * (ClientF i) ((:+:) * (ConferenceF i) ((:+:) * (NumberF i) ((:+:) * (QueueF i) (SipF i))))) => (f i) :<: (DialNounF i) Source | |
| Show a => Show (DialNounF i a) Source | |
| Generic (DialNounF i a) Source | |
| ToXML a => ToXML (DialNounF i a) Source | |
| ToXML (IxFree * DialNounF i Void) Source | |
| type Rep (DialNounF i a) Source |
Client
data ClientAttributes Source
Constructors
| ClientAttributes | |
Fields
| |
Instances
Conference
data Conference Source
data ConferenceF i a Source
Constructors
| (Proxy i ~ Proxy `[Conference]`) => ConferenceF String ConferenceAttributes |
Instances
| Functor (ConferenceF i) Source | |
| Functor1 [*] ConferenceF Source | |
| Show a => Show (ConferenceF i a) Source | |
| ToXML (ConferenceF i a) Source |
data ConferenceAttributes Source
Constructors
| ConferenceAttributes | |
Fields
| |
Instances
Number
data NumberAttributes Source
Constructors
| NumberAttributes | |
Fields
| |
Instances
Queue
data QueueAttributes Source
Constructors
| QueueAttributes | |
Instances
Sip
data SipAttributes Source
Constructors
| SipAttributes | |
Fields
| |
Instances
Verbs
Dial
Constructors
| (Proxy i ~ Proxy `[Dial]`) => DialF EitherDialNounString DialAttributes a |
data DialAttributes Source
Constructors
| DialAttributes | |
Fields
| |
Instances
End
Enqueue
data EnqueueAttributes Source
Constructors
| EnqueueAttributes | |
Fields
| |
Instances
Hangup
Constructors
| GatherF :: Nest i In Gather => GatherAttributes -> IxFree VoiceVerbsF i Void -> a -> GatherF `[Gather]` a |
data GatherAttributes Source
Constructors
| GatherAttributes | |
Fields | |
Instances
Hangup
Leave
Message
data MessageAttributes Source
Constructors
| MessageAttributes | |
Fields
| |
Instances
Pause
Constructors
| (Proxy i ~ Proxy `[Pause]`) => PauseF PauseAttributes a |
data PauseAttributes Source
Constructors
| PauseAttributes | |
Fields
| |
Instances
Play
Constructors
| (Proxy i ~ Proxy `[Play]`) => PlayF MaybeURL PlayAttributes a |
data PlayAttributes Source
Constructors
| PlayAttributes | |
Fields
| |
Instances
Record
Constructors
| (Proxy i ~ Proxy `[Record]`) => RecordF RecordAttributes a |
data RecordAttributes Source
Constructors
| RecordAttributes | |
Fields
| |
Instances
Redirect
data RedirectAttributes Source
Constructors
| RedirectAttributes | |
Fields
| |
Instances
Reject
Constructors
| (Proxy i ~ Proxy `[Reject]`) => RejectF RejectAttributes |
data RejectAttributes Source
Constructors
| RejectAttributes | |
Fields
| |
Instances
Say
data SayAttributes Source
Instances
Sms
data SmsAttributes Source
Constructors
| SmsAttributes | |
Fields
| |
Instances