packages feed

twiml (empty) → 0.1.0.0

raw patch · 45 files changed

+2625/−0 lines, 45 filesdep +Cabaldep +basedep +lenssetup-changed

Dependencies added: Cabal, base, lens, network, twiml, xml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Mark Andrus Roberts++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mark Andrus Roberts nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Text/XML/Twiml.hs view
@@ -0,0 +1,43 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE RankNTypes #-}++module Text.XML.Twiml+  ( Response+  , respond+  , module Text.XML.Twiml.Verbs+  , module Text.XML.Twiml.Types+  , module Text.XML.Twiml.Internal+  ) where++import Text.XML.Twiml.Internal+import Text.XML.Twiml.Verbs+import Text.XML.Twiml.Types hiding+  ( Lens+  , Lens'+  , lens+  , (^.)+  , over+  , to'+  , Fix+  , Foldable+  , Base+  , Yes+  , No+  )++{- Twiml Response -}++-- | The root element of Twilio's XML Markup is the @\<Response\>@ element. See+-- <https://www.twilio.com/docs/api/twiml/your_response#response-element>.+newtype Response = Response { fromResponse :: Twiml' Response }++instance Twiml Response Response where+  toTwiml' = fromResponse++instance Show Response where+  show = show . toTwiml'++respond :: Twiml Response t => t -> Response+respond = Response . toTwiml'
+ src/Text/XML/Twiml/Internal.hs view
@@ -0,0 +1,233 @@+{-#LANGUAGE EmptyDataDecls #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE FunctionalDependencies #-}+{-#LANGUAGE GADTs #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE RankNTypes #-}+{-#LANGUAGE TypeFamilies #-}+{-#LANGUAGE UndecidableInstances #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Internal+  ( TwimlF(..)+  , Twiml(..)+  , Twiml'+  ) where++import Text.XML.Twiml.Types++import Data.Maybe (catMaybes, fromMaybe)+import Text.XML.Light++{- TwimlF -}++-- | This is the 'Functor' we use when folding 'Twiml'.+data TwimlF p a where+  EndF      :: TwimlF p a+  SayF      :: SayAttributes+            -> String+            -> a+            -> TwimlF p a+  PlayF     :: PlayAttributes+            -> Maybe URL+            -> a+            -> TwimlF p a+  GatherF   :: (p :/~ Gather')+            => GatherAttributes+            -> Twiml' Gather'+            -> a+            -> TwimlF p a+  RecordF   :: (p :/~ Gather')+            => RecordAttributes+            -> a+            -> TwimlF p a+  SmsF      :: (p :/~ Gather')+            => SmsAttributes+            -> String+            -> a+            -> TwimlF p a+  DialF     :: (p :/~ Gather')+            => DialAttributes+            -> Either DialNoun String+            -> a+            -> TwimlF p a+  EnqueueF  :: (p :/~ Gather')+            => EnqueueAttributes+            -> String+            -> a+            -> TwimlF p a+  LeaveF    :: (p :/~ Gather')+            => TwimlF p a+  HangupF   :: (p :/~ Gather')+            => TwimlF p a+  RedirectF :: (p :/~ Gather')+            => RedirectAttributes+            -> URL+            -> TwimlF p a+  RejectF   :: (p :/~ Gather')+            => RejectAttributes+            -> TwimlF p a+  PauseF    :: PauseAttributes+            -> a+            -> TwimlF p a++instance Functor (TwimlF p) where+  fmap f  EndF             = EndF+  fmap f (SayF      a b c) = SayF      a b $ f c+  fmap f (PlayF     a b c) = PlayF     a b $ f c+  fmap f (GatherF   a b c) = GatherF   a b $ f c+  fmap f (RecordF   a b)   = RecordF   a   $ f b+  fmap f (SmsF      a b c) = SmsF      a b $ f c+  fmap f (DialF     a b c) = DialF     a b $ f c+  fmap f (EnqueueF  a b c) = EnqueueF  a b $ f c+  fmap f  LeaveF           = LeaveF+  fmap f  HangupF          = HangupF+  fmap f (RedirectF a b)   = RedirectF a b+  fmap f (RejectF   a)     = RejectF   a+  fmap f (PauseF    a b)   = PauseF    a   $ f b++type instance Base (Fix (TwimlF p)) = TwimlF p++instance Foldable (Fix (TwimlF p)) where+  project = unFix++{- Twiml -}++type Twiml' p = Fix (TwimlF p)++class Twiml p t | t -> p where+  toTwiml' :: t -> Twiml' p++instance Twiml p (Twiml' p) where+  toTwiml' = id++instance Show (Twiml' p) where+  show twiml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++ (ppElement . unode "Response" $ toXML twiml) ++ "\n"++(&) :: a -> (a -> b) -> b+a & f = f a+{-# INLINE (&) #-}++string :: String -> Content+string str = Text $ CData CDataText str Nothing++showBool :: Bool -> String+showBool True = "true"+showBool False = "false"++showVoice :: Voice -> String+showVoice (Man _) = "man"+showVoice (Woman _) = "woman"+showVoice (Alice _) = "alice"++showLang :: Voice -> Maybe String+showLang (Man lang) = fmap show lang+showLang (Woman lang) = fmap show lang+showLang (Alice lang) = fmap show lang++dialNoun :: Either DialNoun String -> Content+dialNoun (Left (Number a b))+  = Elem $ unode "Number" (string b) & add_attrs (catMaybes+      [ fmap ((Attr $ unqual "sendDigits") . concatMap show) $ numberSendDigits a+      , fmap ((Attr $ unqual "url") . show) $ numberURL a+      , fmap ((Attr $ unqual "method") . show) $ numberMethod a+      ])+dialNoun (Left (Sip a b))+  = Elem $ unode "Sip" (string $ show b) & add_attrs (catMaybes+      [ fmap ((Attr $ unqual "url") . show) $ sipURL a+      , fmap ((Attr $ unqual "method") . show) $ sipMethod a+      ])+dialNoun (Left (Client a b))+  = Elem $ unode "Client" (string b) & add_attrs (catMaybes+      [ fmap ((Attr $ unqual "url") . show) $ clientURL a+      , fmap ((Attr $ unqual "method") . show) $ clientMethod a+      ])+dialNoun (Left (Conference a b))+  = Elem $ unode "Conference" (string b) & add_attrs (catMaybes+      [ fmap ((Attr $ unqual "muted") . showBool) $ conferenceMuted a+      , fmap ((Attr $ unqual "beep") . show) $ conferenceBeep a+      , fmap ((Attr $ unqual "startConferenceOnEnter") . showBool) $ conferenceStartOnEnter a+      , fmap ((Attr $ unqual "endConferenceOnExit") . showBool) $ conferenceEndOnExit a+      , fmap ((Attr $ unqual "waitUrl") . show) $ conferenceWaitURL a+      , fmap ((Attr $ unqual "waitMethod") . show) $ conferenceWaitMethod a+      , fmap ((Attr $ unqual "maxParticipants") . show) $ conferenceMaxParticipants a+      ])+dialNoun (Left (Queue a b))+  = Elem $ unode "Queue" (string b) & add_attrs (catMaybes+      [ fmap ((Attr $ unqual "url") . show) $ queueURL a+      , fmap ((Attr $ unqual "method") . show) $ queueMethod a+      ])+dialNoun (Right str) = string str++toXML :: Twiml' p -> [Element]+toXML = cata go where+  go EndF = []+  go (SayF a b c) = unode "Say" (string b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "voice") . showVoice) $ sayVoice a+    , fmap ((Attr $ unqual "loop") . show) $ sayLoop a+    , fmap (Attr $ unqual "language") $ (sayVoice a >>= showLang)+    ]) : c+  go (PlayF a b c) = (fromMaybe (unode "Play" ()) (fmap (unode "Play" . string . show) b))+      & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "loop") . show) $ playLoop a+    , fmap ((Attr $ unqual "digits") . concatMap show) $ playDigits a+    ]) : c+  go (GatherF a b c) = unode "Gather" (toXML b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "action") . show) $ gatherAction a+    , fmap ((Attr $ unqual "method") . show) $ gatherMethod a+    , fmap ((Attr $ unqual "timeout") . show) $ gatherTimeout a+    , fmap ((Attr $ unqual "finishOnKey") . show) $ gatherFinishOnKey a+    , fmap ((Attr $ unqual "numDigits") . show) $ gatherNumDigits a+    ]) : c+  go (RecordF a b) = unode "Record" () & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "action") . show) $ recordAction a+    , fmap ((Attr $ unqual "method") . show) $ recordMethod a+    , fmap ((Attr $ unqual "timeout") . show) $ recordTimeout a+    , fmap ((Attr $ unqual "finishOnKey") . show) $ recordFinishOnKey a+    , fmap ((Attr $ unqual "maxLength") . show) $ recordMaxLength a+    , fmap ((Attr $ unqual "transcribe") . showBool) $ recordTranscribe a+    , fmap ((Attr $ unqual "transcribeCallback") . show) $ recordTranscribeCallback a+    , fmap ((Attr $ unqual "playBeep") . show) $ recordPlayBeep a+    ]) : b+  go (SmsF a b c) = unode "Sms" (string b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "to") . show) $ smsTo a+    , fmap ((Attr $ unqual "from") . show) $ smsFrom a+    , fmap ((Attr $ unqual "action") . show) $ smsAction a+    , fmap ((Attr $ unqual "method") . show) $ smsMethod a+    , fmap ((Attr $ unqual "statusCallback") . show) $ smsStatusCallback a+    ]) : c+  go (DialF a b c) = unode "Dial" (dialNoun b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "action") . show) $ dialAction a+    , fmap ((Attr $ unqual "method") . show) $ dialMethod a+    , fmap ((Attr $ unqual "timeout") . show) $ dialTimeout a+    , fmap ((Attr $ unqual "hangupOnStar") . showBool) $ dialHangupOnStar a+    , fmap ((Attr $ unqual "timeLimit") . show) $ dialTimeLimit a+    , fmap (Attr $ unqual "callerId") $ dialCallerId a+    , fmap ((Attr $ unqual "record") . showBool) $ dialRecord a+    ]) : c+  go (EnqueueF a b c) = unode "Enqueue" (string b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "action") . show) $ enqueueAction a+    , fmap ((Attr $ unqual "method") . show) $ enqueueMethod a+    , fmap ((Attr $ unqual "waitUrl") . show) $ enqueueWaitURL a+    , fmap ((Attr $ unqual "waitUrlMethod") . show) $ enqueueWaitURLMethod a+    ]) : c+  go LeaveF = [unode "Leave" ()]+  go HangupF = [unode "Hangup" ()]+  go (RedirectF a b) = [unode "Redirect" (string $ show b) & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "method") . show) $ redirectMethod a+    ])]+  go (RejectF a) = [unode "Reject" () & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "reason") . show) $ rejectReason a+    ])]+  go (PauseF a b) = unode "Pause" () & add_attrs (catMaybes+    [ fmap ((Attr $ unqual "length") . show) $ pauseLength a+    ]) : b++{- Twiml Attributes -}++-- FIXME: Rename `PlayKey`.++number :: String -> Maybe DialNoun+number = Just . Number defaultNumberAttributes+
+ src/Text/XML/Twiml/Types.hs view
@@ -0,0 +1,687 @@+{-#LANGUAGE EmptyDataDecls #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE EmptyDataDecls #-}+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE FunctionalDependencies #-}+{-#LANGUAGE GADTs #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE RankNTypes #-}+{-#LANGUAGE TypeFamilies #-}+{-#LANGUAGE TypeOperators #-}+{-#LANGUAGE UndecidableInstances #-}++module Text.XML.Twiml.Types+  ( Natural+  , URL+  , parseURL+  , Method(..)+  , Key(..)+  , Digit(..)+    -- * @\<Say\>@+  , SayAttributes(..)+  , defaultSayAttributes+  , Voice(..)+  , Lang(..)+  , LangAlice(..)+    -- * @\<Play\>@+  , PlayAttributes(..)+  , defaultPlayAttributes+    -- * @\<Gather\>@+  , GatherAttributes(..)+  , defaultGatherAttributes+  , Gather'+    -- * @\<Record\>@+  , RecordAttributes(..)+  , defaultRecordAttributes+    -- * @\<Sms\>@+  , SmsAttributes(..)+  , defaultSmsAttributes+    -- * @\<Dial\>@+  , DialAttributes(..)+  , defaultDialAttributes+  , DialNoun(..)+    -- ** @\<Number\>@+  , NumberAttributes(..)+  , defaultNumberAttributes+    -- ** @\<Sip\>@+  , SipAttributes(..)+  , defaultSipAttributes+  , Transport(..)+    -- ** @\<Client\>@+  , ClientAttributes(..)+  , defaultClientAttributes+    -- ** @\<Conference\>@+  , ConferenceAttributes(..)+  , defaultConferenceAttributes+  , ConferenceBeep(..)+    -- ** @\<Queue\>@+  , QueueAttributes(..)+  , defaultQueueAttributes+    -- * @\<Enqueue\>@+  , EnqueueAttributes(..)+  , defaultEnqueueAttributes+    -- * @\<Redirect\>@+  , RedirectAttributes(..)+  , defaultRedirectAttributes+    -- * @\<Reject\>@+  , RejectAttributes(..)+  , defaultRejectAttributes+  , Reason(..)+    -- * @\<Pause\>@+  , PauseAttributes(..)+  , defaultPauseAttributes+    -- * Lens Classes+  , HasLoop(..)+  , HasAction(..)+  , HasMethod(..)+  , HasTimeout(..)+  , HasFinishOnKey(..)+  -- * Internal+    -- ** Lens+    -- $lens+  , Lens+  , Lens'+  , lens+  , (^.)+  , over+  , to'+    -- ** Fix & Foldable+    -- $fix+  , Fix(..)+  , Foldable(..)+  , Base(..)+    -- ** Type Inequality+    -- $type+  , (:/~)+  , Yes+  , No+  ) where++import Network.URI (URI(..), parseURIReference)+import Unsafe.Coerce (unsafeCoerce)++{- Attributes -}++-- | See <https://www.twilio.com/docs/api/twiml/say#attributes>.+data SayAttributes = SayAttributes+  { sayVoice :: Maybe Voice+  , sayLoop  :: Maybe Natural+  }++defaultSayAttributes :: SayAttributes+defaultSayAttributes = SayAttributes+  { sayVoice = Nothing+  , sayLoop  = Nothing+  }++-- | Voices supported by @\<Say\>@. See+-- <https://www.twilio.com/docs/api/twiml/say#attributes-voice>.+data Voice+  = Man   (Maybe Lang)+  | Woman (Maybe Lang)+  | Alice (Maybe LangAlice)++-- | Languages spoken by voices 'Man' and 'Woman'. See+-- <https://www.twilio.com/docs/api/twiml/say#attributes-manwoman>.+data Lang+  = English+  | EnglishUK+  | Spanish+  | French+  | German+  | Italian++instance Show Lang where+  show English   = "en"+  show EnglishUK = "en-gb"+  show Spanish   = "es"+  show French    = "fr"+  show German    = "de"+  show Italian   = "it"++-- | Languages spoken by 'Alice'. See+-- <https://www.twilio.com/docs/api/twiml/say#attributes-alice>.+data LangAlice+  = DaDK -- ^ Danish, Denmark+  | DeDE -- ^ German, Germany+  | EnAU -- ^ English, Australia+  | EnCA -- ^ English, Canada+  | EnGB -- ^ English, UK+  | EnIN -- ^ English, India+  | EnUS -- ^ English, United States+  | CaES -- ^ Catalan, Spain+  | EsES -- ^ Spanish, Spain+  | EsMX -- ^ Spanish, Mexico+  | FiFI -- ^ Finnish, Finland+  | FrCA -- ^ French, Canada+  | FrFR -- ^ French, France+  | ItIT -- ^ Italian, Italy+  | JaJP -- ^ Japanese, Japan+  | KoKR -- ^ Korean, Korea+  | NbNO -- ^ Norwegian, Norway+  | NlNL -- ^ Dutch, Netherlands+  | PlPL -- ^ Polish-Poland+  | PtBR -- ^ Portuguese, Brazil+  | PtPT -- ^ Portuguese, Portugal+  | RuRU -- ^ Russian, Russia+  | SvSE -- ^ Swedish, Sweden+  | ZhCN -- ^ Chinese (Mandarin)+  | ZhHK -- ^ Chinese (Cantonese)+  | ZhTW -- ^ Chinese (Taiwanese Mandarin)++instance Show LangAlice where+  show DaDK = "da-DK"+  show DeDE = "de-DE"+  show EnAU = "en-AU"+  show EnCA = "en-CA"+  show EnGB = "en-GB"+  show EnIN = "en-IN"+  show EnUS = "en-US"+  show CaES = "ca-ES"+  show EsES = "es-ES"+  show EsMX = "es-MX"+  show FiFI = "fi-FI"+  show FrCA = "fr-CA"+  show FrFR = "fr-FR"+  show ItIT = "it-IT"+  show JaJP = "ja-JP"+  show KoKR = "ko-KR"+  show NbNO = "nb-NO"+  show NlNL = "nl-NL"+  show PlPL = "pl-PL"+  show PtBR = "pt-BR"+  show PtPT = "pt-PT"+  show RuRU = "ru-RU"+  show SvSE = "sv-SE"+  show ZhCN = "zh-CN"+  show ZhHK = "zh-HK"+  show ZhTW = "zh-TW"++-- | See <https://www.twilio.com/docs/api/twiml/play#attributes>.+data PlayAttributes = PlayAttributes+  { playLoop   :: Maybe Natural+  , playDigits :: Maybe [Digit]+  }++defaultPlayAttributes :: PlayAttributes+defaultPlayAttributes = PlayAttributes+  { playLoop   = Nothing+  , playDigits = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/gather#attributes>.+data GatherAttributes = GatherAttributes+  { gatherAction      :: Maybe URL+  , gatherMethod      :: Maybe Method+  , gatherTimeout     :: Maybe Natural+  , gatherFinishOnKey :: Maybe Key+  , gatherNumDigits   :: Maybe Natural+  }++defaultGatherAttributes :: GatherAttributes+defaultGatherAttributes = GatherAttributes+  { gatherAction      = Nothing+  , gatherMethod      = Nothing+  , gatherTimeout     = Nothing+  , gatherFinishOnKey = Nothing+  , gatherNumDigits   = Nothing+  }++-- | For some @Twiml p t@, the constraint @(p ':/~' 'Gather'')@ lets us enforce+-- TwiML nesting rules.+data Gather'++-- | See <https://www.twilio.com/docs/api/twiml/record#attributes>.+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+  }++defaultRecordAttributes :: RecordAttributes+defaultRecordAttributes = RecordAttributes+  { recordAction             = Nothing+  , recordMethod             = Nothing+  , recordTimeout            = Nothing+  , recordFinishOnKey        = Nothing+  , recordMaxLength          = Nothing+  , recordTranscribe         = Nothing+  , recordTranscribeCallback = Nothing+  , recordPlayBeep           = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/sms#attributes>.+data SmsAttributes = SmsAttributes+  { smsTo             :: Maybe String+  , smsFrom           :: Maybe String+  , smsAction         :: Maybe URL+  , smsMethod         :: Maybe Method+  , smsStatusCallback :: Maybe URL+  }++defaultSmsAttributes :: SmsAttributes+defaultSmsAttributes = SmsAttributes+  { smsTo             = Nothing+  , smsFrom           = Nothing+  , smsAction         = Nothing+  , smsMethod         = Nothing+  , smsStatusCallback = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/dial#attributes>.+data DialAttributes = DialAttributes+  { dialAction       :: Maybe URL+  , dialMethod       :: Maybe Method+  , dialTimeout      :: Maybe Natural+  , dialHangupOnStar :: Maybe Bool+  , dialTimeLimit    :: Maybe Natural+  , dialCallerId     :: Maybe String+  , dialRecord       :: Maybe Bool+  }++defaultDialAttributes :: DialAttributes+defaultDialAttributes = DialAttributes+  { dialAction       = Nothing+  , dialMethod       = Nothing+  , dialTimeout      = Nothing+  , dialHangupOnStar = Nothing+  , dialTimeLimit    = Nothing+  , dialCallerId     = Nothing+  , dialRecord       = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/number#attributes>.+data NumberAttributes = NumberAttributes+  { numberSendDigits :: Maybe [Digit]+  , numberURL        :: Maybe URL+  , numberMethod     :: Maybe Method+  }++defaultNumberAttributes :: NumberAttributes+defaultNumberAttributes = NumberAttributes+  { numberSendDigits = Nothing+  , numberURL        = Nothing+  , numberMethod     = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/sip#attributes>.+data SipAttributes = SipAttributes+  { sipUsername  :: Maybe String+  , sipPassword  :: Maybe String+  , sipTransport :: Maybe Transport+  , sipHeaders   :: Maybe String    -- NOTE: Under 1024 characters.+  , sipURL       :: Maybe URL+  , sipMethod    :: Maybe Method+  }++defaultSipAttributes :: SipAttributes+defaultSipAttributes = SipAttributes+  { sipUsername  = Nothing+  , sipPassword  = Nothing+  , sipTransport = Nothing+  , sipHeaders   = Nothing+  , sipURL       = Nothing+  , sipMethod    = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/sip#transport>.+data Transport = TCP | UDP+  deriving Show++-- | See <https://www.twilio.com/docs/api/twiml/client#attributes>.+data ClientAttributes = ClientAttributes+  { clientURL    :: Maybe URL+  , clientMethod :: Maybe Method+  }++defaultClientAttributes :: ClientAttributes+defaultClientAttributes = ClientAttributes+  { clientURL    = Nothing+  , clientMethod = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/conference#attributes>.+data ConferenceAttributes = ConferenceAttributes+  { conferenceMuted           :: Maybe Bool+  , conferenceBeep            :: Maybe Bool+  , conferenceStartOnEnter    :: Maybe Bool+  , conferenceEndOnExit       :: Maybe Bool+  , conferenceWaitURL         :: Maybe URL+  , conferenceWaitMethod      :: Maybe Method+  , conferenceMaxParticipants :: Maybe Natural -- FIXME: Non-zero, less than 40.+  }++defaultConferenceAttributes :: ConferenceAttributes+defaultConferenceAttributes = ConferenceAttributes+  { conferenceMuted           = Nothing+  , conferenceBeep            = Nothing+  , conferenceStartOnEnter    = Nothing+  , conferenceEndOnExit       = Nothing+  , conferenceWaitURL         = Nothing+  , conferenceWaitMethod      = Nothing+  , conferenceMaxParticipants = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/conference#attributes-beep>.+data ConferenceBeep+  = Yes+  | No+  | OnExit+  | OnEnter++instance Show ConferenceBeep where+  show Yes     = "yes"+  show No      = "no"+  show OnExit  = "onExit"+  show OnEnter = "onEnter"++-- | See <https://www.twilio.com/docs/api/twiml/queue#attributes>.+data QueueAttributes = QueueAttributes+  { queueURL    :: Maybe URL+  , queueMethod :: Maybe Method+  }++defaultQueueAttributes :: QueueAttributes+defaultQueueAttributes = QueueAttributes+  { queueURL    = Nothing+  , queueMethod = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/dial#nouns>.+data DialNoun+  = Number     NumberAttributes     String+  | Sip        SipAttributes        URL    -- NOTE: URL must be under 255 characters.+  | Client     ClientAttributes     String+  | Conference ConferenceAttributes String+  | Queue      QueueAttributes      String++-- | See <https://www.twilio.com/docs/api/twiml/enqueue#attributes>.+data EnqueueAttributes = EnqueueAttributes+  { enqueueAction        :: Maybe URL+  , enqueueMethod        :: Maybe Method+  , enqueueWaitURL       :: Maybe URL+  , enqueueWaitURLMethod :: Maybe Method+  }++defaultEnqueueAttributes :: EnqueueAttributes+defaultEnqueueAttributes = EnqueueAttributes+  { enqueueAction        = Nothing+  , enqueueMethod        = Nothing+  , enqueueWaitURL       = Nothing+  , enqueueWaitURLMethod = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/redirect#attributes>.+data RedirectAttributes = RedirectAttributes+  { redirectMethod :: Maybe Method+  }++defaultRedirectAttributes :: RedirectAttributes+defaultRedirectAttributes = RedirectAttributes+  { redirectMethod = Nothing+  }++-- | See <https://www.twilio.com/docs/api/twiml/reject#attributes>.+data RejectAttributes = RejectAttributes+  { rejectReason :: Maybe Reason+  }++defaultRejectAttributes :: RejectAttributes+defaultRejectAttributes = RejectAttributes+  { rejectReason = Nothing+  }++-- | The reason attribute takes the values \"rejected\" and \"busy.\" This tells+-- Twilio what message to play when rejecting a call. Selecting \"busy\" will+-- play a busy signal to the caller, while selecting \"rejected\" will play a+-- standard not-in-service response.+-- See <https://www.twilio.com/docs/api/twiml/reject#attributes-reason>.+data Reason = Rejected | Busy++instance Show Reason where+  show Rejected = "rejected"+  show Busy     = "busy"++-- | See <https://www.twilio.com/docs/api/twiml/pause#attributes>.+data PauseAttributes = PauseAttributes+  { pauseLength :: Maybe Natural+  }++defaultPauseAttributes :: PauseAttributes+defaultPauseAttributes = PauseAttributes+  { pauseLength = Nothing+  }++{- Attribute Lens Classes -}++class HasLoop t where+  loop :: Lens t t (Maybe Natural) Natural++class HasAction t where+  action :: Lens t t (Maybe URL) URL++class HasMethod t where+  method :: Lens t t (Maybe Method) Method++class HasTimeout t where+  timeout :: Lens t t (Maybe Natural) Natural++class HasFinishOnKey t where+  finishOnKey :: Lens t t (Maybe Key) Key++{- URL, Method & Transport -}++data URL = URL { getURL :: String }++instance Show URL where+  show = getURL++-- | Checks whether a @URI@'s scheme, if any, is one of @"http:"@ or @"https:"@.+isHttp :: URI -> Bool+isHttp uri = case uriScheme uri of+  ""       -> True+  "http:"  -> True+  "https:" -> True+  _        -> False++parseURL :: String -> Maybe URL+parseURL url = parseURIReference url+           >>= (\uri -> if isHttp uri then Just (URL url) else Nothing)++data Method = GET | POST+  deriving Show++type Natural = Int++{- Twiml Datatypes -}++data Key+  = K0      -- ^ 0+  | K1      -- ^ 1+  | K2      -- ^ 2+  | K3      -- ^ 3+  | K4      -- ^ 4+  | K5      -- ^ 5+  | K6      -- ^ 6+  | K7      -- ^ 7+  | K8      -- ^ 8+  | K9      -- ^ 9+  | KStar   -- ^ \*+  | KPound  -- ^ #++instance Show Key where+  show K0     = "0"+  show K1     = "1"+  show K2     = "2"+  show K3     = "3"+  show K4     = "4"+  show K5     = "5"+  show K6     = "6"+  show K7     = "7"+  show K8     = "8"+  show K9     = "9"+  show KStar  = "*"+  show KPound = "#"++{- Voices & Languages -}++data GatherNoun++-- | The ‘digits’ attribute lets you play DTMF tones during a call. See+-- <https://www.twilio.com/docs/api/twiml/play#attributes-digits>.+data Digit+  = D0 -- ^ 0+  | D1 -- ^ 1+  | D2 -- ^ 2+  | D3 -- ^ 3+  | D4 -- ^ 4+  | D5 -- ^ 5+  | D6 -- ^ 6+  | D7 -- ^ 7+  | D8 -- ^ 8+  | D9 -- ^ 9+  | W  -- ^ w++instance Show Digit where+  show D0 = "0"+  show D1 = "1"+  show D2 = "2"+  show D3 = "3"+  show D4 = "4"+  show D5 = "5"+  show D6 = "6"+  show D7 = "7"+  show D8 = "8"+  show D9 = "9"+  show W  = "w"++{- Basic Lens Functionality -}++-- $lens The following section extracts a number of definitions required to get+-- lenses, as defined in the lens package, working, without relying on the lens+-- package itself. Rather than use the following functions, consider installing+-- lens. See <https://hackage.haskell.org/package/lens>.++-- The following definitions were extracted from the lens package.++type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = fmap (sbt s) $ afb (sa s)+{-# INLINE lens #-}++type Lens' s a = Lens s s a a++newtype Accessor r a = Accessor { runAccessor :: r }++instance Functor (Accessor r) where+  fmap _ (Accessor m) = Accessor m+  {-# INLINE fmap #-}++instance Contravariant (Accessor r) where+  contramap _ (Accessor m) = Accessor m+  {-# INLINE contramap #-}++type Getting r s a = (a -> Accessor r a) -> s -> Accessor r s++infixl 8 ^.++(^.) :: s -> Getting a s a -> a+s ^. l = runAccessor (l Accessor s)+{-# INLINE (^.) #-}++type Setting p s t a b = p a (Mutator b) -> s -> Mutator t++newtype Mutator a = Mutator { runMutator :: a }++instance Functor Mutator where+  fmap f (Mutator a) = Mutator $ f a+  {-# INLINE fmap #-}++over :: Profunctor p => Setting p s t a b -> p a b -> s -> t+over l f = runMutator #. l (Mutator #. f)++type IndexPreservingGetter s a+  = forall p f. (Profunctor p, Contravariant f, Functor f) => p a (f a) -> p s (f s)++to' :: (s -> a) -> IndexPreservingGetter s a+to' f = dimap f coerce+{-# INLINE to' #-}++coerce :: (Contravariant f, Functor f) => f a -> f b+coerce a = fmap absurd $ contramap absurd a++-- The following definition was extracted from the contravariant package.++class Contravariant f where+  contramap :: (a -> b) -> f b -> f a++-- The following definitions were extracted from the void package.++newtype Void = Void Void++absurd :: Void -> a+absurd (Void a) = absurd a++-- The following definitions were extracted from the profunctors package.++class Profunctor h where+  lmap :: (a -> b) -> h b c -> h a c+  rmap :: (b -> c) -> h a b -> h a c+  dimap :: (a -> b) -> (c -> d) -> h b c -> h a d+  dimap f g = lmap f . rmap g+  (#.) :: (b -> c) -> h a b -> h a c+  (#.) = \f -> \p -> p `seq` rmap f p++instance Profunctor (->) where+  dimap ab cd bc = cd . bc . ab+  {-# INLINE dimap #-}+  lmap = flip (.)+  {-# INLINE lmap #-}+  rmap = (.)+  {-# INLINE rmap #-}+  (#.) _ = unsafeCoerce+  {-# INLINE (#.) #-}++{- Fix & Foldable -}++-- $fix The following definitions were extracted from the recursion-schemes+-- package. See <https://hackage.haskell.org/package/recursion-schemes>.++newtype Fix f = Fix { unFix :: f (Fix f) }++type family Base t :: * -> *++class Functor (Base t) => Foldable t where+  project :: t -> Base t t+  cata :: (Base t a -> a) -> t -> a+  cata f = c where c = f . fmap c . project++{- Type Inequality -}++-- $type The following defines ':/~' to mean inequality at the type level.+-- Borrowed from HList. See <http://okmij.org/ftp/Haskell/typeEQ.html>.++data Yes++data No++class TypeCast a b | a -> b++instance TypeCast a a++class TypeEq a b c | a b -> c++instance TypeEq x x Yes++instance TypeCast No b => TypeEq x y b++class TypeEq x y No => (:/~) x y++instance TypeEq x y No => (:/~) x y
+ src/Text/XML/Twiml/Verbs.hs view
@@ -0,0 +1,47 @@+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE RankNTypes #-}++module Text.XML.Twiml.Verbs+  ( -- * Verbs+    module Text.XML.Twiml.Verbs.End+    -- ** Primary+  , module Text.XML.Twiml.Verbs.Say+  , module Text.XML.Twiml.Verbs.Play+  , module Text.XML.Twiml.Verbs.Gather+  , module Text.XML.Twiml.Verbs.Record+  , module Text.XML.Twiml.Verbs.Sms+  , module Text.XML.Twiml.Verbs.Dial+    -- ** Secondary+  , module Text.XML.Twiml.Verbs.Enqueue+  , module Text.XML.Twiml.Verbs.Leave+  , module Text.XML.Twiml.Verbs.Hangup+  , module Text.XML.Twiml.Verbs.Redirect+  , module Text.XML.Twiml.Verbs.Reject+  , module Text.XML.Twiml.Verbs.Pause+  ) where++import Text.XML.Twiml.Verbs.End++import Text.XML.Twiml.Verbs.Say+import Text.XML.Twiml.Verbs.Play+import Text.XML.Twiml.Verbs.Gather+import Text.XML.Twiml.Verbs.Record+import Text.XML.Twiml.Verbs.Sms+import Text.XML.Twiml.Verbs.Dial++import Text.XML.Twiml.Verbs.Enqueue+import Text.XML.Twiml.Verbs.Leave+import Text.XML.Twiml.Verbs.Hangup+import Text.XML.Twiml.Verbs.Redirect+import Text.XML.Twiml.Verbs.Reject+import Text.XML.Twiml.Verbs.Pause++import Text.XML.Twiml.Types (URL(..), Method(..), Key(..), Natural)+-- import Text.XML.Twiml.Internal (Twiml, setSayLoop, sayLoop, setPlayLoop, playLoop, gatherAction, setGatherAction, recordAction, setRecordAction, smsAction, setSmsAction, dialAction, setDialAction, gatherMethod, setGatherMethod, recordMethod, setRecordMethod, smsMethod, setSmsMethod, dialMethod, setDialMethod, redirectMethod, setRedirectMethod, gatherTimeout, setGatherTimeout, recordTimeout, setRecordTimeout, dialTimeout, setDialTimeout, gatherFinishOnKey, setGatherFinishOnKey, recordFinishOnKey, setRecordFinishOnKey)+import Text.XML.Twiml.Internal++{- Lenses -}++-- $lenses The following classes and lenses abstract over attributes shared by+-- two or more TwiML verbs.+--
+ src/Text/XML/Twiml/Verbs/Dial.hs view
@@ -0,0 +1,141 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Dial+  ( -- * @\<Dial\>@+    -- $dial+    Dial+    -- ** Constructors+  , dial+  , dial'+    -- ** Attributes+  , DialAttributes(..)+  , defaultDialAttributes+    -- *** Lenses+  , dialAttributes+  , hangupOnStar+  , timeLimit+  , callerId+  , recordDial+  , action+  , method+  , timeout+    -- ** Dial Nouns+  , DialNoun(..)+    -- *** @\<Number\>@+  , NumberAttributes(..)+  , defaultNumberAttributes+    -- *** @\<Sip\>@+  , SipAttributes(..)+  , defaultSipAttributes+    -- *** @\<Client\>@+  , ClientAttributes(..)+  , defaultClientAttributes+    -- *** @\<Conference\>@+  , ConferenceAttributes(..)+  , defaultConferenceAttributes+    -- *** @\<Queue\>@+  , QueueAttributes(..)+  , defaultQueueAttributes+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $dial This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (dial (Right \"415-123-4567\") \<&\> timeout .~ 10+                                 \<&\> record  .~ True)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Dial timeout=\"10\" record=\"true\"\>415-123-4567\<\/Dial\>+\<\/Response\>+@+-}++newtype Dial p = Dial { fromDial :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Dial p) where toTwiml' = fromDial++dial :: (Twiml p t, p :/~ Gather') => Either DialNoun String -> t -> Dial p+dial = dial' defaultDialAttributes++dial' :: (Twiml p t, p :/~ Gather')+      => DialAttributes -> Either DialNoun String -> t -> Dial p+dial' attrs n = Dial . Fix . DialF attrs n . toTwiml'++dialAttributes :: Lens' (Dial p) DialAttributes+dialAttributes = lens+  (\(Dial (Fix (DialF attributes _ _))) -> attributes)+  (\(Dial (Fix (DialF _          n a)))    attributes ->+     Dial (Fix (DialF attributes n a)))++setDialAction :: DialAttributes -> URL -> DialAttributes+setDialAction attrs action = attrs { dialAction = Just action }++setDialMethod :: DialAttributes -> Method -> DialAttributes+setDialMethod attrs method = attrs { dialMethod = Just method }++setDialTimeout :: DialAttributes -> Natural -> DialAttributes+setDialTimeout attrs timeout = attrs { dialTimeout = Just timeout }++setDialHangupOnStar :: DialAttributes -> Bool -> DialAttributes+setDialHangupOnStar attrs hangupOnStar+  = attrs { dialHangupOnStar = Just hangupOnStar }++setDialTimeLimit :: DialAttributes -> Natural -> DialAttributes+setDialTimeLimit attrs timeLimit = attrs { dialTimeLimit = Just timeLimit }++setDialCallerId :: DialAttributes -> String -> DialAttributes+setDialCallerId attrs callerId = attrs { dialCallerId = Just callerId }++setDialRecord :: DialAttributes -> Bool -> DialAttributes+setDialRecord attrs record = attrs { dialRecord = Just record }++hangupOnStar :: Lens (Dial p) (Dial p) (Maybe Bool) Bool+hangupOnStar = lens (^. dialAttributes . to' dialHangupOnStar)+  (\t v -> over dialAttributes (flip setDialHangupOnStar v) t)++timeLimit :: Lens (Dial p) (Dial p) (Maybe Natural) Natural+timeLimit = lens (^. dialAttributes . to' dialTimeLimit)+  (\t v -> over dialAttributes (flip setDialTimeLimit v) t)++callerId :: Lens (Dial p) (Dial p) (Maybe String) String+callerId = lens (^. dialAttributes . to' dialCallerId)+  (\t v -> over dialAttributes (flip setDialCallerId v) t)++recordDial :: Lens (Dial p) (Dial p) (Maybe Bool) Bool+recordDial = lens (^. dialAttributes . to' dialRecord)+  (\t v -> over dialAttributes (flip setDialRecord v) t)++instance HasAction (Dial p) where+  action = lens getAction setAction where+    getAction = (^. dialAttributes . to' dialAction)+    setAction t v = over dialAttributes (flip setDialAction v) t++instance HasMethod (Dial p) where+  method = lens getMethod setMethod where+    getMethod = (^. dialAttributes . to' dialMethod)+    setMethod t v = over dialAttributes (flip setDialMethod v) t++instance HasTimeout (Dial p) where+  timeout = lens getTimeout setTimeout where+    getTimeout = (^. dialAttributes . to' dialTimeout)+    setTimeout t v = over dialAttributes (flip setDialTimeout v) t++
+ src/Text/XML/Twiml/Verbs/End.hs view
@@ -0,0 +1,40 @@+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}++module Text.XML.Twiml.Verbs.End+  ( -- * End+    -- $end+    End+    -- ** Constructor+  , end+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $end 'End' is not actually a TwiML verb, but this library uses it to+terminate 'Twiml'. This example++@+module Example where++import Text.XML.Twiml++example+  = respond+  $ end+@++produces the following empty TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response \/\>+@+-}++newtype End p = End { fromEnd :: Twiml' p }+instance Twiml p (End p) where toTwiml' = fromEnd++end :: End p+end = End . Fix $ EndF
+ src/Text/XML/Twiml/Verbs/Enqueue.hs view
@@ -0,0 +1,95 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Enqueue+  ( -- * @\<Enqueue\>@+    -- $enqueue+    Enqueue+    -- ** Constructors+  , enqueue+  , enqueue'+    -- ** Attributes+  , EnqueueAttributes(..)+  , defaultEnqueueAttributes+    -- *** Lenses+  , enqueueAttributes+  , action+  , method+  , waitURL+  , waitURLMethod+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $enqueue This example++@+module Example where++import Control.Lens+import Data.Maybe (fromJust)+import Text.XML.Twiml++example+  = respond+  . (enqueue \"support\" \<&\> waitURL .~ (fromJust $ parseURL \"wait-music.xml\"))+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Enqueue waitUrl=\"wait-music.xml\"\>support\<\/Enqueue\>+\<\/Response\>+@+-}++newtype Enqueue p = Enqueue { fromEnqueue :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Enqueue  p) where toTwiml' = fromEnqueue++enqueue :: (Twiml p t, p :/~ Gather') => String -> t -> Enqueue p+enqueue name = Enqueue . Fix . EnqueueF defaultEnqueueAttributes name . toTwiml'++enqueue' :: (Twiml p t, p :/~ Gather') => EnqueueAttributes -> String -> t -> Enqueue p+enqueue' attrs name = Enqueue . Fix . EnqueueF attrs name . toTwiml'++enqueueAttributes :: Lens' (Enqueue p) EnqueueAttributes+enqueueAttributes = lens+  (\(Enqueue (Fix (EnqueueF attributes _ _))) -> attributes)+  (\(Enqueue (Fix (EnqueueF _          n a)))    attributes ->+     Enqueue (Fix (EnqueueF attributes n a)))++setEnqueueAction :: EnqueueAttributes -> URL -> EnqueueAttributes+setEnqueueAction attrs action = attrs { enqueueAction = Just action }++setEnqueueMethod :: EnqueueAttributes -> Method -> EnqueueAttributes+setEnqueueMethod attrs method = attrs { enqueueMethod = Just method }++setEnqueueWaitURL :: EnqueueAttributes -> URL -> EnqueueAttributes+setEnqueueWaitURL attrs url = attrs { enqueueWaitURL = Just url }++setEnqueueWaitURLMethod :: EnqueueAttributes -> Method -> EnqueueAttributes+setEnqueueWaitURLMethod attrs meth = attrs { enqueueWaitURLMethod = Just meth }++instance HasAction (Enqueue p) where+  action = lens getAction setAction where+    getAction = (^. enqueueAttributes . to' enqueueAction)+    setAction t v = over enqueueAttributes (flip setEnqueueAction v) t++instance HasMethod (Enqueue p) where+  method = lens getMethod setMethod where+    getMethod = (^. enqueueAttributes . to' enqueueMethod)+    setMethod t v = over enqueueAttributes (flip setEnqueueMethod v) t++waitURL :: Lens (Enqueue p) (Enqueue p) (Maybe URL) URL+waitURL = lens (^. enqueueAttributes . to' enqueueWaitURL)+  (\t v -> over enqueueAttributes (flip setEnqueueWaitURL v) t)++waitURLMethod :: Lens (Enqueue p) (Enqueue p) (Maybe Method) Method+waitURLMethod = lens (^. enqueueAttributes . to' enqueueWaitURLMethod)+  (\t v -> over enqueueAttributes (flip setEnqueueWaitURLMethod v) t)
+ src/Text/XML/Twiml/Verbs/Gather.hs view
@@ -0,0 +1,116 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE RankNTypes #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Gather+  ( -- * @\<Gather\>@+    -- $gather+    Gather+    -- ** Constructors+  , gather+  , gather'+    -- ** Attributes+  , GatherAttributes(..)+  , defaultGatherAttributes+    -- *** Lenses+  , gatherAttributes+  , numDigits+  , action+  , method+  , timeout+  , finishOnKey+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))+import Text.XML.Twiml.Verbs.End++import Unsafe.Coerce (unsafeCoerce)++{- $gather This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (gather \<&\> timeout     .~ 10+            \<&\> finishOnKey .~ KStar+      $ say \"Please enter your pin number and then press star.\"+      $ end)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Gather timeout=\"10\" finishOnKey=\"*\"\>+    \<Say\>Please enter your pin number and then press star.\<\/Say\>+  \<\/Gather\>+\<\/Response\>+@+-}++newtype Gather p = Gather { fromGather :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Gather p) where toTwiml' = fromGather++gather :: (Twiml Gather' n, Twiml p t, p :/~ Gather') => n -> t -> Gather p+gather = gather' defaultGatherAttributes++gather' :: (Twiml Gather' n, Twiml p t, p :/~ Gather')+        => GatherAttributes -> n -> t -> Gather p+gather' attrs n+  = Gather . Fix . GatherF attrs (toTwiml' n) . toTwiml'++gatherAttributes :: Lens' (Gather p) GatherAttributes+gatherAttributes = lens+  (\(Gather (Fix (GatherF attributes _ _))) -> attributes)+  (\(Gather (Fix (GatherF _          n a)))    attributes ->+     Gather (Fix (GatherF attributes n a)))++setGatherAction :: GatherAttributes -> URL -> GatherAttributes+setGatherAction attrs action = attrs { gatherAction = Just action }++setGatherMethod :: GatherAttributes -> Method -> GatherAttributes+setGatherMethod attrs method = attrs { gatherMethod = Just method }++setGatherTimeout :: GatherAttributes -> Natural -> GatherAttributes+setGatherTimeout attrs timeout = attrs { gatherTimeout = Just timeout }++setGatherFinishOnKey :: GatherAttributes -> Key -> GatherAttributes+setGatherFinishOnKey attrs finishOnKey+  = attrs { gatherFinishOnKey = Just finishOnKey }++setGatherNumDigits :: GatherAttributes -> Natural -> GatherAttributes+setGatherNumDigits attrs numDigits = attrs { gatherNumDigits = Just numDigits }++numDigits :: Lens (Gather p) (Gather p) (Maybe Natural) Natural+numDigits = lens (^. gatherAttributes . to' gatherNumDigits)+  (\t v -> over gatherAttributes (flip setGatherNumDigits v) t)++instance forall p t. HasAction (t -> Gather p) where+  action = lens getAction setAction where+    getAction f = (^. gatherAttributes . to' gatherAction) (f $ unsafeCoerce end)+    setAction f v = fmap (over gatherAttributes (flip setGatherAction v)) f++instance forall p t. Twiml p t => HasMethod (t -> Gather p) where+  method = lens getMethod setMethod where+    getMethod f = (^. gatherAttributes . to' gatherMethod) (f $ unsafeCoerce end)+    setMethod f v = fmap (over gatherAttributes (flip setGatherMethod v)) f++instance forall p t. Twiml p t => HasTimeout (t -> Gather p) where+  timeout = lens getTimeout setTimeout where+    getTimeout f = (^. gatherAttributes . to' gatherTimeout) (f $ unsafeCoerce end)+    setTimeout f v = fmap (over gatherAttributes (flip setGatherTimeout v)) f++instance forall p t. Twiml p t => HasFinishOnKey (t -> Gather p) where+  finishOnKey = lens getFinishOnKey setFinishOnKey where+    getFinishOnKey f = (^. gatherAttributes . to' gatherFinishOnKey) (f $ unsafeCoerce end)+    setFinishOnKey f v = fmap (over gatherAttributes (flip setGatherFinishOnKey v)) f
+ src/Text/XML/Twiml/Verbs/Hangup.hs view
@@ -0,0 +1,45 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Hangup+  ( -- * @\<Hangup\>@+    -- $hangup+    Hangup+    -- ** Constructor+  , hangup+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Verbs.End (End)+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $hangup This example++@+module Example where++import Text.XML.Twiml++example+  = respond+  . hangup+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Hangup \/\>+\<\/Response\>+@+-}++newtype Hangup p = Hangup { fromHangup :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Hangup p) where toTwiml' = fromHangup++hangup :: (p :/~ Gather') => End p -> Hangup p+hangup = const . Hangup $ Fix HangupF
+ src/Text/XML/Twiml/Verbs/Leave.hs view
@@ -0,0 +1,45 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Leave+  ( -- * @\<Leave\>@+    -- $leave+    Leave+    -- ** Constructor+  , leave+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Verbs.End (End)+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $leave This example++@+module Example where++import Text.XML.Twiml++example+  = respond+  . leave+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Leave \/\>+\<\/Response\>+@+-}++newtype Leave p = Leave { fromLeave :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Leave p) where toTwiml' = fromLeave++leave :: (p :/~ Gather') => End p -> Leave p+leave = const . Leave $ Fix LeaveF
+ src/Text/XML/Twiml/Verbs/Pause.hs view
@@ -0,0 +1,71 @@+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}++module Text.XML.Twiml.Verbs.Pause+  ( -- * @\<Pause\>@+    -- $pause+    Pause+    -- ** Constructors+  , pause+  , pause'+    -- ** Attributes+  , PauseAttributes(..)+  , defaultPauseAttributes+    -- *** Lenses+  , pauseAttributes+  , duration+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Verbs.End (End)+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $pause This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . say \"I will pause 10 seconds starting now!\"+  . (pause \<&\> duration .~ 10)+  . say \"I just paused 10 seconds\"+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Say\>I will pause 10 seconds starting now!\<\/Say\>+  \<Pause length=\"10\" \/\>+  \<Say\>I just paused 10 seconds\<\/Say\>+\<\/Response\>+@+-}++newtype Pause p = Pause { fromPause :: Twiml' p }+instance Twiml p (Pause p) where toTwiml' = fromPause++pause :: Twiml p t => t -> Pause p+pause = pause' defaultPauseAttributes++pause' :: Twiml p t => PauseAttributes -> t -> Pause p+pause' attrs = Pause . Fix . PauseF attrs . toTwiml'++pauseAttributes :: Lens' (Pause p) PauseAttributes+pauseAttributes = lens+  (\(Pause (Fix (PauseF attributes _))) -> attributes)+  (\(Pause (Fix (PauseF _          a)))    attributes ->+     Pause (Fix (PauseF attributes a)))++setPauseLength :: PauseAttributes -> Natural -> PauseAttributes+setPauseLength attrs length = attrs { pauseLength = Just length }++duration :: Lens (Pause p) (Pause p) (Maybe Natural) Natural+duration = lens (^. pauseAttributes . to' pauseLength)+  (\t v -> over pauseAttributes (flip setPauseLength v) t)
+ src/Text/XML/Twiml/Verbs/Play.hs view
@@ -0,0 +1,75 @@+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}++module Text.XML.Twiml.Verbs.Play+  ( -- * @\<Play\>@+    -- $play+    Play+    -- ** Constructors+  , play+  , play'+    -- ** Attributes+  , PlayAttributes(..)+  , defaultPlayAttributes+    -- *** Lenses+  , playAttributes+  , digits+  , loop+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $play This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (play (parseURL \"https:\/\/api.twilio.com\/cowbell.mp3\") \<&\> loop .~ 10)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Play loop=\"10\"\>https:\/\/api.twilio.com\/cowbell.mp3\<\/Play\>+\<\/Response\>+@+-}++newtype Play p = Play { fromPlay :: Twiml' p }+instance Twiml p (Play p) where toTwiml' = fromPlay++play :: Twiml p t => Maybe URL -> t -> Play p+play = play' defaultPlayAttributes++play' :: Twiml p t => PlayAttributes -> Maybe URL -> t -> Play p+play' attrs n = Play . Fix . PlayF attrs n . toTwiml'++playAttributes :: Lens' (Play p) PlayAttributes+playAttributes = lens+  (\(Play (Fix (PlayF attributes _ _))) -> attributes)+  (\(Play (Fix (PlayF _          n a)))    attributes ->+     Play (Fix (PlayF attributes n a)))++setPlayLoop :: PlayAttributes -> Natural -> PlayAttributes+setPlayLoop attrs loop = attrs { playLoop = Just loop }++setPlayDigits :: PlayAttributes -> [Digit] -> PlayAttributes+setPlayDigits attrs digits = attrs { playDigits = Just digits }++digits :: Lens (Play p) (Play p) (Maybe [Digit]) [Digit]+digits = lens (^. playAttributes . to' playDigits)+  (\t v -> over playAttributes (flip setPlayDigits v) t)++instance HasLoop (Play p) where+  loop = lens getLoop setLoop where+    getLoop = (^. playAttributes . to' playLoop)+    setLoop t v = over playAttributes (flip setPlayLoop v) t
+ src/Text/XML/Twiml/Verbs/Record.hs view
@@ -0,0 +1,133 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Record+  ( -- * @\<Record\>@+    -- $record+    Record+    -- ** Constructors+  , record+  , record'+    -- ** Attributes+  , RecordAttributes(..)+  , defaultRecordAttributes+    -- *** Lenses+  , recordAttributes+  , maxLength+  , transcribe+  , transcribeCallback+  , playBeep+  , action+  , method+  , timeout+  , finishOnKey+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $record This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (record \<&\> timeout    .~ 10+            \<&\> transcribe .~ True)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Record timeout=\"10\" transcribe=\"true\" \/\>+\<\/Response\>+@+-}++newtype Record p = Record { fromRecord :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Record p) where toTwiml' = fromRecord++record :: (Twiml p t, p :/~ Gather') => t -> Record p+record = record' defaultRecordAttributes++record' :: (Twiml p t, p :/~ Gather')+        => RecordAttributes -> t -> Record p+record' attrs+  = Record . Fix . RecordF attrs . toTwiml'++recordAttributes :: Lens' (Record p) RecordAttributes+recordAttributes = lens+  (\(Record (Fix (RecordF attributes _))) -> attributes)+  (\(Record (Fix (RecordF _          a)))    attributes ->+     Record (Fix (RecordF attributes a)))++setRecordAction :: RecordAttributes -> URL -> RecordAttributes+setRecordAction attrs action = attrs { recordAction = Just action }++setRecordMethod :: RecordAttributes -> Method -> RecordAttributes+setRecordMethod attrs method = attrs { recordMethod = Just method }++setRecordTimeout :: RecordAttributes -> Natural -> RecordAttributes+setRecordTimeout attrs timeout = attrs { recordTimeout = Just timeout }++setRecordFinishOnKey :: RecordAttributes -> Key -> RecordAttributes+setRecordFinishOnKey attrs key = attrs { recordFinishOnKey = Just key }++setRecordMaxLength :: RecordAttributes -> Natural -> RecordAttributes+setRecordMaxLength attrs length = attrs { recordMaxLength = Just length }++setRecordTranscribe :: RecordAttributes -> Bool -> RecordAttributes+setRecordTranscribe attrs transcribe+  = attrs { recordTranscribe = Just transcribe }++setRecordTranscribeCallback :: RecordAttributes -> URL -> RecordAttributes+setRecordTranscribeCallback attrs transcribeCallback+  = attrs { recordTranscribeCallback = Just transcribeCallback }++setRecordPlayBeep :: RecordAttributes -> Bool -> RecordAttributes+setRecordPlayBeep attrs playBeep = attrs { recordPlayBeep = Just playBeep }++maxLength :: Lens (Record p) (Record p) (Maybe Natural) Natural+maxLength = lens (^. recordAttributes . to' recordMaxLength)+  (\t v -> over recordAttributes (flip setRecordMaxLength v) t)++transcribe :: Lens (Record p) (Record p) (Maybe Bool) Bool+transcribe = lens (^. recordAttributes . to' recordTranscribe)+  (\t v -> over recordAttributes (flip setRecordTranscribe v) t)++transcribeCallback :: Lens (Record p) (Record p) (Maybe URL) URL+transcribeCallback = lens (^. recordAttributes . to' recordTranscribeCallback)+  (\t v -> over recordAttributes (flip setRecordTranscribeCallback v) t)++playBeep :: Lens (Record p) (Record p) (Maybe Bool) Bool+playBeep = lens (^. recordAttributes . to' recordPlayBeep)+  (\t v -> over recordAttributes (flip setRecordPlayBeep v) t)++instance HasAction (Record p) where+  action = lens getAction setAction where+    getAction = (^. recordAttributes . to' recordAction)+    setAction t v = over recordAttributes (flip setRecordAction v) t++instance HasMethod (Record p) where+  method = lens getMethod setMethod where+    getMethod = (^. recordAttributes . to' recordMethod)+    setMethod t v = over recordAttributes (flip setRecordMethod v) t++instance HasTimeout (Record p) where+  timeout = lens getTimeout setTimeout where+    getTimeout = (^. recordAttributes . to' recordTimeout)+    setTimeout t v = over recordAttributes (flip setRecordTimeout v) t++instance HasFinishOnKey (Record p) where+  finishOnKey = lens getFinishOnKey setFinishOnKey where+    getFinishOnKey = (^. recordAttributes . to' recordFinishOnKey)+    setFinishOnKey t v = over recordAttributes (flip setRecordFinishOnKey v) t
+ src/Text/XML/Twiml/Verbs/Redirect.hs view
@@ -0,0 +1,73 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Redirect+  ( -- * @\<Redirect\>@+    -- $redirect+    Redirect+    -- ** Constructors+  , redirect+  , redirect'+    -- ** Attributes+  , RedirectAttributes(..)+  , defaultRedirectAttributes+    -- *** Lenses+  , redirectAttributes+  , method+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Verbs.End (End)+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $redirect This example++@+module Example where++import Control.Lens+import Data.Maybe (fromJust)+import Text.XML.Twiml++example+  = respond+  . (redirect (fromJust $ parseURL \"http:\/\/pigeons.com\/twiml.xml\") \<&\> method .~ POST)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Redirect method=\"POST\"\>http:\/\/pigeons.com\/twiml.xml\<\/Redirect\>+\<\/Response\>+@+-}++newtype Redirect p = Redirect { fromRedirect :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Redirect p) where toTwiml' = fromRedirect++redirect :: (p :/~ Gather') => URL -> End p -> Redirect p+redirect = redirect' defaultRedirectAttributes++redirect' :: (p :/~ Gather') => RedirectAttributes -> URL -> End p -> Redirect p+redirect' attrs url = const . Redirect . Fix $ RedirectF attrs url++redirectAttributes :: Lens' (Redirect p) RedirectAttributes+redirectAttributes = lens+  (\(Redirect (Fix (RedirectF attributes _))) -> attributes)+  (\(Redirect (Fix (RedirectF _          n)))    attributes ->+     Redirect (Fix (RedirectF attributes n)))++setRedirectMethod :: RedirectAttributes -> Method -> RedirectAttributes+setRedirectMethod attrs method = attrs { redirectMethod = Just method }++instance HasMethod (Redirect p) where+  method = lens getMethod setMethod where+    getMethod = (^. redirectAttributes . to' redirectMethod)+    setMethod t v = over redirectAttributes (flip setRedirectMethod v) t++
+ src/Text/XML/Twiml/Verbs/Reject.hs view
@@ -0,0 +1,70 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Reject+  ( -- * @\<Reject\>@+    -- $reject+    Reject+    -- ** Constructors+  , reject+  , reject'+    -- ** Attributes+  , RejectAttributes(..)+  , defaultRejectAttributes+    -- *** Lenses+  , rejectAttributes+  , reason+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Verbs.End (End)+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $reject This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (reject \<&\> reason .~ Busy)+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Reject reason=\"busy\" \/\>+\<\/Response\>+@+-}++newtype Reject p = Reject { fromReject :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Reject p) where toTwiml' = fromReject++reject :: (p :/~ Gather') => End p -> Reject p+reject = reject' defaultRejectAttributes++reject' :: (p :/~ Gather') => RejectAttributes -> End p -> Reject p+reject' attrs = const . Reject . Fix $ RejectF attrs++rejectAttributes :: Lens' (Reject p) RejectAttributes+rejectAttributes = lens+  (\(Reject (Fix (RejectF attributes))) -> attributes)+  (\(Reject (Fix (RejectF _         )))    attributes ->+     Reject (Fix (RejectF attributes)))++setRejectReason :: RejectAttributes -> Reason -> RejectAttributes+setRejectReason attrs reason = attrs { rejectReason = Just reason }++reason :: Lens (Reject p) (Reject p) (Maybe Reason) Reason+reason = lens (^. rejectAttributes . to' rejectReason)+  (\t v -> over rejectAttributes (flip setRejectReason v) t)+
+ src/Text/XML/Twiml/Verbs/Say.hs view
@@ -0,0 +1,127 @@+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}++module Text.XML.Twiml.Verbs.Say+  ( -- * @\<Say\>@+    -- $say+    Say+    -- ** Constructors+  , say+  , say'+  , sayMan+  , sayMan'+  , sayWoman+  , sayWoman'+  , sayAlice+  , sayAlice'+    -- ** Attributes+  , SayAttributes(..)+  , defaultSayAttributes+    -- *** Lenses+  , sayAttributes+  , voice+  , loop+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $say This example++@+module Example where++import Text.XML.Twiml++example+  = respond+  . sayWoman' French \"Chapeau\"+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Say voice=\"woman\" language=\"fr\"\>Chapeau\<\/Say\>+\<\/Response\>+@+-}++newtype Say p = Say { fromSay :: Twiml' p }+instance Twiml p (Say p) where toTwiml' = fromSay++say :: Twiml p t => String -> t -> Say p+say = say' defaultSayAttributes++say' :: Twiml p t => SayAttributes -> String -> t -> Say p+say' a b = Say . Fix . SayF a b . toTwiml'++sayMan :: Twiml p t => String -> t -> Say p+sayMan = say' (defaultSayAttributes { sayVoice = Just $ Man Nothing })++sayMan' :: Twiml p t => Lang -> String -> t -> Say p+sayMan' lang+  = say' (defaultSayAttributes { sayVoice = Just . Man $ Just lang })++sayWoman :: Twiml p t => String -> t -> Say p+sayWoman = say' (defaultSayAttributes { sayVoice = Just $ Woman Nothing })++sayWoman' :: Twiml p t => Lang -> String -> t -> Say p+sayWoman' lang+  = say' (defaultSayAttributes { sayVoice = Just . Woman $ Just lang })++sayAlice :: Twiml p t => String -> t -> Say p+sayAlice = say' (defaultSayAttributes { sayVoice = Just $ Alice Nothing })++sayAlice' :: Twiml p t => LangAlice -> String -> t -> Say p+sayAlice' lang+  = say' (defaultSayAttributes { sayVoice = Just . Alice $ Just lang })++sayAttributes :: Lens' (Say p) SayAttributes+sayAttributes = lens+  (\(Say (Fix (SayF attributes _ _))) -> attributes)+  (\(Say (Fix (SayF _          n a)))    attributes ->+     Say (Fix (SayF attributes n a)))++{-++setDialAction :: DialAttributes -> URL -> DialAttributes+setDialAction attrs action = attrs { dialAction = Just action }++setDialMethod :: DialAttributes -> Method -> DialAttributes+setDialMethod attrs method = attrs { dialMethod = Just method }++setDialTimeout :: DialAttributes -> Natural -> DialAttributes+setDialTimeout attrs timeout = attrs { dialTimeout = Just timeout }++setDialHangupOnStar :: DialAttributes -> Bool -> DialAttributes+setDialHangupOnStar attrs hangupOnStar+  = attrs { dialHangupOnStar = Just hangupOnStar }++setDialTimeLimit :: DialAttributes -> Natural -> DialAttributes+setDialTimeLimit attrs timeLimit = attrs { dialTimeLimit = Just timeLimit }++setDialCallerId :: DialAttributes -> String -> DialAttributes+setDialCallerId attrs callerId = attrs { dialCallerId = Just callerId }++setDialRecord :: DialAttributes -> Bool -> DialAttributes+setDialRecord attrs record = attrs { dialRecord = Just record }++-}++setSayVoice :: SayAttributes -> Voice -> SayAttributes+setSayVoice attrs voice = attrs { sayVoice = Just voice }++setSayLoop :: SayAttributes -> Natural -> SayAttributes+setSayLoop attrs loop = attrs { sayLoop = Just loop }++voice :: Lens (Say p) (Say p) (Maybe Voice) Voice+voice = lens (^. sayAttributes . to' sayVoice)+  (\t v -> over sayAttributes (flip setSayVoice v) t)++instance HasLoop (Say p) where+  loop = lens getLoop setLoop where+    getLoop = (^. sayAttributes . to' sayLoop)+    setLoop t v = over sayAttributes (flip setSayLoop v) t
+ src/Text/XML/Twiml/Verbs/Sms.hs view
@@ -0,0 +1,104 @@+{-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-}+{-#LANGUAGE TypeOperators #-}++module Text.XML.Twiml.Verbs.Sms+  ( -- * @\<Sms\>@+    -- $sms+    Sms+    -- ** Constructors+  , sms+  , sms'+    -- ** Attributes+  , SmsAttributes(..)+  , defaultSmsAttributes+    -- *** Lenses+  , smsAttributes+  , to+  , from+  , statusCallback+  , action+  , method+  ) where++import Text.XML.Twiml.Types+import Text.XML.Twiml.Internal (Twiml(..), Twiml', TwimlF(..))++{- $sms This example++@+module Example where++import Control.Lens+import Text.XML.Twiml++example+  = respond+  . (sms \"The king stay the king.\" \<&\> to   .~ \"+14105551234\"+                                   \<&\> from .~ \"+14105556789\")+  $ end+@++produces the following TwiML response:++@+\<?xml version=\"1.0\" encoding=\"UTF-8\"?\>+\<Response\>+  \<Sms from=\"+14105551234\" to=\"+14105556789\"\>The king stay the king.\<\/Sms\>+\<\/Response\>+@+-}++newtype Sms p = Sms { fromSms :: Twiml' p }+instance (p :/~ Gather') => Twiml p (Sms p) where toTwiml' = fromSms++sms :: (Twiml p t, p :/~ Gather') => String -> t -> Sms p+sms = sms' defaultSmsAttributes++sms' :: (Twiml p t, p :/~ Gather') => SmsAttributes -> String -> t -> Sms p+sms' attrs n = Sms . Fix . SmsF attrs n . toTwiml'++smsAttributes :: Lens' (Sms p) SmsAttributes+smsAttributes = lens+  (\(Sms (Fix (SmsF attributes _ _))) -> attributes)+  (\(Sms (Fix (SmsF _          n a)))    attributes ->+     Sms (Fix (SmsF attributes n a)))++setSmsTo :: SmsAttributes -> String -> SmsAttributes+setSmsTo attrs to = attrs { smsTo = Just to }++setSmsFrom :: SmsAttributes -> String -> SmsAttributes+setSmsFrom attrs from = attrs { smsFrom = Just from }++setSmsAction :: SmsAttributes -> URL -> SmsAttributes+setSmsAction attrs action = attrs { smsAction = Just action }++setSmsMethod :: SmsAttributes -> Method -> SmsAttributes+setSmsMethod attrs method = attrs { smsMethod = Just method }++setSmsStatusCallback :: SmsAttributes -> URL -> SmsAttributes+setSmsStatusCallback attrs statusCallback+  = attrs { smsStatusCallback = Just statusCallback }++to :: Lens (Sms p) (Sms p) (Maybe String) String+to = lens (^. smsAttributes . to' smsTo)+  (\t v -> over smsAttributes (flip setSmsTo v) t)++from :: Lens (Sms p) (Sms p) (Maybe String) String+from = lens (^. smsAttributes . to' smsFrom)+  (\t v -> over smsAttributes (flip setSmsFrom v) t)++statusCallback :: Lens (Sms p) (Sms p) (Maybe URL) URL+statusCallback = lens (^. smsAttributes . to' smsStatusCallback)+  (\t v -> over smsAttributes (flip setSmsStatusCallback v) t)++instance HasAction (Sms p) where+  action = lens getAction setAction where+    getAction = (^. smsAttributes . to' smsAction)+    setAction t v = over smsAttributes (flip setSmsAction v) t++instance HasMethod (Sms p) where+  method = lens getMethod setMethod where+    getMethod = (^. smsAttributes . to' smsMethod)+    setMethod t v = over smsAttributes (flip setSmsMethod v) t
+ test/Test.hs view
@@ -0,0 +1,264 @@+module Main where++import Text.XML.Twiml++import Data.Functor ((<$>))+import Control.Lens+import Control.Monad (when)+import Data.Maybe (fromJust)+import System.IO++{- Say -}++sayExample1 =+  ( respond+  . say "Hello World"+  $ end+  , "test/xml/sayExample1.xml" )++sayExample2 =+  ( respond+  . (sayAlice' PtBR "Bom dia." <&> loop .~ 2)+  $ end+  , "test/xml/sayExample2.xml" )++sayExamples = [ sayExample1, sayExample2 ]++{- Play -}++playExample1 =+  ( respond+  . play (parseURL "https://api.twilio.com/cowbell.mp3")+  $ end+  , "test/xml/playExample1.xml" )++playExample2 =+  ( respond+  . (play Nothing <&> digits .~ [W, W, W, W, D3])+  $ end+  , "test/xml/playExample2.xml" )++playExamples = [ playExample1, playExample2 ]++{- Gather -}++gatherExample1 =+  ( respond+  . gather end+  $ end+  , "test/xml/gatherExample1.xml" )++-- FIXME: Ugly.+gatherExample2 =+  ( respond+  . (gather <&> action .~ (fromJust $ parseURL "/process_gather.php")+            <&> method .~ GET+      $ say "Please enter your account number, followed by the pound sign"+      $ end)+  . say "We didn't receive any input. Goodbye!"+  $ end+  , "test/xml/gatherExample2.xml" )++gatherExamples = [ gatherExample1, gatherExample2 ]++{- Record -}++recordExample1 =+  ( respond+  . record+  $ end+  , "test/xml/recordExample1.xml" )++recordExample2 =+  ( respond+  . say "Please leave a message at the beep. Press the star key when finished."+  . (record <&> action      .~ (fromJust $ parseURL "http://foo.edu/handleRecording.php")+            <&> method      .~ GET+            <&> maxLength   .~ 20+            <&> finishOnKey .~ KStar)+  . say "I did not receive a recording"+  $ end+  , "test/xml/recordExample2.xml" )++recordExample3 =+  ( respond+  . (record <&> transcribe         .~ True+            <&> transcribeCallback .~ (fromJust $ parseURL "/handle_transcribe.php"))+  $ end+  , "test/xml/recordExample3.xml" )++recordExamples = [ recordExample1, recordExample2, recordExample3 ]++{- Sms -}++smsExample1 =+  ( respond+  . say "Our store is located at 123 Easy St."+  . sms "Store Location: 123 Easy St."+  $ end+  , "test/xml/smsExample1.xml" )++smsExample2 =+  ( respond+  . say "Our store is located at 123 Easy St."+  . (sms "Store Location: 123 Easy St." <&> action .~ (fromJust $ parseURL "/smsHandler.php")+                                        <&> method .~ POST)+  $ end+  , "test/xml/smsExample2.xml" )++smsExample3 =+  ( respond+  . say "Our store is located at 123 Easy St."+  . (sms "Store Location: 123 Easy St." <&> statusCallback .~ (fromJust $ parseURL "/smsHandler.php"))+  $ end+  , "test/xml/smsExample3.xml" )++smsExamples = [ smsExample1, smsExample2, smsExample3 ]++{- Dial -}++-- FIXME: Ugly.+dialExample1 =+  ( respond+  . dial (Right "415-123-4567")+  . say "Goodbye"+  $ end+  , "test/xml/dialExample1.xml" )++dialExample2 =+  ( respond+  . (dial (Right "415-123-4567") <&> action .~ (fromJust $ parseURL "/handleDialCallStatus.php")+                                 <&> method .~ GET)+  . say "I am unreachable"+  $ end+  , "test/xml/dialExample2.xml" )++dialExample3 =+  ( respond+  . (dial+        (Left $ Number (NumberAttributes Nothing Nothing Nothing) "+15558675309")+      <&> callerId .~ "+15551112222")+  $ end+  , "test/xml/dialExample3.xml" )++dialExamples = [ dialExample1, dialExample2, dialExample3 ]++-- TODO: Dial nouns...++{- Enqueue -}++enqueueExample1 =+  ( respond+  . (enqueue "support" <&> waitURL .~ (fromJust $ parseURL "wait-music.xml"))+  $ end+  , "test/xml/enqueueExample1.xml" )++enqueueExamples = [ enqueueExample1 ]++{- Leave -}++leaveExample1 =+  ( respond+  . leave+  $ end+  , "test/xml/leaveExample1.xml" )++leaveExamples = [ leaveExample1 ]++{- Hangup -}++hangupExample1 =+  ( respond+  . hangup+  $ end+  , "test/xml/hangupExample1.xml" )++hangupExamples = [ hangupExample1 ]++{- Redirect -}++-- FIXME: Ugly.+redirectExample1 =+  ( respond+  . dial (Right "415-123-4567")+  . redirect (fromJust $ parseURL "http://www.foo.com/nextInstructions")+  $ end+  , "test/xml/redirectExample1.xml" )++redirectExample2 =+  ( respond+  . redirect (fromJust $ parseURL "../nextInstructions")+  $ end+  , "test/xml/redirectExample2.xml" )++redirectExamples = [ redirectExample1, redirectExample2 ]++{- Reject -}++rejectExample1 =+  ( respond+  . reject+  $ end+  , "test/xml/rejectExample1.xml" )++rejectExample2 =+  ( respond+  . (reject <&> reason .~ Busy)+  $ end+  , "test/xml/rejectExample2.xml" )++rejectExamples = [ rejectExample1, rejectExample2 ]++{- Pause -}++pauseExample1 =+  ( respond+  . say "I will pause 10 seconds starting now!"+  . (pause <&> duration .~ 10)+  . say "I just paused 10 seconds"+  $ end+  , "test/xml/pauseExample1.xml" )++pauseExample2 =+  ( respond+  . (pause <&> duration .~ 5)+  . say "Hi there."+  $ end+  , "test/xml/pauseExample2.xml" )++pauseExamples = [ pauseExample1, pauseExample2 ]++{- Main -}++examples = concat+  [ sayExamples+  , playExamples+  , gatherExamples+  , recordExamples+  , smsExamples+  , dialExamples+  , enqueueExamples+  , leaveExamples+  , hangupExamples+  , redirectExamples+  , rejectExamples+  ] ++main :: IO ()+main = do+  results <- sequence $ map check examples+  when (not $ and results) $ error "Failed"++check :: (Response, FilePath) -> IO Bool+check (twiml, filePath) = do+  let a = show twiml+  b <- readFile filePath+  let equal = a == b+  if (not equal)+    then do+      putStrLn $ "Failed: " ++ filePath+      putStrLn $ "Expected:\n" ++ b+      putStrLn $ "Got:\n" ++ a ++ "\n"+    else do+      putStrLn $ "Passed: " ++ filePath+  return equal
+ test/xml/dialExample1.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Dial>415-123-4567</Dial>+  <Say>Goodbye</Say>+</Response>
+ test/xml/dialExample2.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Dial action="/handleDialCallStatus.php" method="GET">415-123-4567</Dial>+  <Say>I am unreachable</Say>+</Response>
+ test/xml/dialExample3.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Dial callerId="+15551112222">+    <Number>+15558675309</Number>+  </Dial>+</Response>
+ test/xml/enqueueExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Enqueue waitUrl="wait-music.xml">support</Enqueue>+</Response>
+ test/xml/gatherExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Gather />+</Response>
+ test/xml/gatherExample2.xml view
@@ -0,0 +1,7 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Gather action="/process_gather.php" method="GET">+    <Say>Please enter your account number, followed by the pound sign</Say>+  </Gather>+  <Say>We didn&#39;t receive any input. Goodbye!</Say>+</Response>
+ test/xml/hangupExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Hangup />+</Response>
+ test/xml/leaveExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Leave />+</Response>
+ test/xml/pauseExample1.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>I will pause 10 seconds starting now!</Say>+  <Pause length="10"/>+  <Say>I just paused 10 seconds</Say>+</Response>
+ test/xml/pauseExample2.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Pause length="5"/>+  <Say>Hi there.</Say>+</Response>
+ test/xml/playExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Play>https://api.twilio.com/cowbell.mp3</Play>+</Response>
+ test/xml/playExample2.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Play digits="wwww3" />+</Response>
+ test/xml/recordExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Record />+</Response>
+ test/xml/recordExample2.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>Please leave a message at the beep. Press the star key when finished.</Say>+  <Record action="http://foo.edu/handleRecording.php" method="GET" finishOnKey="*" maxLength="20" />+  <Say>I did not receive a recording</Say>+</Response>
+ test/xml/recordExample3.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Record transcribe="true" transcribeCallback="/handle_transcribe.php" />+</Response>
+ test/xml/redirectExample1.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Dial>415-123-4567</Dial>+  <Redirect>http://www.foo.com/nextInstructions</Redirect>+</Response>
+ test/xml/redirectExample2.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Redirect>../nextInstructions</Redirect>+</Response>
+ test/xml/rejectExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Reject />+</Response>
+ test/xml/rejectExample2.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Reject reason="busy" />+</Response>
+ test/xml/sayExample1.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>Hello World</Say>+</Response>
+ test/xml/sayExample2.xml view
@@ -0,0 +1,4 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say voice="alice" loop="2" language="pt-BR">Bom dia.</Say>+</Response>
+ test/xml/smsExample1.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>Our store is located at 123 Easy St.</Say>+  <Sms>Store Location: 123 Easy St.</Sms>+</Response>
+ test/xml/smsExample2.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>Our store is located at 123 Easy St.</Say>+  <Sms action="/smsHandler.php" method="POST">Store Location: 123 Easy St.</Sms>+</Response>
+ test/xml/smsExample3.xml view
@@ -0,0 +1,5 @@+<?xml version="1.0" encoding="UTF-8"?>+<Response>+  <Say>Our store is located at 123 Easy St.</Say>+  <Sms statusCallback="/smsHandler.php">Store Location: 123 Easy St.</Sms>+</Response>
+ twiml.cabal view
@@ -0,0 +1,72 @@+-- Initial twiml.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++name:                twiml+version:             0.1.0.0+synopsis:            TwiML library for Haskell+description:         TwiML library for Haskell+homepage:            https://github.com/markandrus/twiml-haskell+license:             BSD3+license-file:        LICENSE+author:              Mark Andrus Roberts+maintainer:          markandrusroberts@gmail.com+-- copyright:           +category:            Text, Web, XML+build-type:          Simple+cabal-version:       >=1.8+data-files:          test/xml/dialExample1.xml,+                     test/xml/dialExample2.xml,+                     test/xml/dialExample3.xml,+                     test/xml/enqueueExample1.xml,+                     test/xml/gatherExample1.xml,+                     test/xml/gatherExample2.xml,+                     test/xml/hangupExample1.xml,+                     test/xml/leaveExample1.xml,+                     test/xml/pauseExample1.xml,+                     test/xml/pauseExample2.xml,+                     test/xml/playExample1.xml,+                     test/xml/playExample2.xml,+                     test/xml/recordExample1.xml,+                     test/xml/recordExample2.xml,+                     test/xml/recordExample3.xml,+                     test/xml/redirectExample1.xml,+                     test/xml/redirectExample2.xml,+                     test/xml/rejectExample1.xml,+                     test/xml/rejectExample2.xml,+                     test/xml/sayExample1.xml,+                     test/xml/sayExample2.xml,+                     test/xml/smsExample1.xml,+                     test/xml/smsExample2.xml,+                     test/xml/smsExample3.xml++source-repository head+  type: git+  location: https://github.com/markandrus/twiml-haskell++library+  exposed-modules:     Text.XML.Twiml,+                       Text.XML.Twiml.Types,+                       Text.XML.Twiml.Verbs,+                       Text.XML.Twiml.Verbs.End,+                       Text.XML.Twiml.Verbs.Say,+                       Text.XML.Twiml.Verbs.Play,+                       Text.XML.Twiml.Verbs.Gather,+                       Text.XML.Twiml.Verbs.Record,+                       Text.XML.Twiml.Verbs.Sms,+                       Text.XML.Twiml.Verbs.Dial,+                       Text.XML.Twiml.Verbs.Enqueue,+                       Text.XML.Twiml.Verbs.Leave,+                       Text.XML.Twiml.Verbs.Hangup,+                       Text.XML.Twiml.Verbs.Redirect,+                       Text.XML.Twiml.Verbs.Reject,+                       Text.XML.Twiml.Verbs.Pause,+                       Text.XML.Twiml.Internal+  hs-source-dirs:      src+  -- other-modules:       +  build-depends:       base ==4.6.*, xml >=1.3, network >=2.4++test-suite Tests+  hs-source-dirs:      test+  main-is:             Test.hs+  Type:                exitcode-stdio-1.0+  build-depends:       base ==4.6.*, Cabal >=1.16.0, lens >=3.9, twiml