{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.XML.Twiml.Types
( Digit(..)
, Key(..)
, Method(..)
, Natural
, URL
, parseURL
, Voice(..)
, Lang(..)
, LangAlice(..)
, Transport(..)
, ConferenceBeep(..)
, Reason(..)
) where
import Control.DeepSeq (NFData(..))
import Data.Data
import GHC.Generics (Generic)
import Network.URI (URI(..), parseURIReference)
import Text.XML.Twiml.Internal
data Digit
= D0
| D1
| D2
| D3
| D4
| D5
| D6
| D7
| D8
| D9
| W
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Digit where
toAttrValue D0 = "0"
toAttrValue D1 = "1"
toAttrValue D2 = "2"
toAttrValue D3 = "3"
toAttrValue D4 = "4"
toAttrValue D5 = "5"
toAttrValue D6 = "6"
toAttrValue D7 = "7"
toAttrValue D8 = "8"
toAttrValue D9 = "9"
toAttrValue W = "w"
instance ToAttrValue [Digit] where
toAttrValue = concatMap toAttrValue
data Key
= K0
| K1
| K2
| K3
| K4
| K5
| K6
| K7
| K8
| K9
| KStar
| KPound
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Key where
toAttrValue K0 = "0"
toAttrValue K1 = "1"
toAttrValue K2 = "2"
toAttrValue K3 = "3"
toAttrValue K4 = "4"
toAttrValue K5 = "5"
toAttrValue K6 = "6"
toAttrValue K7 = "7"
toAttrValue K8 = "8"
toAttrValue K9 = "9"
toAttrValue KStar = "*"
toAttrValue KPound = "#"
type Natural = Int
instance ToAttrValue Natural where
toAttrValue = show
data Method = GET | POST
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Method where
toAttrValue = show
newtype URL = URL { getURL :: String }
deriving (Data, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToSomeNode URL where
toSomeNode = toSomeNode . getURL
instance ToAttrValue URL where
toAttrValue = getURL
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 Voice
= Man (Maybe Lang)
| Woman (Maybe Lang)
| Alice (Maybe LangAlice)
deriving (Data, Eq, Generic, NFData, Ord, Read, Show, Typeable)
data Lang
= English
| EnglishUK
| Spanish
| French
| German
| Italian
deriving (Data, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Lang where
toAttrValue English = "en"
toAttrValue EnglishUK = "en-gb"
toAttrValue Spanish = "es"
toAttrValue French = "fr"
toAttrValue German = "de"
toAttrValue Italian = "it"
data LangAlice
= DaDK
| DeDE
| EnAU
| EnCA
| EnGB
| EnIN
| EnUS
| CaES
| EsES
| EsMX
| FiFI
| FrCA
| FrFR
| ItIT
| JaJP
| KoKR
| NbNO
| NlNL
| PlPL
| PtBR
| PtPT
| RuRU
| SvSE
| ZhCN
| ZhHK
| ZhTW
deriving (Data, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue LangAlice where
toAttrValue DaDK = "da-DK"
toAttrValue DeDE = "de-DE"
toAttrValue EnAU = "en-AU"
toAttrValue EnCA = "en-CA"
toAttrValue EnGB = "en-GB"
toAttrValue EnIN = "en-IN"
toAttrValue EnUS = "en-US"
toAttrValue CaES = "ca-ES"
toAttrValue EsES = "es-ES"
toAttrValue EsMX = "es-MX"
toAttrValue FiFI = "fi-FI"
toAttrValue FrCA = "fr-CA"
toAttrValue FrFR = "fr-FR"
toAttrValue ItIT = "it-IT"
toAttrValue JaJP = "ja-JP"
toAttrValue KoKR = "ko-KR"
toAttrValue NbNO = "nb-NO"
toAttrValue NlNL = "nl-NL"
toAttrValue PlPL = "pl-PL"
toAttrValue PtBR = "pt-BR"
toAttrValue PtPT = "pt-PT"
toAttrValue RuRU = "ru-RU"
toAttrValue SvSE = "sv-SE"
toAttrValue ZhCN = "zh-CN"
toAttrValue ZhHK = "zh-HK"
toAttrValue ZhTW = "zh-TW"
data Transport = TCP | UDP
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Transport where
toAttrValue TCP = "tcp"
toAttrValue UDP = "udp"
data ConferenceBeep
= Yes
| No
| OnExit
| OnEnter
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue ConferenceBeep where
toAttrValue Yes = "yes"
toAttrValue No = "no"
toAttrValue OnExit = "on-exit"
toAttrValue OnEnter = "on-enter"
data Reason = Rejected | Busy
deriving (Bounded, Data, Enum, Eq, Generic, NFData, Ord, Read, Show, Typeable)
instance ToAttrValue Reason where
toAttrValue Rejected = "rejected"
toAttrValue Busy = "busy"
instance ToAttrValue Voice where
toAttrValue (Man _) = "man"
toAttrValue (Woman _) = "woman"
toAttrValue (Alice _) = "alice"