{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE CPP #-}
module Text.ICalendar.Printer
    ( EncodingFunctions(..)
    , printICalendar
    , printICal
    ) where

import           Control.Applicative
import           Control.Arrow                ((&&&))
import           Control.Monad                hiding (forM_, mapM_)
import           Control.Monad.RWS            (MonadState (get, put),
                                               MonadWriter (tell), RWS, asks,
                                               modify, runRWS)
import           Data.ByteString.Lazy         (ByteString)
import           Data.ByteString.Builder      (Builder)
import qualified Data.ByteString.Builder      as Bu
import qualified Data.ByteString.Lazy.Char8   as BS
import qualified Data.CaseInsensitive         as CI
import           Data.Char                    (ord, toUpper)
import           Data.Default
import           Data.Foldable                (forM_, mapM_)
import           Data.Monoid
import           Data.Set                     (Set)
import qualified Data.Set                     as S
import           Data.Text.Lazy               (Text)
import qualified Data.Text.Lazy               as T
import           Data.Time                    (FormatTime ())
import qualified Data.Time                    as Time
import qualified Data.Version                 as Ver
import qualified Network.URI                  as URI
import           Prelude                      hiding (mapM_)

#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif

import           Text.Printf                  (printf)

import           Codec.MIME.Type             (MIMEType, showMIMEType)
import qualified Data.ByteString.Base64.Lazy as B64

import Text.ICalendar.Types


-- | Functions for encoding into bytestring builders.
data EncodingFunctions = EncodingFunctions
    { EncodingFunctions -> Char -> Builder
efChar2Bu  :: Char -> Builder
    , EncodingFunctions -> Char -> Int
efChar2Len :: Char -> Int -- ^ How many octets the character is encoded.
    }

utf8Len :: Char -> Int
utf8Len :: Char -> Int
utf8Len Char
c | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80  = Int
1
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x800  = Int
2
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 = Int
3
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x200000 = Int
4
          | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x4000000 = Int
5
          | Bool
otherwise      = Int
6
  where o :: Int
o = Char -> Int
ord Char
c

newtype AltRep = AltRep URI.URI
newtype CN = CN Text
newtype Dir = Dir URI.URI
newtype Member = Member (Set URI.URI)
newtype DelTo = DelTo (Set URI.URI)
newtype DelFrom = DelFrom (Set URI.URI)
newtype RSVP = RSVP Bool
newtype SentBy = SentBy CalAddress

data Quoting = NeedQuotes | Optional | NoQuotes
               deriving (Quoting -> Quoting -> Bool
(Quoting -> Quoting -> Bool)
-> (Quoting -> Quoting -> Bool) -> Eq Quoting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Quoting -> Quoting -> Bool
== :: Quoting -> Quoting -> Bool
$c/= :: Quoting -> Quoting -> Bool
/= :: Quoting -> Quoting -> Bool
Eq, Eq Quoting
Eq Quoting =>
(Quoting -> Quoting -> Ordering)
-> (Quoting -> Quoting -> Bool)
-> (Quoting -> Quoting -> Bool)
-> (Quoting -> Quoting -> Bool)
-> (Quoting -> Quoting -> Bool)
-> (Quoting -> Quoting -> Quoting)
-> (Quoting -> Quoting -> Quoting)
-> Ord Quoting
Quoting -> Quoting -> Bool
Quoting -> Quoting -> Ordering
Quoting -> Quoting -> Quoting
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Quoting -> Quoting -> Ordering
compare :: Quoting -> Quoting -> Ordering
$c< :: Quoting -> Quoting -> Bool
< :: Quoting -> Quoting -> Bool
$c<= :: Quoting -> Quoting -> Bool
<= :: Quoting -> Quoting -> Bool
$c> :: Quoting -> Quoting -> Bool
> :: Quoting -> Quoting -> Bool
$c>= :: Quoting -> Quoting -> Bool
>= :: Quoting -> Quoting -> Bool
$cmax :: Quoting -> Quoting -> Quoting
max :: Quoting -> Quoting -> Quoting
$cmin :: Quoting -> Quoting -> Quoting
min :: Quoting -> Quoting -> Quoting
Ord, Int -> Quoting -> ShowS
[Quoting] -> ShowS
Quoting -> String
(Int -> Quoting -> ShowS)
-> (Quoting -> String) -> ([Quoting] -> ShowS) -> Show Quoting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Quoting -> ShowS
showsPrec :: Int -> Quoting -> ShowS
$cshow :: Quoting -> String
show :: Quoting -> String
$cshowList :: [Quoting] -> ShowS
showList :: [Quoting] -> ShowS
Show)

-- | UTF8.
instance Default EncodingFunctions where
    def :: EncodingFunctions
def = (Char -> Builder) -> (Char -> Int) -> EncodingFunctions
EncodingFunctions Char -> Builder
Bu.charUtf8
                            Char -> Int
utf8Len

type ContentPrinter = RWS EncodingFunctions Builder Int

-- | Print a VCalendar object to a ByteString.
printICalendar :: EncodingFunctions -> VCalendar -> ByteString
printICalendar :: EncodingFunctions -> VCalendar -> ByteString
printICalendar EncodingFunctions
r VCalendar
v = (\(()
_, Int
_, Builder
x) -> Builder -> ByteString
Bu.toLazyByteString Builder
x) (((), Int, Builder) -> ByteString)
-> ((), Int, Builder) -> ByteString
forall a b. (a -> b) -> a -> b
$
                     RWS EncodingFunctions Builder Int ()
-> EncodingFunctions -> Int -> ((), Int, Builder)
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS (VCalendar -> RWS EncodingFunctions Builder Int ()
printVCalendar VCalendar
v) EncodingFunctions
r Int
0

-- | Deprecated synonym for printICalendar
printICal :: EncodingFunctions -> VCalendar -> ByteString
printICal :: EncodingFunctions -> VCalendar -> ByteString
printICal = EncodingFunctions -> VCalendar -> ByteString
printICalendar
{-# DEPRECATED printICal "Use printICalendar instead" #-}

-- {{{ Component printers

printVCalendar :: VCalendar -> ContentPrinter ()
printVCalendar :: VCalendar -> RWS EncodingFunctions Builder Int ()
printVCalendar VCalendar {Maybe Method
Set OtherProperty
Set VOther
Map (Text, Maybe (Either Date DateTime)) VJournal
Map (Text, Maybe (Either Date DateTime)) VTodo
Map (Text, Maybe (Either Date DateTime)) VEvent
Map Text VTimeZone
Map Text VFreeBusy
Scale
ICalVersion
ProdId
vcProdId :: ProdId
vcVersion :: ICalVersion
vcScale :: Scale
vcMethod :: Maybe Method
vcOther :: Set OtherProperty
vcTimeZones :: Map Text VTimeZone
vcEvents :: Map (Text, Maybe (Either Date DateTime)) VEvent
vcTodos :: Map (Text, Maybe (Either Date DateTime)) VTodo
vcJournals :: Map (Text, Maybe (Either Date DateTime)) VJournal
vcFreeBusys :: Map Text VFreeBusy
vcOtherComps :: Set VOther
vcProdId :: VCalendar -> ProdId
vcVersion :: VCalendar -> ICalVersion
vcScale :: VCalendar -> Scale
vcMethod :: VCalendar -> Maybe Method
vcOther :: VCalendar -> Set OtherProperty
vcTimeZones :: VCalendar -> Map Text VTimeZone
vcEvents :: VCalendar -> Map (Text, Maybe (Either Date DateTime)) VEvent
vcTodos :: VCalendar -> Map (Text, Maybe (Either Date DateTime)) VTodo
vcJournals :: VCalendar -> Map (Text, Maybe (Either Date DateTime)) VJournal
vcFreeBusys :: VCalendar -> Map Text VFreeBusy
vcOtherComps :: VCalendar -> Set VOther
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VCALENDAR"
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"VERSION" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ICalVersion -> OtherParams
versionOther ICalVersion
vcVersion -- Should be first for
            ICalVersion -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ICalVersion
vcVersion                    -- compatibility.
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"PRODID" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ProdId -> OtherParams
prodIdOther ProdId
vcProdId
            Text -> RWS EncodingFunctions Builder Int ()
text (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ProdId -> Text
prodIdValue ProdId
vcProdId
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"CALSCALE" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Scale -> OtherParams
scaleOther Scale
vcScale
            Text -> RWS EncodingFunctions Builder Int ()
text (Text -> RWS EncodingFunctions Builder Int ())
-> (CI Text -> Text)
-> CI Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> RWS EncodingFunctions Builder Int ())
-> CI Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Scale -> CI Text
scaleValue Scale
vcScale
    Maybe Method
-> (Method -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Method
vcMethod ((Method -> RWS EncodingFunctions Builder Int ())
 -> RWS EncodingFunctions Builder Int ())
-> (Method -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ \Method
meth -> do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"METHOD" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Method -> OtherParams
methodOther Method
meth
        RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (CI Text -> RWS EncodingFunctions Builder Int ())
-> CI Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RWS EncodingFunctions Builder Int ()
text (Text -> RWS EncodingFunctions Builder Int ())
-> (CI Text -> Text)
-> CI Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> RWS EncodingFunctions Builder Int ())
-> CI Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Method -> CI Text
methodValue Method
meth
    (OtherProperty -> RWS EncodingFunctions Builder Int ())
-> Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vcOther
    (VTimeZone -> RWS EncodingFunctions Builder Int ())
-> Map Text VTimeZone -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VTimeZone -> RWS EncodingFunctions Builder Int ()
printVTimeZone Map Text VTimeZone
vcTimeZones
    (VEvent -> RWS EncodingFunctions Builder Int ())
-> Map (Text, Maybe (Either Date DateTime)) VEvent
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VEvent -> RWS EncodingFunctions Builder Int ()
printVEvent Map (Text, Maybe (Either Date DateTime)) VEvent
vcEvents
    (VTodo -> RWS EncodingFunctions Builder Int ())
-> Map (Text, Maybe (Either Date DateTime)) VTodo
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VTodo -> RWS EncodingFunctions Builder Int ()
printVTodo Map (Text, Maybe (Either Date DateTime)) VTodo
vcTodos
    (VJournal -> RWS EncodingFunctions Builder Int ())
-> Map (Text, Maybe (Either Date DateTime)) VJournal
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VJournal -> RWS EncodingFunctions Builder Int ()
printVJournal Map (Text, Maybe (Either Date DateTime)) VJournal
vcJournals
    (VFreeBusy -> RWS EncodingFunctions Builder Int ())
-> Map Text VFreeBusy -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VFreeBusy -> RWS EncodingFunctions Builder Int ()
printVFreeBusy Map Text VFreeBusy
vcFreeBusys
    (VOther -> RWS EncodingFunctions Builder Int ())
-> Set VOther -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VOther -> RWS EncodingFunctions Builder Int ()
printVOther Set VOther
vcOtherComps
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VCALENDAR"

printVTimeZone :: VTimeZone -> ContentPrinter ()
printVTimeZone :: VTimeZone -> RWS EncodingFunctions Builder Int ()
printVTimeZone VTimeZone {Maybe LastModified
Maybe TZUrl
Set OtherProperty
Set TZProp
TZID
vtzId :: TZID
vtzLastMod :: Maybe LastModified
vtzUrl :: Maybe TZUrl
vtzStandardC :: Set TZProp
vtzDaylightC :: Set TZProp
vtzOther :: Set OtherProperty
vtzId :: VTimeZone -> TZID
vtzLastMod :: VTimeZone -> Maybe LastModified
vtzUrl :: VTimeZone -> Maybe TZUrl
vtzStandardC :: VTimeZone -> Set TZProp
vtzDaylightC :: VTimeZone -> Set TZProp
vtzOther :: VTimeZone -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VTIMEZONE"
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TZID" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TZID -> OtherParams
tzidOther TZID
vtzId
            Text -> RWS EncodingFunctions Builder Int ()
text (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TZID -> Text
tzidValue TZID
vtzId
    Maybe LastModified -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe LastModified
vtzLastMod
    Maybe TZUrl
-> (TZUrl -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TZUrl
vtzUrl ((TZUrl -> RWS EncodingFunctions Builder Int ())
 -> RWS EncodingFunctions Builder Int ())
-> (TZUrl -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ \TZUrl
url -> do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TZURL" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TZUrl -> OtherParams
tzUrlOther TZUrl
url
        RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (URI -> RWS EncodingFunctions Builder Int ())
-> URI
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow (URI -> RWS EncodingFunctions Builder Int ())
-> URI -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TZUrl -> URI
tzUrlValue TZUrl
url
    (TZProp -> RWS EncodingFunctions Builder Int ())
-> Set TZProp -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> TZProp -> RWS EncodingFunctions Builder Int ()
printTZProp ByteString
"STANDARD") Set TZProp
vtzStandardC
    (TZProp -> RWS EncodingFunctions Builder Int ())
-> Set TZProp -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> TZProp -> RWS EncodingFunctions Builder Int ()
printTZProp ByteString
"DAYLIGHT") Set TZProp
vtzDaylightC
    (OtherProperty -> RWS EncodingFunctions Builder Int ())
-> Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vtzOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VTIMEZONE"

printTZProp :: ByteString -> TZProp -> ContentPrinter ()
printTZProp :: ByteString -> TZProp -> RWS EncodingFunctions Builder Int ()
printTZProp ByteString
name TZProp {Set OtherProperty
Set RRule
Set RDate
Set TZName
Set Comment
UTCOffset
DTStart
tzpDTStart :: DTStart
tzpTZOffsetTo :: UTCOffset
tzpTZOffsetFrom :: UTCOffset
tzpRRule :: Set RRule
tzpComment :: Set Comment
tzpRDate :: Set RDate
tzpTZName :: Set TZName
tzpOther :: Set OtherProperty
tzpDTStart :: TZProp -> DTStart
tzpTZOffsetTo :: TZProp -> UTCOffset
tzpTZOffsetFrom :: TZProp -> UTCOffset
tzpRRule :: TZProp -> Set RRule
tzpComment :: TZProp -> Set Comment
tzpRDate :: TZProp -> Set RDate
tzpTZName :: TZProp -> Set TZName
tzpOther :: TZProp -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line (ByteString -> RWS EncodingFunctions Builder Int ())
-> ByteString -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString
"BEGIN:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
name
    DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty DTStart
tzpDTStart
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TZOFFSETTO" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ UTCOffset -> OtherParams
utcOffsetOther UTCOffset
tzpTZOffsetTo
            Int -> RWS EncodingFunctions Builder Int ()
printUTCOffset (Int -> RWS EncodingFunctions Builder Int ())
-> Int -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ UTCOffset -> Int
utcOffsetValue UTCOffset
tzpTZOffsetTo
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TZOFFSETFROM" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ UTCOffset -> OtherParams
utcOffsetOther UTCOffset
tzpTZOffsetTo
            Int -> RWS EncodingFunctions Builder Int ()
printUTCOffset (Int -> RWS EncodingFunctions Builder Int ())
-> Int -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ UTCOffset -> Int
utcOffsetValue UTCOffset
tzpTZOffsetFrom
    Set RRule -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RRule
tzpRRule
    Set Comment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Comment
tzpComment
    Set RDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RDate
tzpRDate
    Set TZName
-> (TZName -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set TZName
tzpTZName ((TZName -> RWS EncodingFunctions Builder Int ())
 -> RWS EncodingFunctions Builder Int ())
-> (TZName -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ \TZName {Maybe Language
Text
OtherParams
tzNameValue :: Text
tzNameLanguage :: Maybe Language
tzNameOther :: OtherParams
tzNameValue :: TZName -> Text
tzNameLanguage :: TZName -> Maybe Language
tzNameOther :: TZName -> OtherParams
..} -> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TZNAME" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
tzNameLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
tzNameOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
tzNameValue
    (OtherProperty -> RWS EncodingFunctions Builder Int ())
-> Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
tzpOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line (ByteString -> RWS EncodingFunctions Builder Int ())
-> ByteString -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString
"END:" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
name

printVEvent :: VEvent -> ContentPrinter ()
printVEvent :: VEvent -> RWS EncodingFunctions Builder Int ()
printVEvent VEvent {Maybe (Either DTEnd DurationProp)
Maybe LastModified
Maybe Created
Maybe URL
Maybe RecurrenceId
Maybe Organizer
Maybe DTStart
Maybe Summary
Maybe EventStatus
Maybe Location
Maybe Geo
Maybe Description
Set OtherProperty
Set RequestStatus
Set RRule
Set RDate
Set ExDate
Set RelatedTo
Set Contact
Set Attendee
Set Resources
Set Comment
Set Categories
Set Attachment
Set VAlarm
Sequence
DTStamp
UID
TimeTransparency
Priority
Class
veDTStamp :: DTStamp
veUID :: UID
veClass :: Class
veDTStart :: Maybe DTStart
veCreated :: Maybe Created
veDescription :: Maybe Description
veGeo :: Maybe Geo
veLastMod :: Maybe LastModified
veLocation :: Maybe Location
veOrganizer :: Maybe Organizer
vePriority :: Priority
veSeq :: Sequence
veStatus :: Maybe EventStatus
veSummary :: Maybe Summary
veTransp :: TimeTransparency
veUrl :: Maybe URL
veRecurId :: Maybe RecurrenceId
veRRule :: Set RRule
veDTEndDuration :: Maybe (Either DTEnd DurationProp)
veAttach :: Set Attachment
veAttendee :: Set Attendee
veCategories :: Set Categories
veComment :: Set Comment
veContact :: Set Contact
veExDate :: Set ExDate
veRStatus :: Set RequestStatus
veRelated :: Set RelatedTo
veResources :: Set Resources
veRDate :: Set RDate
veAlarms :: Set VAlarm
veOther :: Set OtherProperty
veDTStamp :: VEvent -> DTStamp
veUID :: VEvent -> UID
veClass :: VEvent -> Class
veDTStart :: VEvent -> Maybe DTStart
veCreated :: VEvent -> Maybe Created
veDescription :: VEvent -> Maybe Description
veGeo :: VEvent -> Maybe Geo
veLastMod :: VEvent -> Maybe LastModified
veLocation :: VEvent -> Maybe Location
veOrganizer :: VEvent -> Maybe Organizer
vePriority :: VEvent -> Priority
veSeq :: VEvent -> Sequence
veStatus :: VEvent -> Maybe EventStatus
veSummary :: VEvent -> Maybe Summary
veTransp :: VEvent -> TimeTransparency
veUrl :: VEvent -> Maybe URL
veRecurId :: VEvent -> Maybe RecurrenceId
veRRule :: VEvent -> Set RRule
veDTEndDuration :: VEvent -> Maybe (Either DTEnd DurationProp)
veAttach :: VEvent -> Set Attachment
veAttendee :: VEvent -> Set Attendee
veCategories :: VEvent -> Set Categories
veComment :: VEvent -> Set Comment
veContact :: VEvent -> Set Contact
veExDate :: VEvent -> Set ExDate
veRStatus :: VEvent -> Set RequestStatus
veRelated :: VEvent -> Set RelatedTo
veResources :: VEvent -> Set Resources
veRDate :: VEvent -> Set RDate
veAlarms :: VEvent -> Set VAlarm
veOther :: VEvent -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VEVENT"
    DTStamp -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty DTStamp
veDTStamp
    UID -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty UID
veUID
    Maybe DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe DTStart
veDTStart
    Class -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Class
veClass
    Maybe Created -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Created
veCreated
    Maybe Description -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Description
veDescription
    Maybe Geo -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Geo
veGeo
    Maybe LastModified -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe LastModified
veLastMod
    Maybe Location -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Location
veLocation
    Maybe Organizer -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Organizer
veOrganizer
    Priority -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Priority
vePriority
    Sequence -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Sequence
veSeq
    Maybe EventStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe EventStatus
veStatus
    Maybe Summary -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Summary
veSummary
    TimeTransparency -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty TimeTransparency
veTransp
    Maybe URL -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe URL
veUrl
    Maybe RecurrenceId -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe RecurrenceId
veRecurId
    Set RRule -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RRule
veRRule
    Maybe (Either DTEnd DurationProp)
-> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe (Either DTEnd DurationProp)
veDTEndDuration
    Set Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attachment
veAttach
    Set Attendee -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attendee
veAttendee
    Set Categories -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Categories
veCategories
    Set Comment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Comment
veComment
    Set Contact -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Contact
veContact
    Set ExDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set ExDate
veExDate
    Set RequestStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RequestStatus
veRStatus
    Set RelatedTo -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RelatedTo
veRelated
    Set Resources -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Resources
veResources
    Set RDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RDate
veRDate
    Set VAlarm
-> (VAlarm -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set VAlarm
veAlarms VAlarm -> RWS EncodingFunctions Builder Int ()
printVAlarm
    Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
veOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VEVENT"

printVTodo :: VTodo -> ContentPrinter ()
printVTodo :: VTodo -> RWS EncodingFunctions Builder Int ()
printVTodo VTodo {Maybe (Either Due DurationProp)
Maybe LastModified
Maybe Created
Maybe URL
Maybe RecurrenceId
Maybe Organizer
Maybe DTStart
Maybe Summary
Maybe TodoStatus
Maybe PercentComplete
Maybe Location
Maybe Geo
Maybe Description
Maybe Completed
Set OtherProperty
Set RequestStatus
Set RRule
Set RDate
Set ExDate
Set RelatedTo
Set Contact
Set Attendee
Set Resources
Set Comment
Set Categories
Set Attachment
Set VAlarm
Sequence
DTStamp
UID
Priority
Class
vtDTStamp :: DTStamp
vtUID :: UID
vtClass :: Class
vtCompleted :: Maybe Completed
vtCreated :: Maybe Created
vtDescription :: Maybe Description
vtDTStart :: Maybe DTStart
vtGeo :: Maybe Geo
vtLastMod :: Maybe LastModified
vtLocation :: Maybe Location
vtOrganizer :: Maybe Organizer
vtPercent :: Maybe PercentComplete
vtPriority :: Priority
vtRecurId :: Maybe RecurrenceId
vtSeq :: Sequence
vtStatus :: Maybe TodoStatus
vtSummary :: Maybe Summary
vtUrl :: Maybe URL
vtRRule :: Set RRule
vtDueDuration :: Maybe (Either Due DurationProp)
vtAttach :: Set Attachment
vtAttendee :: Set Attendee
vtCategories :: Set Categories
vtComment :: Set Comment
vtContact :: Set Contact
vtExDate :: Set ExDate
vtRStatus :: Set RequestStatus
vtRelated :: Set RelatedTo
vtResources :: Set Resources
vtRDate :: Set RDate
vtAlarms :: Set VAlarm
vtOther :: Set OtherProperty
vtDTStamp :: VTodo -> DTStamp
vtUID :: VTodo -> UID
vtClass :: VTodo -> Class
vtCompleted :: VTodo -> Maybe Completed
vtCreated :: VTodo -> Maybe Created
vtDescription :: VTodo -> Maybe Description
vtDTStart :: VTodo -> Maybe DTStart
vtGeo :: VTodo -> Maybe Geo
vtLastMod :: VTodo -> Maybe LastModified
vtLocation :: VTodo -> Maybe Location
vtOrganizer :: VTodo -> Maybe Organizer
vtPercent :: VTodo -> Maybe PercentComplete
vtPriority :: VTodo -> Priority
vtRecurId :: VTodo -> Maybe RecurrenceId
vtSeq :: VTodo -> Sequence
vtStatus :: VTodo -> Maybe TodoStatus
vtSummary :: VTodo -> Maybe Summary
vtUrl :: VTodo -> Maybe URL
vtRRule :: VTodo -> Set RRule
vtDueDuration :: VTodo -> Maybe (Either Due DurationProp)
vtAttach :: VTodo -> Set Attachment
vtAttendee :: VTodo -> Set Attendee
vtCategories :: VTodo -> Set Categories
vtComment :: VTodo -> Set Comment
vtContact :: VTodo -> Set Contact
vtExDate :: VTodo -> Set ExDate
vtRStatus :: VTodo -> Set RequestStatus
vtRelated :: VTodo -> Set RelatedTo
vtResources :: VTodo -> Set Resources
vtRDate :: VTodo -> Set RDate
vtAlarms :: VTodo -> Set VAlarm
vtOther :: VTodo -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VTODO"
    DTStamp -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty DTStamp
vtDTStamp
    UID -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty UID
vtUID
    Class -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Class
vtClass
    Maybe Completed -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Completed
vtCompleted
    Maybe Created -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Created
vtCreated
    Maybe Description -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Description
vtDescription
    Maybe DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe DTStart
vtDTStart
    Maybe Geo -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Geo
vtGeo
    Maybe LastModified -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe LastModified
vtLastMod
    Maybe Location -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Location
vtLocation
    Maybe Organizer -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Organizer
vtOrganizer
    Maybe PercentComplete -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe PercentComplete
vtPercent
    Priority -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Priority
vtPriority
    Sequence -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Sequence
vtSeq
    Maybe RecurrenceId -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe RecurrenceId
vtRecurId
    Maybe TodoStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe TodoStatus
vtStatus
    Maybe Summary -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Summary
vtSummary
    Maybe URL -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe URL
vtUrl
    Set RRule -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RRule
vtRRule
    Maybe (Either Due DurationProp)
-> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe (Either Due DurationProp)
vtDueDuration
    Set Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attachment
vtAttach
    Set Attendee -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attendee
vtAttendee
    Set Categories -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Categories
vtCategories
    Set Comment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Comment
vtComment
    Set Contact -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Contact
vtContact
    Set ExDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set ExDate
vtExDate
    Set RequestStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RequestStatus
vtRStatus
    Set RelatedTo -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RelatedTo
vtRelated
    Set Resources -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Resources
vtResources
    Set RDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RDate
vtRDate
    Set VAlarm
-> (VAlarm -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set VAlarm
vtAlarms VAlarm -> RWS EncodingFunctions Builder Int ()
printVAlarm
    Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vtOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VTODO"

printVJournal :: VJournal -> ContentPrinter ()
printVJournal :: VJournal -> RWS EncodingFunctions Builder Int ()
printVJournal VJournal {Maybe LastModified
Maybe Created
Maybe URL
Maybe RecurrenceId
Maybe Organizer
Maybe DTStart
Maybe Summary
Maybe JournalStatus
Set OtherProperty
Set RequestStatus
Set RRule
Set RDate
Set ExDate
Set RelatedTo
Set Contact
Set Attendee
Set Description
Set Comment
Set Categories
Set Attachment
Sequence
DTStamp
UID
Class
vjDTStamp :: DTStamp
vjUID :: UID
vjClass :: Class
vjCreated :: Maybe Created
vjDTStart :: Maybe DTStart
vjLastMod :: Maybe LastModified
vjOrganizer :: Maybe Organizer
vjRecurId :: Maybe RecurrenceId
vjSeq :: Sequence
vjStatus :: Maybe JournalStatus
vjSummary :: Maybe Summary
vjUrl :: Maybe URL
vjRRule :: Set RRule
vjAttach :: Set Attachment
vjAttendee :: Set Attendee
vjCategories :: Set Categories
vjComment :: Set Comment
vjContact :: Set Contact
vjDescription :: Set Description
vjExDate :: Set ExDate
vjRelated :: Set RelatedTo
vjRDate :: Set RDate
vjRStatus :: Set RequestStatus
vjOther :: Set OtherProperty
vjDTStamp :: VJournal -> DTStamp
vjUID :: VJournal -> UID
vjClass :: VJournal -> Class
vjCreated :: VJournal -> Maybe Created
vjDTStart :: VJournal -> Maybe DTStart
vjLastMod :: VJournal -> Maybe LastModified
vjOrganizer :: VJournal -> Maybe Organizer
vjRecurId :: VJournal -> Maybe RecurrenceId
vjSeq :: VJournal -> Sequence
vjStatus :: VJournal -> Maybe JournalStatus
vjSummary :: VJournal -> Maybe Summary
vjUrl :: VJournal -> Maybe URL
vjRRule :: VJournal -> Set RRule
vjAttach :: VJournal -> Set Attachment
vjAttendee :: VJournal -> Set Attendee
vjCategories :: VJournal -> Set Categories
vjComment :: VJournal -> Set Comment
vjContact :: VJournal -> Set Contact
vjDescription :: VJournal -> Set Description
vjExDate :: VJournal -> Set ExDate
vjRelated :: VJournal -> Set RelatedTo
vjRDate :: VJournal -> Set RDate
vjRStatus :: VJournal -> Set RequestStatus
vjOther :: VJournal -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VJOURNAL"
    DTStamp -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty DTStamp
vjDTStamp
    UID -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty UID
vjUID
    Class -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Class
vjClass
    Maybe Created -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Created
vjCreated
    Set Description -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Description
vjDescription
    Maybe DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe DTStart
vjDTStart
    Maybe LastModified -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe LastModified
vjLastMod
    Maybe Organizer -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Organizer
vjOrganizer
    Sequence -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Sequence
vjSeq
    Maybe RecurrenceId -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe RecurrenceId
vjRecurId
    Maybe JournalStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe JournalStatus
vjStatus
    Maybe Summary -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Summary
vjSummary
    Maybe URL -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe URL
vjUrl
    Set RRule -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RRule
vjRRule
    Set Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attachment
vjAttach
    Set Attendee -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attendee
vjAttendee
    Set Categories -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Categories
vjCategories
    Set Comment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Comment
vjComment
    Set Contact -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Contact
vjContact
    Set ExDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set ExDate
vjExDate
    Set RequestStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RequestStatus
vjRStatus
    Set RelatedTo -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RelatedTo
vjRelated
    Set RDate -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RDate
vjRDate
    Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vjOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VJOURNAL"

printVFreeBusy :: VFreeBusy -> ContentPrinter ()
printVFreeBusy :: VFreeBusy -> RWS EncodingFunctions Builder Int ()
printVFreeBusy VFreeBusy {Maybe URL
Maybe Organizer
Maybe Contact
Maybe DTStart
Maybe DTEnd
Set OtherProperty
Set RequestStatus
Set Attendee
Set FreeBusy
Set Comment
DTStamp
UID
vfbDTStamp :: DTStamp
vfbUID :: UID
vfbContact :: Maybe Contact
vfbDTStart :: Maybe DTStart
vfbDTEnd :: Maybe DTEnd
vfbOrganizer :: Maybe Organizer
vfbUrl :: Maybe URL
vfbAttendee :: Set Attendee
vfbComment :: Set Comment
vfbFreeBusy :: Set FreeBusy
vfbRStatus :: Set RequestStatus
vfbOther :: Set OtherProperty
vfbDTStamp :: VFreeBusy -> DTStamp
vfbUID :: VFreeBusy -> UID
vfbContact :: VFreeBusy -> Maybe Contact
vfbDTStart :: VFreeBusy -> Maybe DTStart
vfbDTEnd :: VFreeBusy -> Maybe DTEnd
vfbOrganizer :: VFreeBusy -> Maybe Organizer
vfbUrl :: VFreeBusy -> Maybe URL
vfbAttendee :: VFreeBusy -> Set Attendee
vfbComment :: VFreeBusy -> Set Comment
vfbFreeBusy :: VFreeBusy -> Set FreeBusy
vfbRStatus :: VFreeBusy -> Set RequestStatus
vfbOther :: VFreeBusy -> Set OtherProperty
..} = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VFREEBUSY"
    DTStamp -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty DTStamp
vfbDTStamp
    UID -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty UID
vfbUID
    Maybe Contact -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Contact
vfbContact
    Maybe DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe DTStart
vfbDTStart
    Maybe DTEnd -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe DTEnd
vfbDTEnd
    Maybe Organizer -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Organizer
vfbOrganizer
    Maybe URL -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe URL
vfbUrl
    Set Attendee -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attendee
vfbAttendee
    Set Comment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Comment
vfbComment
    Set FreeBusy -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set FreeBusy
vfbFreeBusy
    Set RequestStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set RequestStatus
vfbRStatus
    Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vfbOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VFREEBUSY"

printVOther :: VOther -> ContentPrinter ()
printVOther :: VOther -> RWS EncodingFunctions Builder Int ()
printVOther VOther {CI Text
Set OtherProperty
voName :: CI Text
voProps :: Set OtherProperty
voName :: VOther -> CI Text
voProps :: VOther -> Set OtherProperty
..} = do
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (Text -> RWS EncodingFunctions Builder Int ())
-> Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Text
"BEGIN:V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CI Text -> Text
forall s. CI s -> s
CI.original CI Text
voName
    (OtherProperty -> RWS EncodingFunctions Builder Int ())
-> Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
voProps
    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (Text -> RWS EncodingFunctions Builder Int ())
-> Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Text
"END:V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CI Text -> Text
forall s. CI s -> s
CI.original CI Text
voName

printVAlarm :: VAlarm -> ContentPrinter ()
printVAlarm :: VAlarm -> RWS EncodingFunctions Builder Int ()
printVAlarm VAlarm
va = do
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"BEGIN:VALARM"
    ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"ACTION" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ VAlarm -> OtherParams
vaActionOther VAlarm
va
    case VAlarm
va of
         VAlarmAudio {Maybe DurationProp
Maybe Attachment
Set OtherProperty
Trigger
Repeat
OtherParams
vaActionOther :: VAlarm -> OtherParams
vaTrigger :: Trigger
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaAudioAttach :: Maybe Attachment
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaTrigger :: VAlarm -> Trigger
vaRepeat :: VAlarm -> Repeat
vaDuration :: VAlarm -> Maybe DurationProp
vaAudioAttach :: VAlarm -> Maybe Attachment
vaOther :: VAlarm -> Set OtherProperty
..} -> do
             RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RWS EncodingFunctions Builder Int ()
bytestring ByteString
"AUDIO"
             Trigger -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Trigger
vaTrigger
             RWS EncodingFunctions Builder Int ()
repAndDur
             Maybe Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Maybe Attachment
vaAudioAttach
             Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vaOther
         VAlarmDisplay {Maybe DurationProp
Set OtherProperty
Trigger
Repeat
Description
OtherParams
vaActionOther :: VAlarm -> OtherParams
vaTrigger :: VAlarm -> Trigger
vaRepeat :: VAlarm -> Repeat
vaDuration :: VAlarm -> Maybe DurationProp
vaOther :: VAlarm -> Set OtherProperty
vaDescription :: Description
vaTrigger :: Trigger
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaDescription :: VAlarm -> Description
..} -> do
             RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RWS EncodingFunctions Builder Int ()
bytestring ByteString
"DISPLAY"
             Trigger -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Trigger
vaTrigger
             Description -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Description
vaDescription
             RWS EncodingFunctions Builder Int ()
repAndDur
             Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vaOther
         VAlarmEmail {Maybe DurationProp
Set OtherProperty
Set Attendee
Set Attachment
Trigger
Repeat
Summary
Description
OtherParams
vaActionOther :: VAlarm -> OtherParams
vaTrigger :: VAlarm -> Trigger
vaRepeat :: VAlarm -> Repeat
vaDuration :: VAlarm -> Maybe DurationProp
vaOther :: VAlarm -> Set OtherProperty
vaDescription :: VAlarm -> Description
vaDescription :: Description
vaTrigger :: Trigger
vaSummary :: Summary
vaAttendee :: Set Attendee
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaMailAttach :: Set Attachment
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaSummary :: VAlarm -> Summary
vaAttendee :: VAlarm -> Set Attendee
vaMailAttach :: VAlarm -> Set Attachment
..} -> do
             RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RWS EncodingFunctions Builder Int ()
bytestring ByteString
"EMAIL"
             Trigger -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Trigger
vaTrigger
             Description -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Description
vaDescription
             Summary -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Summary
vaSummary
             Set Attendee -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attendee
vaAttendee
             RWS EncodingFunctions Builder Int ()
repAndDur
             Set Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set Attachment
vaMailAttach
             Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vaOther
         VAlarmX {CI Text
Set OtherProperty
Trigger
OtherParams
vaActionOther :: VAlarm -> OtherParams
vaTrigger :: VAlarm -> Trigger
vaOther :: VAlarm -> Set OtherProperty
vaAction :: CI Text
vaTrigger :: Trigger
vaActionOther :: OtherParams
vaOther :: Set OtherProperty
vaAction :: VAlarm -> CI Text
..} -> do
             RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (Text -> RWS EncodingFunctions Builder Int ())
-> Text
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ CI Text -> Text
forall s. CI s -> s
CI.original CI Text
vaAction
             Trigger -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Trigger
vaTrigger
             Set OtherProperty -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty Set OtherProperty
vaOther
    ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
"END:VALARM"
  where repAndDur :: RWS EncodingFunctions Builder Int ()
repAndDur = Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (VAlarm -> Repeat
vaRepeat VAlarm
va Repeat -> Repeat -> Bool
forall a. Eq a => a -> a -> Bool
== Repeat
forall a. Default a => a
def) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
            Repeat -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty (Repeat -> RWS EncodingFunctions Builder Int ())
-> Repeat -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ VAlarm -> Repeat
vaRepeat VAlarm
va
            Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Repeat -> Integer
repeatValue (VAlarm -> Repeat
vaRepeat VAlarm
va) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
                Maybe DurationProp
-> (DurationProp -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (VAlarm -> Maybe DurationProp
vaDuration VAlarm
va) DurationProp -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty

-- }}}
-- {{{ Property printers.

class IsProperty a where
    printProperty :: a -> ContentPrinter ()

instance IsProperty a => IsProperty (Set a) where
    printProperty :: Set a -> RWS EncodingFunctions Builder Int ()
printProperty = (a -> RWS EncodingFunctions Builder Int ())
-> Set a -> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty

instance IsProperty a => IsProperty (Maybe a) where
    printProperty :: Maybe a -> RWS EncodingFunctions Builder Int ()
printProperty (Just a
x) = a -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty a
x
    printProperty Maybe a
_ = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance (IsProperty a, IsProperty b) => IsProperty (Either a b) where
    printProperty :: Either a b -> RWS EncodingFunctions Builder Int ()
printProperty (Left a
x) = a -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty a
x
    printProperty (Right b
x) = b -> RWS EncodingFunctions Builder Int ()
forall a. IsProperty a => a -> RWS EncodingFunctions Builder Int ()
printProperty b
x

instance IsProperty FreeBusy where
    printProperty :: FreeBusy -> RWS EncodingFunctions Builder Int ()
printProperty FreeBusy {Set UTCPeriod
FBType
OtherParams
freeBusyType :: FBType
freeBusyPeriods :: Set UTCPeriod
freeBusyOther :: OtherParams
freeBusyType :: FreeBusy -> FBType
freeBusyPeriods :: FreeBusy -> Set UTCPeriod
freeBusyOther :: FreeBusy -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"FREEBUSY" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
freeBusyOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> FBType -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam FBType
freeBusyType
        (UTCPeriod -> RWS EncodingFunctions Builder Int ())
-> [UTCPeriod] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN UTCPeriod -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([UTCPeriod] -> RWS EncodingFunctions Builder Int ())
-> [UTCPeriod] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set UTCPeriod -> [UTCPeriod]
forall a. Set a -> [a]
S.toList Set UTCPeriod
freeBusyPeriods

instance IsProperty PercentComplete where
    printProperty :: PercentComplete -> RWS EncodingFunctions Builder Int ()
printProperty PercentComplete {Int
OtherParams
percentCompleteValue :: Int
percentCompleteOther :: OtherParams
percentCompleteValue :: PercentComplete -> Int
percentCompleteOther :: PercentComplete -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"PERCENT-COMPLETE" OtherParams
percentCompleteOther
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
percentCompleteValue

instance IsProperty Completed where
    printProperty :: Completed -> RWS EncodingFunctions Builder Int ()
printProperty Completed {DateTime
OtherParams
completedValue :: DateTime
completedOther :: OtherParams
completedValue :: Completed -> DateTime
completedOther :: Completed -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"COMPLETED" OtherParams
completedOther
                                           DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
completedValue

instance IsProperty DurationProp where
    printProperty :: DurationProp -> RWS EncodingFunctions Builder Int ()
printProperty DurationProp {Duration
OtherParams
durationValue :: Duration
durationOther :: OtherParams
durationValue :: DurationProp -> Duration
durationOther :: DurationProp -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DURATION" OtherParams
durationOther
                                              Duration -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Duration
durationValue

instance IsProperty Repeat where
    printProperty :: Repeat -> RWS EncodingFunctions Builder Int ()
printProperty Repeat {Integer
OtherParams
repeatValue :: Repeat -> Integer
repeatValue :: Integer
repeatOther :: OtherParams
repeatOther :: Repeat -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"REPEAT" OtherParams
repeatOther
                                        Integer -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Integer
repeatValue

instance IsProperty DTEnd where
    printProperty :: DTEnd -> RWS EncodingFunctions Builder Int ()
printProperty DTEnd
dtend = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> DTEnd -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DTEND" DTEnd
dtend RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DTEnd -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DTEnd
dtend

instance IsProperty Due where
    printProperty :: Due -> RWS EncodingFunctions Builder Int ()
printProperty Due
due = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Due -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DUE" Due
due RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Due -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Due
due

instance IsProperty DTStamp where
    printProperty :: DTStamp -> RWS EncodingFunctions Builder Int ()
printProperty DTStamp
x = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> DTStamp -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DTSTAMP" DTStamp
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DTStamp -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DTStamp
x

instance IsProperty UID where
    printProperty :: UID -> RWS EncodingFunctions Builder Int ()
printProperty UID {Text
OtherParams
uidValue :: Text
uidOther :: OtherParams
uidValue :: UID -> Text
uidOther :: UID -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"UID" OtherParams
uidOther RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
uidValue

instance IsProperty DTStart where
    printProperty :: DTStart -> RWS EncodingFunctions Builder Int ()
printProperty DTStart
x = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> DTStart -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DTSTART" DTStart
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DTStart -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DTStart
x

instance IsProperty Class where
    printProperty :: Class -> RWS EncodingFunctions Builder Int ()
printProperty c :: Class
c@Class {ClassValue
OtherParams
classValue :: ClassValue
classOther :: OtherParams
classValue :: Class -> ClassValue
classOther :: Class -> OtherParams
..} | Class
c Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
forall a. Default a => a
def = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                               | Bool
otherwise = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"CLASS" OtherParams
classOther
                                                     ClassValue -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ClassValue
classValue

instance IsProperty Created where
    printProperty :: Created -> RWS EncodingFunctions Builder Int ()
printProperty Created {UTCTime
OtherParams
createdValue :: UTCTime
createdOther :: OtherParams
createdValue :: Created -> UTCTime
createdOther :: Created -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"CREATED" OtherParams
createdOther
        UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
createdValue

instance IsProperty Description  where
    printProperty :: Description -> RWS EncodingFunctions Builder Int ()
printProperty Description {Maybe URI
Maybe Language
Text
OtherParams
descriptionValue :: Text
descriptionAltRep :: Maybe URI
descriptionLanguage :: Maybe Language
descriptionOther :: OtherParams
descriptionValue :: Description -> Text
descriptionAltRep :: Description -> Maybe URI
descriptionLanguage :: Description -> Maybe Language
descriptionOther :: Description -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"DESCRIPTION" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
descriptionAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                             Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
descriptionLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                             OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
descriptionOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
descriptionValue

instance IsProperty Geo where
    printProperty :: Geo -> RWS EncodingFunctions Builder Int ()
printProperty Geo {Float
OtherParams
geoLat :: Float
geoLong :: Float
geoOther :: OtherParams
geoLat :: Geo -> Float
geoLong :: Geo -> Float
geoOther :: Geo -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"GEO" OtherParams
geoOther
        Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> Float -> Float -> String
forall r. PrintfType r => String -> r
printf String
"%.6f;%.6f" Float
geoLat Float
geoLong

instance IsProperty LastModified where
    printProperty :: LastModified -> RWS EncodingFunctions Builder Int ()
printProperty LastModified {UTCTime
OtherParams
lastModifiedValue :: UTCTime
lastModifiedOther :: OtherParams
lastModifiedValue :: LastModified -> UTCTime
lastModifiedOther :: LastModified -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"LAST-MODIFIED" OtherParams
lastModifiedOther
        UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
lastModifiedValue

instance IsProperty Location where
    printProperty :: Location -> RWS EncodingFunctions Builder Int ()
printProperty Location {Maybe URI
Maybe Language
Text
OtherParams
locationValue :: Text
locationAltRep :: Maybe URI
locationLanguage :: Maybe Language
locationOther :: OtherParams
locationValue :: Location -> Text
locationAltRep :: Location -> Maybe URI
locationLanguage :: Location -> Maybe Language
locationOther :: Location -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"LOCATION" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
locationAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                          Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
locationLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
locationOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
locationValue

instance IsProperty Organizer where
    printProperty :: Organizer -> RWS EncodingFunctions Builder Int ()
printProperty Organizer {Maybe URI
Maybe Text
Maybe Language
URI
OtherParams
organizerValue :: URI
organizerCN :: Maybe Text
organizerDir :: Maybe URI
organizerSentBy :: Maybe URI
organizerLanguage :: Maybe Language
organizerOther :: OtherParams
organizerValue :: Organizer -> URI
organizerCN :: Organizer -> Maybe Text
organizerDir :: Organizer -> Maybe URI
organizerSentBy :: Organizer -> Maybe URI
organizerLanguage :: Organizer -> Maybe Language
organizerOther :: Organizer -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"ORGANIZER" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe CN -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Text -> CN
CN (Text -> CN) -> Maybe Text -> Maybe CN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
organizerCN) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                           Maybe Dir -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> Dir
Dir (URI -> Dir) -> Maybe URI -> Maybe Dir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
organizerDir) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                           Maybe SentBy -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> SentBy
SentBy (URI -> SentBy) -> Maybe URI -> Maybe SentBy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
organizerSentBy) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                           Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
organizerLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
organizerOther
        URI -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow URI
organizerValue

instance IsProperty Priority where
    printProperty :: Priority -> RWS EncodingFunctions Builder Int ()
printProperty Priority
x | Priority
x Priority -> Priority -> Bool
forall a. Eq a => a -> a -> Bool
== Priority
forall a. Default a => a
def = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"PRIORITY" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Priority -> OtherParams
priorityOther Priority
x
                                          Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow (Int -> RWS EncodingFunctions Builder Int ())
-> Int -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Priority -> Int
priorityValue Priority
x

instance IsProperty Sequence where
    printProperty :: Sequence -> RWS EncodingFunctions Builder Int ()
printProperty Sequence
x | Sequence
x Sequence -> Sequence -> Bool
forall a. Eq a => a -> a -> Bool
== Sequence
forall a. Default a => a
def = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"SEQUENCE" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Sequence -> OtherParams
sequenceOther Sequence
x
                                          Integer -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow (Integer -> RWS EncodingFunctions Builder Int ())
-> Integer -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Sequence -> Integer
sequenceValue Sequence
x
instance IsProperty EventStatus where
    printProperty :: EventStatus -> RWS EncodingFunctions Builder Int ()
printProperty EventStatus
s = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"STATUS" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ EventStatus -> OtherParams
eventStatusOther EventStatus
s
                              EventStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue EventStatus
s

instance IsProperty TodoStatus where
    printProperty :: TodoStatus -> RWS EncodingFunctions Builder Int ()
printProperty TodoStatus
s = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"STATUS" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TodoStatus -> OtherParams
todoStatusOther TodoStatus
s
                              TodoStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue TodoStatus
s

instance IsProperty JournalStatus where
    printProperty :: JournalStatus -> RWS EncodingFunctions Builder Int ()
printProperty JournalStatus
s = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"STATUS" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ JournalStatus -> OtherParams
journalStatusOther JournalStatus
s
                              JournalStatus -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue JournalStatus
s

instance IsProperty Summary where
    printProperty :: Summary -> RWS EncodingFunctions Builder Int ()
printProperty Summary {Maybe URI
Maybe Language
Text
OtherParams
summaryValue :: Text
summaryAltRep :: Maybe URI
summaryLanguage :: Maybe Language
summaryOther :: OtherParams
summaryValue :: Summary -> Text
summaryAltRep :: Summary -> Maybe URI
summaryLanguage :: Summary -> Maybe Language
summaryOther :: Summary -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"SUMMARY" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
summaryAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                         Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
summaryLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
summaryOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
summaryValue

instance IsProperty TimeTransparency where
    printProperty :: TimeTransparency -> RWS EncodingFunctions Builder Int ()
printProperty TimeTransparency
x | TimeTransparency
x TimeTransparency -> TimeTransparency -> Bool
forall a. Eq a => a -> a -> Bool
== TimeTransparency
forall a. Default a => a
def = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
                        ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TRANSP" (OtherParams -> RWS EncodingFunctions Builder Int ())
-> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ TimeTransparency -> OtherParams
timeTransparencyOther TimeTransparency
x
                        TimeTransparency -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue TimeTransparency
x

instance IsProperty URL where
    printProperty :: URL -> RWS EncodingFunctions Builder Int ()
printProperty URL {URI
OtherParams
urlValue :: URI
urlOther :: OtherParams
urlValue :: URL -> URI
urlOther :: URL -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"URL" OtherParams
urlOther RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> URI -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow URI
urlValue

instance IsProperty RecurrenceId where
    printProperty :: RecurrenceId -> RWS EncodingFunctions Builder Int ()
printProperty RecurrenceId
r = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RecurrenceId -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"RECURRENCE-ID" RecurrenceId
r RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RecurrenceId -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue RecurrenceId
r

instance IsProperty RRule where
    printProperty :: RRule -> RWS EncodingFunctions Builder Int ()
printProperty RRule {Recur
OtherParams
rRuleValue :: Recur
rRuleOther :: OtherParams
rRuleValue :: RRule -> Recur
rRuleOther :: RRule -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do ByteString -> OtherParams -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"RRULE" OtherParams
rRuleOther
                                       Recur -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Recur
rRuleValue

instance IsProperty Attachment where
    printProperty :: Attachment -> RWS EncodingFunctions Builder Int ()
printProperty Attachment
a = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Attachment -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"ATTACH" Attachment
a RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attachment -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Attachment
a

instance IsProperty Attendee where
    printProperty :: Attendee -> RWS EncodingFunctions Builder Int ()
printProperty att :: Attendee
att@Attendee {Bool
Maybe URI
Maybe Text
Maybe Language
Set URI
URI
PartStat
Role
CUType
OtherParams
attendeeValue :: URI
attendeeCUType :: CUType
attendeeMember :: Set URI
attendeeRole :: Role
attendeePartStat :: PartStat
attendeeRSVP :: Bool
attendeeDelTo :: Set URI
attendeeDelFrom :: Set URI
attendeeSentBy :: Maybe URI
attendeeCN :: Maybe Text
attendeeDir :: Maybe URI
attendeeLanguage :: Maybe Language
attendeeOther :: OtherParams
attendeeValue :: Attendee -> URI
attendeeCUType :: Attendee -> CUType
attendeeMember :: Attendee -> Set URI
attendeeRole :: Attendee -> Role
attendeePartStat :: Attendee -> PartStat
attendeeRSVP :: Attendee -> Bool
attendeeDelTo :: Attendee -> Set URI
attendeeDelFrom :: Attendee -> Set URI
attendeeSentBy :: Attendee -> Maybe URI
attendeeCN :: Attendee -> Maybe Text
attendeeDir :: Attendee -> Maybe URI
attendeeLanguage :: Attendee -> Maybe Language
attendeeOther :: Attendee -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Attendee -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"ATTENDEE" Attendee
att
        URI -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue URI
attendeeValue

instance IsProperty Categories where
    printProperty :: Categories -> RWS EncodingFunctions Builder Int ()
printProperty Categories {Maybe Language
Set Text
OtherParams
categoriesValues :: Set Text
categoriesLanguage :: Maybe Language
categoriesOther :: OtherParams
categoriesValues :: Categories -> Set Text
categoriesLanguage :: Categories -> Maybe Language
categoriesOther :: Categories -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"CATEGORIES" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
categoriesOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
categoriesLanguage
        [Text] -> RWS EncodingFunctions Builder Int ()
texts ([Text] -> RWS EncodingFunctions Builder Int ())
-> [Text] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
categoriesValues

instance IsProperty Comment where
    printProperty :: Comment -> RWS EncodingFunctions Builder Int ()
printProperty Comment {Maybe URI
Maybe Language
Text
OtherParams
commentValue :: Text
commentAltRep :: Maybe URI
commentLanguage :: Maybe Language
commentOther :: OtherParams
commentValue :: Comment -> Text
commentAltRep :: Comment -> Maybe URI
commentLanguage :: Comment -> Maybe Language
commentOther :: Comment -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"COMMENT" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
commentAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                         Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
commentLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                         OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
commentOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
commentValue

instance IsProperty Contact where
    printProperty :: Contact -> RWS EncodingFunctions Builder Int ()
printProperty Contact {Maybe URI
Maybe Language
Text
OtherParams
contactValue :: Text
contactAltRep :: Maybe URI
contactLanguage :: Maybe Language
contactOther :: OtherParams
contactValue :: Contact -> Text
contactAltRep :: Contact -> Maybe URI
contactLanguage :: Contact -> Maybe Language
contactOther :: Contact -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"CONTACT" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
contactAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                         Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
contactLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                         OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
contactOther
        Text -> RWS EncodingFunctions Builder Int ()
text Text
contactValue

instance IsProperty ExDate where
    printProperty :: ExDate -> RWS EncodingFunctions Builder Int ()
printProperty ExDate
exd = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> ExDate -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"EXDATE" ExDate
exd
        case ExDate
exd of
             ExDates {Set Date
OtherParams
exDates :: Set Date
exDateOther :: OtherParams
exDates :: ExDate -> Set Date
exDateOther :: ExDate -> OtherParams
..} -> (Date -> RWS EncodingFunctions Builder Int ())
-> [Date] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([Date] -> RWS EncodingFunctions Builder Int ())
-> [Date] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set Date -> [Date]
forall a. Set a -> [a]
S.toList Set Date
exDates
             ExDateTimes {Set DateTime
OtherParams
exDateOther :: ExDate -> OtherParams
exDateTimes :: Set DateTime
exDateOther :: OtherParams
exDateTimes :: ExDate -> Set DateTime
..} -> (DateTime -> RWS EncodingFunctions Builder Int ())
-> [DateTime] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([DateTime] -> RWS EncodingFunctions Builder Int ())
-> [DateTime] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set DateTime -> [DateTime]
forall a. Set a -> [a]
S.toList Set DateTime
exDateTimes

instance IsProperty RequestStatus where
    printProperty :: RequestStatus -> RWS EncodingFunctions Builder Int ()
printProperty RequestStatus {[Int]
Maybe Text
Maybe Language
Text
OtherParams
requestStatusCode :: [Int]
requestStatusDesc :: Text
requestStatusLanguage :: Maybe Language
requestStatusExt :: Maybe Text
requestStatusOther :: OtherParams
requestStatusCode :: RequestStatus -> [Int]
requestStatusDesc :: RequestStatus -> Text
requestStatusLanguage :: RequestStatus -> Maybe Language
requestStatusExt :: RequestStatus -> Maybe Text
requestStatusOther :: RequestStatus -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"REQUEST-STATUS" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
requestStatusLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
requestStatusOther
        (\[Int]
z -> case [Int]
z of
                    (Int
x:[Int]
xs) -> do Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
x
                                 [RWS EncodingFunctions Builder Int ()]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Char -> RWS EncodingFunctions Builder Int ()
putc Char
'.' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
y | Int
y <- [Int]
xs]
                    [] -> () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [Int]
requestStatusCode
        Char -> RWS EncodingFunctions Builder Int ()
putc Char
';'
        Text -> RWS EncodingFunctions Builder Int ()
text Text
requestStatusDesc
        Maybe Text
-> (Text -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
requestStatusExt ((Text -> RWS EncodingFunctions Builder Int ())
 -> RWS EncodingFunctions Builder Int ())
-> (Text -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ \Text
x -> Char -> RWS EncodingFunctions Builder Int ()
putc Char
';' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
x

instance IsProperty RelatedTo where
    printProperty :: RelatedTo -> RWS EncodingFunctions Builder Int ()
printProperty RelatedTo {Text
RelationshipType
OtherParams
relatedToValue :: Text
relatedToType :: RelationshipType
relatedToOther :: OtherParams
relatedToValue :: RelatedTo -> Text
relatedToType :: RelatedTo -> RelationshipType
relatedToOther :: RelatedTo -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"RELATED-TO" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
relatedToOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> RelationshipType -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam RelationshipType
relatedToType
        Text -> RWS EncodingFunctions Builder Int ()
text Text
relatedToValue

instance IsProperty Resources where
    printProperty :: Resources -> RWS EncodingFunctions Builder Int ()
printProperty Resources {Maybe URI
Maybe Language
Set Text
OtherParams
resourcesValue :: Set Text
resourcesAltRep :: Maybe URI
resourcesLanguage :: Maybe Language
resourcesOther :: OtherParams
resourcesValue :: Resources -> Set Text
resourcesAltRep :: Resources -> Maybe URI
resourcesLanguage :: Resources -> Maybe Language
resourcesOther :: Resources -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"RESOURCES" ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Maybe AltRep -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> AltRep
AltRep (URI -> AltRep) -> Maybe URI -> Maybe AltRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
resourcesAltRep) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                           Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
resourcesLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
resourcesOther
        [Text] -> RWS EncodingFunctions Builder Int ()
texts ([Text] -> RWS EncodingFunctions Builder Int ())
-> [Text] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
resourcesValue

instance IsProperty RDate where
    printProperty :: RDate -> RWS EncodingFunctions Builder Int ()
printProperty RDate
r = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RDate -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"RDATE" RDate
r RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RDate -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue RDate
r

instance IsProperty OtherProperty where
    printProperty :: OtherProperty -> RWS EncodingFunctions Builder Int ()
printProperty OtherProperty {ByteString
CI Text
OtherParams
otherName :: CI Text
otherValue :: ByteString
otherParams :: OtherParams
otherName :: OtherProperty -> CI Text
otherValue :: OtherProperty -> ByteString
otherParams :: OtherProperty -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> RWS EncodingFunctions Builder Int ()
out (CI Text -> Text
forall s. CI s -> s
CI.original CI Text
otherName)
        ((Text, [(Quoting, Text)]) -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, [(Quoting, Text)]) -> RWS EncodingFunctions Builder Int ()
param ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
otherParams
        Text -> RWS EncodingFunctions Builder Int ()
out Text
":"
        ByteString -> RWS EncodingFunctions Builder Int ()
bytestring ByteString
otherValue

instance IsProperty Trigger where
    printProperty :: Trigger -> RWS EncodingFunctions Builder Int ()
printProperty tr :: Trigger
tr@TriggerDuration {AlarmTriggerRelationship
Duration
OtherParams
triggerDuration :: Duration
triggerRelated :: AlarmTriggerRelationship
triggerOther :: OtherParams
triggerDuration :: Trigger -> Duration
triggerRelated :: Trigger -> AlarmTriggerRelationship
triggerOther :: Trigger -> OtherParams
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Trigger -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TRIGGER" Trigger
tr
        Duration -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Duration
triggerDuration
    printProperty tr :: Trigger
tr@TriggerDateTime {UTCTime
OtherParams
triggerOther :: Trigger -> OtherParams
triggerDateTime :: UTCTime
triggerOther :: OtherParams
triggerDateTime :: Trigger -> UTCTime
..} = RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> Trigger -> RWS EncodingFunctions Builder Int ()
forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
"TRIGGER" Trigger
tr
        UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
triggerDateTime


-- | Print a generic property.
prop :: ToParam a
     => ByteString
     -> a
     -> ContentPrinter ()
prop :: forall a.
ToParam a =>
ByteString -> a -> RWS EncodingFunctions Builder Int ()
prop ByteString
b a
x = do
    Int -> RWS EncodingFunctions Builder Int ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BS.length ByteString
b)
    Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ByteString -> Builder
Bu.lazyByteString ByteString
b)
    ((Text, [(Quoting, Text)]) -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, [(Quoting, Text)]) -> RWS EncodingFunctions Builder Int ()
param ([(Text, [(Quoting, Text)])]
 -> RWS EncodingFunctions Builder Int ())
-> [(Text, [(Quoting, Text)])]
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ a -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam a
x
    Text -> RWS EncodingFunctions Builder Int ()
out Text
":"

-- }}}
-- {{{ Parameter "printers".

class ToParam a where
    toParam :: a -> [(Text, [(Quoting, Text)])]

instance ToParam a => ToParam (Maybe a) where
    toParam :: Maybe a -> [(Text, [(Quoting, Text)])]
toParam Maybe a
Nothing = []
    toParam (Just a
x) = a -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam a
x

instance ToParam a => ToParam (Set a) where
    toParam :: Set a -> [(Text, [(Quoting, Text)])]
toParam Set a
s = case Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.maxView Set a
s of
                     Maybe (a, Set a)
Nothing -> []
                     Just (a
x, Set a
_) -> a -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam a
x

instance ToParam ExDate where
    toParam :: ExDate -> [(Text, [(Quoting, Text)])]
toParam ExDates {Set Date
OtherParams
exDates :: ExDate -> Set Date
exDateOther :: ExDate -> OtherParams
exDates :: Set Date
exDateOther :: OtherParams
..} = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                           OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
exDateOther
    toParam ExDateTimes {Set DateTime
OtherParams
exDateOther :: ExDate -> OtherParams
exDateTimes :: ExDate -> Set DateTime
exDateTimes :: Set DateTime
exDateOther :: OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
exDateOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                               Maybe DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam ((DateTime, Set DateTime) -> DateTime
forall a b. (a, b) -> a
fst ((DateTime, Set DateTime) -> DateTime)
-> Maybe (DateTime, Set DateTime) -> Maybe DateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set DateTime -> Maybe (DateTime, Set DateTime)
forall a. Set a -> Maybe (a, Set a)
S.maxView Set DateTime
exDateTimes)

instance ToParam AltRep where
    toParam :: AltRep -> [(Text, [(Quoting, Text)])]
toParam (AltRep URI
x) = [(Text
"ALTREP", [(Quoting
NeedQuotes, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
x)])]

instance ToParam SentBy where
    toParam :: SentBy -> [(Text, [(Quoting, Text)])]
toParam (SentBy URI
x) = [(Text
"SENT-BY", [(Quoting
NeedQuotes, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
x)])]

instance ToParam Dir where
    toParam :: Dir -> [(Text, [(Quoting, Text)])]
toParam (Dir URI
x) = [(Text
"DIR", [(Quoting
NeedQuotes, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ URI -> String
forall a. Show a => a -> String
show URI
x)])]

instance ToParam DateTime where
    toParam :: DateTime -> [(Text, [(Quoting, Text)])]
toParam ZonedDateTime {Text
LocalTime
dateTimeFloating :: LocalTime
dateTimeZone :: Text
dateTimeFloating :: DateTime -> LocalTime
dateTimeZone :: DateTime -> Text
..} = [(Text
"TZID", [(Quoting
NoQuotes, Text
dateTimeZone)])]
    toParam DateTime
_ = []

instance ToParam DTEnd where
    toParam :: DTEnd -> [(Text, [(Quoting, Text)])]
toParam DTEndDateTime {DateTime
OtherParams
dtEndDateTimeValue :: DateTime
dtEndOther :: OtherParams
dtEndDateTimeValue :: DTEnd -> DateTime
dtEndOther :: DTEnd -> OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dtEndOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                 DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
dtEndDateTimeValue
    toParam DTEndDate {Date
OtherParams
dtEndOther :: DTEnd -> OtherParams
dtEndDateValue :: Date
dtEndOther :: OtherParams
dtEndDateValue :: DTEnd -> Date
..}     = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                 OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dtEndOther

instance ToParam Due where
    toParam :: Due -> [(Text, [(Quoting, Text)])]
toParam DueDateTime {DateTime
OtherParams
dueDateTimeValue :: DateTime
dueOther :: OtherParams
dueDateTimeValue :: Due -> DateTime
dueOther :: Due -> OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dueOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
dueDateTimeValue
    toParam DueDate {Date
OtherParams
dueOther :: Due -> OtherParams
dueDateValue :: Date
dueOther :: OtherParams
dueDateValue :: Due -> Date
..}     = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                               OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dueOther

instance ToParam CN where
    toParam :: CN -> [(Text, [(Quoting, Text)])]
toParam (CN Text
x) = [(Text
"CN", [(Quoting
Optional, Text
x)])]

instance ToParam DTStart where
    toParam :: DTStart -> [(Text, [(Quoting, Text)])]
toParam DTStartDateTime {DateTime
OtherParams
dtStartDateTimeValue :: DateTime
dtStartOther :: OtherParams
dtStartDateTimeValue :: DTStart -> DateTime
dtStartOther :: DTStart -> OtherParams
..} = DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
dtStartDateTimeValue [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                   OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dtStartOther
    toParam DTStartDate {Date
OtherParams
dtStartOther :: DTStart -> OtherParams
dtStartDateValue :: Date
dtStartOther :: OtherParams
dtStartDateValue :: DTStart -> Date
..} = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                               OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dtStartOther

instance ToParam RDate where
    toParam :: RDate -> [(Text, [(Quoting, Text)])]
toParam RDateDates {Set Date
OtherParams
rDateDates :: Set Date
rDateOther :: OtherParams
rDateDates :: RDate -> Set Date
rDateOther :: RDate -> OtherParams
..} = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                              OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
rDateOther
    toParam RDatePeriods {Set Period
OtherParams
rDateOther :: RDate -> OtherParams
rDatePeriods :: Set Period
rDateOther :: OtherParams
rDatePeriods :: RDate -> Set Period
..} = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"PERIOD")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
rDateOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                Maybe Period -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam ((Period, Set Period) -> Period
forall a b. (a, b) -> a
fst ((Period, Set Period) -> Period)
-> Maybe (Period, Set Period) -> Maybe Period
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Period -> Maybe (Period, Set Period)
forall a. Set a -> Maybe (a, Set a)
S.maxView Set Period
rDatePeriods)
    toParam RDateDateTimes {Set DateTime
OtherParams
rDateOther :: RDate -> OtherParams
rDateDateTimes :: Set DateTime
rDateOther :: OtherParams
rDateDateTimes :: RDate -> Set DateTime
..} = Set DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Set DateTime
rDateDateTimes [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
rDateOther

instance ToParam Period where
    toParam :: Period -> [(Text, [(Quoting, Text)])]
toParam (PeriodDates DateTime
x DateTime
_) = DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
x
    toParam (PeriodDuration DateTime
x Duration
_) = DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
x

instance ToParam DTStamp where
    toParam :: DTStamp -> [(Text, [(Quoting, Text)])]
toParam DTStamp {UTCTime
OtherParams
dtStampValue :: UTCTime
dtStampOther :: OtherParams
dtStampValue :: DTStamp -> UTCTime
dtStampOther :: DTStamp -> OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
dtStampOther

instance ToParam OtherParams where
    toParam :: OtherParams -> [(Text, [(Quoting, Text)])]
toParam (OtherParams Set OtherParam
l) = OtherParam -> (Text, [(Quoting, Text)])
fromOP (OtherParam -> (Text, [(Quoting, Text)]))
-> [OtherParam] -> [(Text, [(Quoting, Text)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set OtherParam -> [OtherParam]
forall a. Set a -> [a]
S.toList Set OtherParam
l
      where fromOP :: OtherParam -> (Text, [(Quoting, Text)])
fromOP (OtherParam CI Text
x [Text]
y) = (CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x, (Quoting
Optional,) (Text -> (Quoting, Text)) -> [Text] -> [(Quoting, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
y)

instance ToParam Language where
    toParam :: Language -> [(Text, [(Quoting, Text)])]
toParam (Language CI Text
x) = [(Text
"LANGUAGE", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam TZName where
    toParam :: TZName -> [(Text, [(Quoting, Text)])]
toParam TZName {Maybe Language
Text
OtherParams
tzNameValue :: TZName -> Text
tzNameLanguage :: TZName -> Maybe Language
tzNameOther :: TZName -> OtherParams
tzNameValue :: Text
tzNameLanguage :: Maybe Language
tzNameOther :: OtherParams
..} = Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
tzNameLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<> OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
tzNameOther

instance ToParam x => ToParam [x] where
    toParam :: [x] -> [(Text, [(Quoting, Text)])]
toParam = [[(Text, [(Quoting, Text)])]] -> [(Text, [(Quoting, Text)])]
forall a. Monoid a => [a] -> a
mconcat ([[(Text, [(Quoting, Text)])]] -> [(Text, [(Quoting, Text)])])
-> ([x] -> [[(Text, [(Quoting, Text)])]])
-> [x]
-> [(Text, [(Quoting, Text)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> [(Text, [(Quoting, Text)])])
-> [x] -> [[(Text, [(Quoting, Text)])]]
forall a b. (a -> b) -> [a] -> [b]
map x -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam

instance ToParam (Text, [(Quoting, Text)]) where
    toParam :: (Text, [(Quoting, Text)]) -> [(Text, [(Quoting, Text)])]
toParam = ((Text, [(Quoting, Text)])
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. a -> [a] -> [a]
:[])

instance ToParam RecurrenceId where
    toParam :: RecurrenceId -> [(Text, [(Quoting, Text)])]
toParam RecurrenceIdDate {Maybe Range
Date
OtherParams
recurrenceIdDate :: Date
recurrenceIdRange :: Maybe Range
recurrenceIdOther :: OtherParams
recurrenceIdDate :: RecurrenceId -> Date
recurrenceIdRange :: RecurrenceId -> Maybe Range
recurrenceIdOther :: RecurrenceId -> OtherParams
..} = [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE")])] [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                    Maybe Range -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Range
recurrenceIdRange [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                    OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
recurrenceIdOther
    toParam RecurrenceIdDateTime {Maybe Range
DateTime
OtherParams
recurrenceIdRange :: RecurrenceId -> Maybe Range
recurrenceIdOther :: RecurrenceId -> OtherParams
recurrenceIdDateTime :: DateTime
recurrenceIdRange :: Maybe Range
recurrenceIdOther :: OtherParams
recurrenceIdDateTime :: RecurrenceId -> DateTime
..} = DateTime -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam DateTime
recurrenceIdDateTime [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                        Maybe Range -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Range
recurrenceIdRange [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                        OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
recurrenceIdOther

instance ToParam Range where
    toParam :: Range -> [(Text, [(Quoting, Text)])]
toParam Range
ThisAndFuture = [(Text
"RANGE", [(Quoting
NoQuotes, Text
"THISANDFUTURE")])]
    toParam Range
_ = [] -- ThisAndPrior MUST NOT be generated.

instance ToParam FBType where
    toParam :: FBType -> [(Text, [(Quoting, Text)])]
toParam FBType
x | FBType
x FBType -> FBType -> Bool
forall a. Eq a => a -> a -> Bool
== FBType
forall a. Default a => a
def    = []
    toParam FBType
Free            = [(Text
"FBTYPE", [(Quoting
NoQuotes, Text
"FREE")])]
    toParam FBType
Busy            = [(Text
"FBTYPE", [(Quoting
NoQuotes, Text
"BUSY")])]
    toParam FBType
BusyUnavailable = [(Text
"FBTYPE", [(Quoting
NoQuotes, Text
"BUSY-UNAVAILABLE")])]
    toParam FBType
BusyTentative   = [(Text
"FBTYPE", [(Quoting
NoQuotes, Text
"BUSY-TENTATIVE")])]
    toParam (FBTypeX CI Text
x)     = [(Text
"FBTYPE", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam MIMEType where
    toParam :: MIMEType -> [(Text, [(Quoting, Text)])]
toParam MIMEType
m = [(Text
"FMTTYPE", [(Quoting
NoQuotes, Text -> Text
T.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MIMEType -> Text
showMIMEType MIMEType
m)])]

instance ToParam Attachment where
    toParam :: Attachment -> [(Text, [(Quoting, Text)])]
toParam UriAttachment {Maybe MIMEType
URI
OtherParams
attachFmtType :: Maybe MIMEType
attachUri :: URI
attachOther :: OtherParams
attachFmtType :: Attachment -> Maybe MIMEType
attachUri :: Attachment -> URI
attachOther :: Attachment -> OtherParams
..} = Maybe MIMEType -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe MIMEType
attachFmtType [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                 OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
attachOther
    toParam BinaryAttachment {Maybe MIMEType
ByteString
OtherParams
attachFmtType :: Attachment -> Maybe MIMEType
attachOther :: Attachment -> OtherParams
attachFmtType :: Maybe MIMEType
attachContent :: ByteString
attachOther :: OtherParams
attachContent :: Attachment -> ByteString
..} = Maybe MIMEType -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe MIMEType
attachFmtType [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                    OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
attachOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                    [ (Text
"VALUE", [(Quoting
NoQuotes, Text
"BINARY")])
                                    , (Text
"ENCODING", [(Quoting
NoQuotes, Text
"BASE64")])]

instance ToParam CUType where
    toParam :: CUType -> [(Text, [(Quoting, Text)])]
toParam CUType
x | CUType
x CUType -> CUType -> Bool
forall a. Eq a => a -> a -> Bool
== CUType
forall a. Default a => a
def = []
    toParam CUType
Individual   = [(Text
"CUTYPE", [(Quoting
NoQuotes, Text
"INDIVIDUAL")])]
    toParam CUType
Group        = [(Text
"CUTYPE", [(Quoting
NoQuotes, Text
"GROUP")])]
    toParam CUType
Resource     = [(Text
"CUTYPE", [(Quoting
NoQuotes, Text
"RESOURCE")])]
    toParam CUType
Room         = [(Text
"CUTYPE", [(Quoting
NoQuotes, Text
"ROOM")])]
    toParam CUType
Unknown      = [(Text
"CUTYPE", [(Quoting
NoQuotes, Text
"UNKNOWN")])]
    toParam (CUTypeX CI Text
x)  = [(Text
"CUTYPE", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam Member where
    toParam :: Member -> [(Text, [(Quoting, Text)])]
toParam (Member Set URI
x) | Set URI -> Bool
forall a. Set a -> Bool
S.null Set URI
x = []
    toParam (Member Set URI
x) = [( Text
"MEMBER"
                          , (Quoting
NeedQuotes,) (Text -> (Quoting, Text))
-> (URI -> Text) -> URI -> (Quoting, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show (URI -> (Quoting, Text)) -> [URI] -> [(Quoting, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set URI -> [URI]
forall a. Set a -> [a]
S.toList Set URI
x)]

instance ToParam Role where
    toParam :: Role -> [(Text, [(Quoting, Text)])]
toParam Role
x | Role
x Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
forall a. Default a => a
def   = []
    toParam Role
Chair          = [(Text
"ROLE", [(Quoting
NoQuotes, Text
"CHAIR")])]
    toParam Role
ReqParticipant = [(Text
"ROLE", [(Quoting
NoQuotes, Text
"REQ-PARTICIPANT")])]
    toParam Role
OptParticipant = [(Text
"ROLE", [(Quoting
NoQuotes, Text
"OPT-PARTICIPANT")])]
    toParam Role
NonParticipant = [(Text
"ROLE", [(Quoting
NoQuotes, Text
"NON-PARTICIPANT")])]
    toParam (RoleX CI Text
x)      = [(Text
"ROLE", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam PartStat where
    toParam :: PartStat -> [(Text, [(Quoting, Text)])]
toParam PartStat
x | PartStat
x PartStat -> PartStat -> Bool
forall a. Eq a => a -> a -> Bool
== PartStat
forall a. Default a => a
def        = []
    toParam PartStat
PartStatNeedsAction = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"NEEDS-ACTION")])]
    toParam PartStat
Accepted            = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"ACCEPTED")])]
    toParam PartStat
Declined            = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"DECLINED")])]
    toParam PartStat
Tentative           = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"TENTATIVE")])]
    toParam PartStat
Delegated           = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"DELEGATED")])]
    toParam PartStat
PartStatCompleted   = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"COMPLETED")])]
    toParam PartStat
InProcess           = [(Text
"PARTSTAT", [(Quoting
NoQuotes, Text
"IN-PROCESS")])]
    toParam (PartStatX CI Text
x)       = [(Text
"PARTSTAT", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam RelationshipType where
    toParam :: RelationshipType -> [(Text, [(Quoting, Text)])]
toParam RelationshipType
x | RelationshipType
x RelationshipType -> RelationshipType -> Bool
forall a. Eq a => a -> a -> Bool
== RelationshipType
forall a. Default a => a
def          = []
    toParam RelationshipType
Parent                = [(Text
"RELTYPE", [(Quoting
NoQuotes, Text
"PARENT")])]
    toParam RelationshipType
Child                 = [(Text
"RELTYPE", [(Quoting
NoQuotes, Text
"CHILD")])]
    toParam RelationshipType
Sibling               = [(Text
"RELTYPE", [(Quoting
NoQuotes, Text
"SIBLING")])]
    toParam (RelationshipTypeX CI Text
x) = [(Text
"RELTYPE", [(Quoting
Optional, CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x)])]

instance ToParam RSVP where
    toParam :: RSVP -> [(Text, [(Quoting, Text)])]
toParam (RSVP Bool
False) = []
    toParam (RSVP Bool
True)  = [(Text
"RSVP", [(Quoting
NoQuotes, Text
"TRUE")])]

instance ToParam DelTo where
    toParam :: DelTo -> [(Text, [(Quoting, Text)])]
toParam (DelTo Set URI
x) | Set URI -> Bool
forall a. Set a -> Bool
S.null Set URI
x = []
                      | Bool
otherwise = [( Text
"DELEGATED-TO"
                                     , (Quoting
NeedQuotes,) (Text -> (Quoting, Text))
-> (URI -> Text) -> URI -> (Quoting, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show
                                                    (URI -> (Quoting, Text)) -> [URI] -> [(Quoting, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set URI -> [URI]
forall a. Set a -> [a]
S.toList Set URI
x)]

instance ToParam DelFrom where
    toParam :: DelFrom -> [(Text, [(Quoting, Text)])]
toParam (DelFrom Set URI
x) | Set URI -> Bool
forall a. Set a -> Bool
S.null Set URI
x = []
                        | Bool
otherwise = [( Text
"DELEGATED-FROM"
                                       , (Quoting
NeedQuotes,) (Text -> (Quoting, Text))
-> (URI -> Text) -> URI -> (Quoting, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show
                                             (URI -> (Quoting, Text)) -> [URI] -> [(Quoting, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set URI -> [URI]
forall a. Set a -> [a]
S.toList Set URI
x)]

instance ToParam Attendee where
    toParam :: Attendee -> [(Text, [(Quoting, Text)])]
toParam Attendee {Bool
Maybe URI
Maybe Text
Maybe Language
Set URI
URI
PartStat
Role
CUType
OtherParams
attendeeValue :: Attendee -> URI
attendeeCUType :: Attendee -> CUType
attendeeMember :: Attendee -> Set URI
attendeeRole :: Attendee -> Role
attendeePartStat :: Attendee -> PartStat
attendeeRSVP :: Attendee -> Bool
attendeeDelTo :: Attendee -> Set URI
attendeeDelFrom :: Attendee -> Set URI
attendeeSentBy :: Attendee -> Maybe URI
attendeeCN :: Attendee -> Maybe Text
attendeeDir :: Attendee -> Maybe URI
attendeeLanguage :: Attendee -> Maybe Language
attendeeOther :: Attendee -> OtherParams
attendeeValue :: URI
attendeeCUType :: CUType
attendeeMember :: Set URI
attendeeRole :: Role
attendeePartStat :: PartStat
attendeeRSVP :: Bool
attendeeDelTo :: Set URI
attendeeDelFrom :: Set URI
attendeeSentBy :: Maybe URI
attendeeCN :: Maybe Text
attendeeDir :: Maybe URI
attendeeLanguage :: Maybe Language
attendeeOther :: OtherParams
..} = CUType -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam CUType
attendeeCUType [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Member -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Set URI -> Member
Member Set URI
attendeeMember) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Role -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Role
attendeeRole [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            PartStat -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam PartStat
attendeePartStat [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            RSVP -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Bool -> RSVP
RSVP Bool
attendeeRSVP) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            DelTo -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Set URI -> DelTo
DelTo Set URI
attendeeDelTo) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            DelFrom -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Set URI -> DelFrom
DelFrom Set URI
attendeeDelFrom) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Maybe SentBy -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> SentBy
SentBy (URI -> SentBy) -> Maybe URI -> Maybe SentBy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
attendeeSentBy) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Maybe CN -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (Text -> CN
CN (Text -> CN) -> Maybe Text -> Maybe CN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
attendeeCN) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Maybe Dir -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam (URI -> Dir
Dir (URI -> Dir) -> Maybe URI -> Maybe Dir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe URI
attendeeDir) [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            Maybe Language -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam Maybe Language
attendeeLanguage [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                            OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
attendeeOther

instance ToParam AlarmTriggerRelationship where
    toParam :: AlarmTriggerRelationship -> [(Text, [(Quoting, Text)])]
toParam AlarmTriggerRelationship
x | AlarmTriggerRelationship
x AlarmTriggerRelationship -> AlarmTriggerRelationship -> Bool
forall a. Eq a => a -> a -> Bool
== AlarmTriggerRelationship
forall a. Default a => a
def = []
    toParam AlarmTriggerRelationship
Start        = [(Text
"RELATED", [(Quoting
NoQuotes, Text
"START")])]
    toParam AlarmTriggerRelationship
End          = [(Text
"RELATED", [(Quoting
NoQuotes, Text
"END")])]

instance ToParam Trigger where
    toParam :: Trigger -> [(Text, [(Quoting, Text)])]
toParam TriggerDuration {AlarmTriggerRelationship
Duration
OtherParams
triggerDuration :: Trigger -> Duration
triggerRelated :: Trigger -> AlarmTriggerRelationship
triggerOther :: Trigger -> OtherParams
triggerDuration :: Duration
triggerRelated :: AlarmTriggerRelationship
triggerOther :: OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
triggerOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                   AlarmTriggerRelationship -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam AlarmTriggerRelationship
triggerRelated
    toParam TriggerDateTime {UTCTime
OtherParams
triggerOther :: Trigger -> OtherParams
triggerDateTime :: Trigger -> UTCTime
triggerDateTime :: UTCTime
triggerOther :: OtherParams
..} = OtherParams -> [(Text, [(Quoting, Text)])]
forall a. ToParam a => a -> [(Text, [(Quoting, Text)])]
toParam OtherParams
triggerOther [(Text, [(Quoting, Text)])]
-> [(Text, [(Quoting, Text)])] -> [(Text, [(Quoting, Text)])]
forall a. Semigroup a => a -> a -> a
<>
                                   [(Text
"VALUE", [(Quoting
NoQuotes, Text
"DATE-TIME")])]

-- }}}
-- {{{ Value printers

printUTCOffset :: Int -> ContentPrinter ()
printUTCOffset :: Int -> RWS EncodingFunctions Builder Int ()
printUTCOffset Int
n = do case Int -> Int
forall a. Num a => a -> a
signum Int
n of
                           -1 -> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'-'
                           Int
_  -> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'+'
                      Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
t
                      Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
m
                      Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> (String -> RWS EncodingFunctions Builder Int ())
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
s
  where (Int
m', Int
s) = Int -> Int
forall a. Num a => a -> a
abs Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60
        (Int
t, Int
m)  = Int
m' Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60

printNWeekday :: Either (Int, Weekday) Weekday -> ContentPrinter ()
printNWeekday :: Either (Int, Weekday) Weekday
-> RWS EncodingFunctions Builder Int ()
printNWeekday (Left (Int
n, Weekday
w)) = Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
n RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Weekday -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Weekday
w
printNWeekday (Right Weekday
x) = Weekday -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Weekday
x

printShow :: Show a => a -> ContentPrinter ()
printShow :: forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (a -> Text) -> a -> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

printShowN :: Show a => [a] -> ContentPrinter ()
printShowN :: forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN = (a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN a -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow

printN :: (a -> ContentPrinter ()) -> [a] -> ContentPrinter ()
printN :: forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN a -> RWS EncodingFunctions Builder Int ()
m (a
x:[a]
xs) = a -> RWS EncodingFunctions Builder Int ()
m a
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RWS EncodingFunctions Builder Int ()]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Char -> RWS EncodingFunctions Builder Int ()
putc Char
',' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> RWS EncodingFunctions Builder Int ()
m a
x' | a
x' <- [a]
xs]
printN a -> RWS EncodingFunctions Builder Int ()
_ [a]
_ = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

printShowUpper :: Show a => a -> ContentPrinter ()
printShowUpper :: forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShowUpper = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (a -> Text) -> a -> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

printUTCTime :: Time.UTCTime -> ContentPrinter ()
printUTCTime :: UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (UTCTime -> Text)
-> UTCTime
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UTCTime -> String
forall t. FormatTime t => String -> t -> String
formatTime String
"%C%y%m%dT%H%M%SZ"

class IsValue a where
    printValue :: a -> ContentPrinter ()

instance IsValue ICalVersion where
    printValue :: ICalVersion -> RWS EncodingFunctions Builder Int ()
printValue MaxICalVersion {Version
OtherParams
versionOther :: ICalVersion -> OtherParams
versionMax :: Version
versionOther :: OtherParams
versionMax :: ICalVersion -> Version
..} = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Version -> String
Ver.showVersion Version
versionMax
    printValue MinMaxICalVersion {Version
OtherParams
versionOther :: ICalVersion -> OtherParams
versionMax :: ICalVersion -> Version
versionMax :: Version
versionMin :: Version
versionOther :: OtherParams
versionMin :: ICalVersion -> Version
..} = do
        Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Version -> String
Ver.showVersion Version
versionMin
        Char -> RWS EncodingFunctions Builder Int ()
putc Char
';'
        Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Version -> String
Ver.showVersion Version
versionMax

instance IsValue Recur where
    printValue :: Recur -> RWS EncodingFunctions Builder Int ()
printValue Recur {Int
[Int]
[Either (Int, Weekday) Weekday]
Maybe (Either (Either Date DateTime) Int)
Weekday
Frequency
recurFreq :: Frequency
recurUntilCount :: Maybe (Either (Either Date DateTime) Int)
recurInterval :: Int
recurBySecond :: [Int]
recurByMinute :: [Int]
recurByHour :: [Int]
recurByDay :: [Either (Int, Weekday) Weekday]
recurByMonthDay :: [Int]
recurByYearDay :: [Int]
recurByWeekNo :: [Int]
recurByMonth :: [Int]
recurBySetPos :: [Int]
recurWkSt :: Weekday
recurFreq :: Recur -> Frequency
recurUntilCount :: Recur -> Maybe (Either (Either Date DateTime) Int)
recurInterval :: Recur -> Int
recurBySecond :: Recur -> [Int]
recurByMinute :: Recur -> [Int]
recurByHour :: Recur -> [Int]
recurByDay :: Recur -> [Either (Int, Weekday) Weekday]
recurByMonthDay :: Recur -> [Int]
recurByYearDay :: Recur -> [Int]
recurByWeekNo :: Recur -> [Int]
recurByMonth :: Recur -> [Int]
recurBySetPos :: Recur -> [Int]
recurWkSt :: Recur -> Weekday
..} = do
        Text -> RWS EncodingFunctions Builder Int ()
out Text
"FREQ="
        Frequency -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShowUpper Frequency
recurFreq
        Maybe (Either (Either Date DateTime) Int)
-> (Either (Either Date DateTime) Int
    -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Either (Either Date DateTime) Int)
recurUntilCount ((Either (Either Date DateTime) Int
  -> RWS EncodingFunctions Builder Int ())
 -> RWS EncodingFunctions Builder Int ())
-> (Either (Either Date DateTime) Int
    -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ \Either (Either Date DateTime) Int
x ->
            case Either (Either Date DateTime) Int
x of
                 Left Either Date DateTime
y -> Text -> RWS EncodingFunctions Builder Int ()
out Text
";UNTIL=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Date DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Either Date DateTime
y
                 Right Int
y -> Text -> RWS EncodingFunctions Builder Int ()
out Text
";COUNT=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
y
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
recurInterval Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";INTERVAL=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
recurInterval
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurBySecond) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYSECOND=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurBySecond
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByMinute) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYMINUTE=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByMinute
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByHour) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYHOUR=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByHour
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Either (Int, Weekday) Weekday] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either (Int, Weekday) Weekday]
recurByDay) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYDAY=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Either (Int, Weekday) Weekday
 -> RWS EncodingFunctions Builder Int ())
-> [Either (Int, Weekday) Weekday]
-> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN Either (Int, Weekday) Weekday
-> RWS EncodingFunctions Builder Int ()
printNWeekday [Either (Int, Weekday) Weekday]
recurByDay
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByMonthDay) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYMONTHDAY=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByMonthDay
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByYearDay) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYYEARDAY=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByYearDay
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByWeekNo) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYWEEKNO=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByWeekNo
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurByMonth) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYMONTH=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurByMonth
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
recurBySetPos) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";BYSETPOS=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Int] -> RWS EncodingFunctions Builder Int ()
forall a. Show a => [a] -> RWS EncodingFunctions Builder Int ()
printShowN [Int]
recurBySetPos
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Weekday
recurWkSt Weekday -> Weekday -> Bool
forall a. Eq a => a -> a -> Bool
== Weekday
Monday) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$
            Text -> RWS EncodingFunctions Builder Int ()
out Text
";WKST=" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Weekday -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Weekday
recurWkSt

instance IsValue TimeTransparency where
    printValue :: TimeTransparency -> RWS EncodingFunctions Builder Int ()
printValue Opaque {}      = Text -> RWS EncodingFunctions Builder Int ()
out Text
"OPAQUE"
    printValue Transparent {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"TRANSPARENT"

instance IsValue DTEnd where
    printValue :: DTEnd -> RWS EncodingFunctions Builder Int ()
printValue DTEndDateTime {DateTime
OtherParams
dtEndDateTimeValue :: DTEnd -> DateTime
dtEndOther :: DTEnd -> OtherParams
dtEndDateTimeValue :: DateTime
dtEndOther :: OtherParams
..} = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
dtEndDateTimeValue
    printValue DTEndDate {Date
OtherParams
dtEndOther :: DTEnd -> OtherParams
dtEndDateValue :: DTEnd -> Date
dtEndDateValue :: Date
dtEndOther :: OtherParams
..}     = Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Date
dtEndDateValue

instance IsValue Due where
    printValue :: Due -> RWS EncodingFunctions Builder Int ()
printValue DueDateTime {DateTime
OtherParams
dueDateTimeValue :: Due -> DateTime
dueOther :: Due -> OtherParams
dueDateTimeValue :: DateTime
dueOther :: OtherParams
..} = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
dueDateTimeValue
    printValue DueDate {Date
OtherParams
dueOther :: Due -> OtherParams
dueDateValue :: Due -> Date
dueDateValue :: Date
dueOther :: OtherParams
..}     = Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Date
dueDateValue

instance IsValue EventStatus where
    printValue :: EventStatus -> RWS EncodingFunctions Builder Int ()
printValue TentativeEvent {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"TENTATIVE"
    printValue ConfirmedEvent {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"CONFIRMED"
    printValue CancelledEvent {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"CANCELLED"

instance IsValue TodoStatus where
    printValue :: TodoStatus -> RWS EncodingFunctions Builder Int ()
printValue TodoNeedsAction {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"NEEDS-ACTION"
    printValue CompletedTodo {}   = Text -> RWS EncodingFunctions Builder Int ()
out Text
"COMPLETED"
    printValue InProcessTodo {}   = Text -> RWS EncodingFunctions Builder Int ()
out Text
"IN-PROCESS"
    printValue CancelledTodo {}   = Text -> RWS EncodingFunctions Builder Int ()
out Text
"CANCELLED"

instance IsValue JournalStatus where
    printValue :: JournalStatus -> RWS EncodingFunctions Builder Int ()
printValue DraftJournal {}     = Text -> RWS EncodingFunctions Builder Int ()
out Text
"DRAFT"
    printValue FinalJournal {}     = Text -> RWS EncodingFunctions Builder Int ()
out Text
"FINAL"
    printValue CancelledJournal {} = Text -> RWS EncodingFunctions Builder Int ()
out Text
"CANCELLED"

instance IsValue ClassValue where
    printValue :: ClassValue -> RWS EncodingFunctions Builder Int ()
printValue (ClassValueX CI Text
x) = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> Text -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ CI Text -> Text
forall s. CI s -> s
CI.original CI Text
x
    printValue ClassValue
x = ClassValue -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShowUpper ClassValue
x

instance IsValue Weekday where
    printValue :: Weekday -> RWS EncodingFunctions Builder Int ()
printValue Weekday
Sunday    = Text -> RWS EncodingFunctions Builder Int ()
out Text
"SU"
    printValue Weekday
Monday    = Text -> RWS EncodingFunctions Builder Int ()
out Text
"MO"
    printValue Weekday
Tuesday   = Text -> RWS EncodingFunctions Builder Int ()
out Text
"TU"
    printValue Weekday
Wednesday = Text -> RWS EncodingFunctions Builder Int ()
out Text
"WE"
    printValue Weekday
Thursday  = Text -> RWS EncodingFunctions Builder Int ()
out Text
"TH"
    printValue Weekday
Friday    = Text -> RWS EncodingFunctions Builder Int ()
out Text
"FR"
    printValue Weekday
Saturday  = Text -> RWS EncodingFunctions Builder Int ()
out Text
"SA"

instance IsValue Date where
    printValue :: Date -> RWS EncodingFunctions Builder Int ()
printValue Date {Day
dateValue :: Day
dateValue :: Date -> Day
..} = Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> Day -> String
forall t. FormatTime t => String -> t -> String
formatTime String
"%C%y%m%d" Day
dateValue

instance IsValue DateTime where
    printValue :: DateTime -> RWS EncodingFunctions Builder Int ()
printValue FloatingDateTime {LocalTime
dateTimeFloating :: DateTime -> LocalTime
dateTimeFloating :: LocalTime
..} =
        Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> LocalTime -> String
forall t. FormatTime t => String -> t -> String
formatTime String
"%C%y%m%dT%H%M%S" LocalTime
dateTimeFloating
    printValue UTCDateTime {UTCTime
dateTimeUTC :: UTCTime
dateTimeUTC :: DateTime -> UTCTime
..} = UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
dateTimeUTC
    printValue ZonedDateTime {Text
LocalTime
dateTimeFloating :: DateTime -> LocalTime
dateTimeZone :: DateTime -> Text
dateTimeFloating :: LocalTime
dateTimeZone :: Text
..} =
        Text -> RWS EncodingFunctions Builder Int ()
out (Text -> RWS EncodingFunctions Builder Int ())
-> (String -> Text)
-> String
-> RWS EncodingFunctions Builder Int ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RWS EncodingFunctions Builder Int ())
-> String -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ String -> LocalTime -> String
forall t. FormatTime t => String -> t -> String
formatTime String
"%C%y%m%dT%H%M%S" LocalTime
dateTimeFloating

instance IsValue (Either Date DateTime) where
    printValue :: Either Date DateTime -> RWS EncodingFunctions Builder Int ()
printValue (Left Date
x) = Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Date
x
    printValue (Right DateTime
x) = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
x

instance IsValue DTStamp where
    printValue :: DTStamp -> RWS EncodingFunctions Builder Int ()
printValue DTStamp {UTCTime
OtherParams
dtStampValue :: DTStamp -> UTCTime
dtStampOther :: DTStamp -> OtherParams
dtStampValue :: UTCTime
dtStampOther :: OtherParams
..} = UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
dtStampValue

instance IsValue DTStart where
    printValue :: DTStart -> RWS EncodingFunctions Builder Int ()
printValue DTStartDateTime {DateTime
OtherParams
dtStartDateTimeValue :: DTStart -> DateTime
dtStartOther :: DTStart -> OtherParams
dtStartDateTimeValue :: DateTime
dtStartOther :: OtherParams
..} = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
dtStartDateTimeValue
    printValue DTStartDate {Date
OtherParams
dtStartOther :: DTStart -> OtherParams
dtStartDateValue :: DTStart -> Date
dtStartDateValue :: Date
dtStartOther :: OtherParams
..} = Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Date
dtStartDateValue

instance IsValue URI.URI where
    printValue :: URI -> RWS EncodingFunctions Builder Int ()
printValue = URI -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow

instance IsValue Duration where
    printValue :: Duration -> RWS EncodingFunctions Builder Int ()
printValue DurationDate {Int
Sign
durSign :: Sign
durDay :: Int
durHour :: Int
durMinute :: Int
durSecond :: Int
durSign :: Duration -> Sign
durDay :: Duration -> Int
durHour :: Duration -> Int
durMinute :: Duration -> Int
durSecond :: Duration -> Int
..} = do
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Sign
durSign Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
Negative) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Char -> RWS EncodingFunctions Builder Int ()
putc Char
'-'
        Char -> RWS EncodingFunctions Builder Int ()
putc Char
'P'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durDay    RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'D'
        Char -> RWS EncodingFunctions Builder Int ()
putc Char
'T'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durHour   RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'H'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durMinute RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'M'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durSecond RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'S'
    printValue DurationTime {Int
Sign
durSign :: Duration -> Sign
durHour :: Duration -> Int
durMinute :: Duration -> Int
durSecond :: Duration -> Int
durSign :: Sign
durHour :: Int
durMinute :: Int
durSecond :: Int
..} = do
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Sign
durSign Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
Negative) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Char -> RWS EncodingFunctions Builder Int ()
putc Char
'-'
        Text -> RWS EncodingFunctions Builder Int ()
out Text
"PT"
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durHour   RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'H'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durMinute RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'M'
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durSecond RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'S'
    printValue DurationWeek {Int
Sign
durSign :: Duration -> Sign
durSign :: Sign
durWeek :: Int
durWeek :: Duration -> Int
..} = do
        Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Sign
durSign Sign -> Sign -> Bool
forall a. Eq a => a -> a -> Bool
== Sign
Negative) (RWS EncodingFunctions Builder Int ()
 -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Char -> RWS EncodingFunctions Builder Int ()
putc Char
'-'
        Text -> RWS EncodingFunctions Builder Int ()
out Text
"P"
        Int -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow Int
durWeek RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'W'

instance IsValue RecurrenceId where
    printValue :: RecurrenceId -> RWS EncodingFunctions Builder Int ()
printValue RecurrenceIdDate {Maybe Range
Date
OtherParams
recurrenceIdDate :: RecurrenceId -> Date
recurrenceIdRange :: RecurrenceId -> Maybe Range
recurrenceIdOther :: RecurrenceId -> OtherParams
recurrenceIdDate :: Date
recurrenceIdRange :: Maybe Range
recurrenceIdOther :: OtherParams
..}     = Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Date
recurrenceIdDate
    printValue RecurrenceIdDateTime {Maybe Range
DateTime
OtherParams
recurrenceIdRange :: RecurrenceId -> Maybe Range
recurrenceIdOther :: RecurrenceId -> OtherParams
recurrenceIdDateTime :: RecurrenceId -> DateTime
recurrenceIdDateTime :: DateTime
recurrenceIdRange :: Maybe Range
recurrenceIdOther :: OtherParams
..} = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
recurrenceIdDateTime

instance IsValue Period where
    printValue :: Period -> RWS EncodingFunctions Builder Int ()
printValue (PeriodDates DateTime
f DateTime
t) = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
f RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'/' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
t
    printValue (PeriodDuration DateTime
f Duration
d) = DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue DateTime
f RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'/' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Duration -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Duration
d

instance IsValue UTCPeriod where
    printValue :: UTCPeriod -> RWS EncodingFunctions Builder Int ()
printValue (UTCPeriodDates UTCTime
f UTCTime
t) = UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
f RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'/' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
t
    printValue (UTCPeriodDuration UTCTime
f Duration
d) = UTCTime -> RWS EncodingFunctions Builder Int ()
printUTCTime UTCTime
f RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'/' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Duration -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue Duration
d

instance IsValue RDate where
    printValue :: RDate -> RWS EncodingFunctions Builder Int ()
printValue RDateDates {Set Date
OtherParams
rDateDates :: RDate -> Set Date
rDateOther :: RDate -> OtherParams
rDateDates :: Set Date
rDateOther :: OtherParams
..}     = (Date -> RWS EncodingFunctions Builder Int ())
-> [Date] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN Date -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([Date] -> RWS EncodingFunctions Builder Int ())
-> [Date] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set Date -> [Date]
forall a. Set a -> [a]
S.toList Set Date
rDateDates
    printValue RDateDateTimes {Set DateTime
OtherParams
rDateOther :: RDate -> OtherParams
rDateDateTimes :: RDate -> Set DateTime
rDateDateTimes :: Set DateTime
rDateOther :: OtherParams
..} = (DateTime -> RWS EncodingFunctions Builder Int ())
-> [DateTime] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN DateTime -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([DateTime] -> RWS EncodingFunctions Builder Int ())
-> [DateTime] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set DateTime -> [DateTime]
forall a. Set a -> [a]
S.toList Set DateTime
rDateDateTimes
    printValue RDatePeriods {Set Period
OtherParams
rDateOther :: RDate -> OtherParams
rDatePeriods :: RDate -> Set Period
rDatePeriods :: Set Period
rDateOther :: OtherParams
..}   = (Period -> RWS EncodingFunctions Builder Int ())
-> [Period] -> RWS EncodingFunctions Builder Int ()
forall a.
(a -> RWS EncodingFunctions Builder Int ())
-> [a] -> RWS EncodingFunctions Builder Int ()
printN Period -> RWS EncodingFunctions Builder Int ()
forall a. IsValue a => a -> RWS EncodingFunctions Builder Int ()
printValue ([Period] -> RWS EncodingFunctions Builder Int ())
-> [Period] -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Set Period -> [Period]
forall a. Set a -> [a]
S.toList Set Period
rDatePeriods

instance IsValue Attachment where
    printValue :: Attachment -> RWS EncodingFunctions Builder Int ()
printValue UriAttachment {Maybe MIMEType
URI
OtherParams
attachFmtType :: Attachment -> Maybe MIMEType
attachUri :: Attachment -> URI
attachOther :: Attachment -> OtherParams
attachFmtType :: Maybe MIMEType
attachUri :: URI
attachOther :: OtherParams
..} = URI -> RWS EncodingFunctions Builder Int ()
forall a. Show a => a -> RWS EncodingFunctions Builder Int ()
printShow URI
attachUri
    printValue BinaryAttachment {Maybe MIMEType
ByteString
OtherParams
attachFmtType :: Attachment -> Maybe MIMEType
attachOther :: Attachment -> OtherParams
attachContent :: Attachment -> ByteString
attachFmtType :: Maybe MIMEType
attachContent :: ByteString
attachOther :: OtherParams
..} = ByteString -> RWS EncodingFunctions Builder Int ()
bytestring (ByteString -> RWS EncodingFunctions Builder Int ())
-> ByteString -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
attachContent

-- }}}
-- {{{ Lib

ln :: ContentPrinter () -> ContentPrinter ()
ln :: RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
ln RWS EncodingFunctions Builder Int ()
x = RWS EncodingFunctions Builder Int ()
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RWS EncodingFunctions Builder Int ()
newline

param :: (Text, [(Quoting, Text)]) -> ContentPrinter ()
param :: (Text, [(Quoting, Text)]) -> RWS EncodingFunctions Builder Int ()
param (Text
n, [(Quoting, Text)]
xs) = Char -> RWS EncodingFunctions Builder Int ()
putc Char
';' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
out Text
n RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'=' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Quoting, Text)] -> RWS EncodingFunctions Builder Int ()
paramVals [(Quoting, Text)]
xs

paramVals :: [(Quoting, Text)] -> ContentPrinter ()
paramVals :: [(Quoting, Text)] -> RWS EncodingFunctions Builder Int ()
paramVals ((Quoting, Text)
x:[(Quoting, Text)]
xs) = (Quoting, Text) -> RWS EncodingFunctions Builder Int ()
paramVal (Quoting, Text)
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RWS EncodingFunctions Builder Int ()]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Char -> RWS EncodingFunctions Builder Int ()
putc Char
',' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Quoting, Text) -> RWS EncodingFunctions Builder Int ()
paramVal (Quoting, Text)
x' | (Quoting, Text)
x' <- [(Quoting, Text)]
xs]
paramVals [(Quoting, Text)]
_ = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

paramVal :: (Quoting, Text) -> ContentPrinter ()
paramVal :: (Quoting, Text) -> RWS EncodingFunctions Builder Int ()
paramVal (Quoting
NeedQuotes, Text
t) = Char -> RWS EncodingFunctions Builder Int ()
putc Char
'"' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
out Text
t RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc Char
'"'
paramVal (Quoting
NoQuotes, Text
t) = Text -> RWS EncodingFunctions Builder Int ()
out Text
t
paramVal (Quoting
_, Text
t) = (Quoting, Text) -> RWS EncodingFunctions Builder Int ()
paramVal (Quoting
NeedQuotes, Text
t)

texts :: [Text] -> ContentPrinter ()
texts :: [Text] -> RWS EncodingFunctions Builder Int ()
texts (Text
x:[Text]
xs) = Text -> RWS EncodingFunctions Builder Int ()
text Text
x RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [RWS EncodingFunctions Builder Int ()]
-> RWS EncodingFunctions Builder Int ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Char -> RWS EncodingFunctions Builder Int ()
putc Char
',' RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
x' | Text
x' <- [Text]
xs]
texts [Text]
_ = () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

text :: Text -> ContentPrinter ()
text :: Text -> RWS EncodingFunctions Builder Int ()
text Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
              Just (Char
';', Text
r)  -> Text -> RWS EncodingFunctions Builder Int ()
out Text
"\\;"  RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
r
              Just (Char
'\n', Text
r) -> Text -> RWS EncodingFunctions Builder Int ()
out Text
"\\n"  RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
r
              Just (Char
',', Text
r)  -> Text -> RWS EncodingFunctions Builder Int ()
out Text
"\\,"  RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
r
              Just (Char
'\\', Text
r) -> Text -> RWS EncodingFunctions Builder Int ()
out Text
"\\\\" RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
r
              Just (Char
c, Text
r)    -> Char -> RWS EncodingFunctions Builder Int ()
putc Char
c     RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
text Text
r
              Maybe (Char, Text)
Nothing        -> () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

bytestring :: ByteString -> ContentPrinter ()
bytestring :: ByteString -> RWS EncodingFunctions Builder Int ()
bytestring = (RWS EncodingFunctions Builder Int ()
 -> Char -> RWS EncodingFunctions Builder Int ())
-> RWS EncodingFunctions Builder Int ()
-> ByteString
-> RWS EncodingFunctions Builder Int ()
forall a. (a -> Char -> a) -> a -> ByteString -> a
BS.foldl' (\RWS EncodingFunctions Builder Int ()
m Char
c -> RWS EncodingFunctions Builder Int ()
m RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> RWS EncodingFunctions Builder Int ()
putc8 Char
c) (() -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

out :: Text -> ContentPrinter ()
out :: Text -> RWS EncodingFunctions Builder Int ()
out Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
             Just (Char
c, Text
r) -> Char -> RWS EncodingFunctions Builder Int ()
putc Char
c RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> RWS EncodingFunctions Builder Int ()
out Text
r
             Maybe (Char, Text)
Nothing -> () -> RWS EncodingFunctions Builder Int ()
forall a. a -> RWST EncodingFunctions Builder Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putc :: Char -> ContentPrinter ()
putc :: Char -> RWS EncodingFunctions Builder Int ()
putc Char
c = do Int
x <- RWST EncodingFunctions Builder Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
            (Char -> Builder
b, Char -> Int
clen) <- (EncodingFunctions -> (Char -> Builder, Char -> Int))
-> RWST
     EncodingFunctions
     Builder
     Int
     Identity
     (Char -> Builder, Char -> Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (EncodingFunctions -> Char -> Builder
efChar2Bu (EncodingFunctions -> Char -> Builder)
-> (EncodingFunctions -> Char -> Int)
-> EncodingFunctions
-> (Char -> Builder, Char -> Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EncodingFunctions -> Char -> Int
efChar2Len)
            let cl :: Int
cl = Char -> Int
clen Char
c
            Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
75) RWS EncodingFunctions Builder Int ()
foldLine
            Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> RWS EncodingFunctions Builder Int ())
-> Builder -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Char -> Builder
b Char
c
            (Int -> Int) -> RWS EncodingFunctions Builder Int ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cl)

putc8 :: Char -> ContentPrinter ()
putc8 :: Char -> RWS EncodingFunctions Builder Int ()
putc8 Char
c = do Int
x <- RWST EncodingFunctions Builder Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
             Bool
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
75) RWS EncodingFunctions Builder Int ()
foldLine
             Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> RWS EncodingFunctions Builder Int ())
-> Builder -> RWS EncodingFunctions Builder Int ()
forall a b. (a -> b) -> a -> b
$ Char -> Builder
Bu.char8 Char
c
             (Int -> Int) -> RWS EncodingFunctions Builder Int ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

foldLine :: ContentPrinter ()
foldLine :: RWS EncodingFunctions Builder Int ()
foldLine = Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ByteString -> Builder
Bu.byteString ByteString
"\r\n ") RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> RWS EncodingFunctions Builder Int ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
1

newline :: ContentPrinter ()
newline :: RWS EncodingFunctions Builder Int ()
newline = Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ByteString -> Builder
Bu.byteString ByteString
"\r\n") RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> RWS EncodingFunctions Builder Int ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Int
0

-- | Output a whole line. Must be less than 75 bytes.
line :: ByteString -> ContentPrinter ()
line :: ByteString -> RWS EncodingFunctions Builder Int ()
line ByteString
b = Builder -> RWS EncodingFunctions Builder Int ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ByteString -> Builder
Bu.lazyByteString ByteString
b) RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
-> RWS EncodingFunctions Builder Int ()
forall a b.
RWST EncodingFunctions Builder Int Identity a
-> RWST EncodingFunctions Builder Int Identity b
-> RWST EncodingFunctions Builder Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RWS EncodingFunctions Builder Int ()
newline

formatTime :: FormatTime t => String -> t -> String
formatTime :: forall t. FormatTime t => String -> t -> String
formatTime = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
defaultTimeLocale

-- }}}