{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE FlexibleContexts  #-}
module Text.ICalendar.Parser.Components where

import           Control.Applicative
import           Control.Arrow        ((&&&))
import           Control.Monad        (when)
import           Control.Monad.Except hiding (mapM)
import           Control.Monad.RWS    (MonadState (get), tell)
import qualified Data.CaseInsensitive as CI
import qualified Data.Foldable        as F
import           Data.List            (partition)
import qualified Data.Map             as M
import           Data.Maybe
import           Data.Set             (Set)
import qualified Data.Set             as S

import Text.ICalendar.Parser.Common
import Text.ICalendar.Parser.Properties
import Text.ICalendar.Types

-- | Parse a VCALENDAR component. 3.4
parseVCalendar :: Content -> ContentParser VCalendar
parseVCalendar :: Content -> ContentParser VCalendar
parseVCalendar c :: Content
c@(Component SourcePos
_ CI Text
"VCALENDAR" [Content]
_) = Content -> ContentParser VCalendar -> ContentParser VCalendar
forall a. Content -> ContentParser a -> ContentParser a
down Content
c (ContentParser VCalendar -> ContentParser VCalendar)
-> ContentParser VCalendar -> ContentParser VCalendar
forall a b. (a -> b) -> a -> b
$ do
    ProdId
vcProdId <- CI Text
-> (Content -> ContentParser ProdId) -> ContentParser ProdId
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"PRODID" ((Text -> OtherParams -> ProdId) -> Content -> ContentParser ProdId
forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> ProdId
ProdId)
    ICalVersion
vcVersion <- CI Text
-> (Content -> ContentParser ICalVersion)
-> ContentParser ICalVersion
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"VERSION" Content -> ContentParser ICalVersion
parseVersion
    Scale
vcScale <- CI Text -> (Content -> ContentParser Scale) -> ContentParser Scale
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CALSCALE" ((CI Text -> OtherParams -> Scale) -> Content -> ContentParser Scale
forall b.
(CI Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleI CI Text -> OtherParams -> Scale
Scale)
    Maybe Method
vcMethod <- CI Text
-> (Content -> ContentParser (Maybe Method))
-> ContentParser (Maybe Method)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"METHOD" ((CI Text -> OtherParams -> Maybe Method)
-> Content -> ContentParser (Maybe Method)
forall b.
(CI Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleI ((Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method)
-> (OtherParams -> Method) -> OtherParams -> Maybe Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Method) -> OtherParams -> Maybe Method)
-> (CI Text -> OtherParams -> Method)
-> CI Text
-> OtherParams
-> Maybe Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> OtherParams -> Method
Method))
    Map Text VTimeZone
vcTimeZones <- (VTimeZone -> Text)
-> Set VTimeZone -> ContentParser (Map Text VTimeZone)
forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f (TZID -> Text
tzidValue (TZID -> Text) -> (VTimeZone -> TZID) -> VTimeZone -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VTimeZone -> TZID
vtzId) (Set VTimeZone -> ContentParser (Map Text VTimeZone))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VTimeZone)
-> ContentParser (Map Text VTimeZone)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI Text
-> (Content -> ContentParser VTimeZone)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VTimeZone)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VTIMEZONE" Content -> ContentParser VTimeZone
parseVTimeZone
    Map (Text, Maybe (Either Date DateTime)) VEvent
vcEvents <- (VEvent -> (Text, Maybe (Either Date DateTime)))
-> Set VEvent
-> ContentParser (Map (Text, Maybe (Either Date DateTime)) VEvent)
forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f (UID -> Text
uidValue (UID -> Text) -> (VEvent -> UID) -> VEvent -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEvent -> UID
veUID (VEvent -> Text)
-> (VEvent -> Maybe (Either Date DateTime))
-> VEvent
-> (Text, Maybe (Either Date DateTime))
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')
&&& Maybe RecurrenceId -> Maybe (Either Date DateTime)
recur (Maybe RecurrenceId -> Maybe (Either Date DateTime))
-> (VEvent -> Maybe RecurrenceId)
-> VEvent
-> Maybe (Either Date DateTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEvent -> Maybe RecurrenceId
veRecurId)
                    (Set VEvent
 -> ContentParser (Map (Text, Maybe (Either Date DateTime)) VEvent))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VEvent)
-> ContentParser (Map (Text, Maybe (Either Date DateTime)) VEvent)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI Text
-> (Content -> ContentParser VEvent)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VEvent)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VEVENT" (Maybe Method -> Content -> ContentParser VEvent
parseVEvent Maybe Method
vcMethod)
    Map (Text, Maybe (Either Date DateTime)) VTodo
vcTodos <- (VTodo -> (Text, Maybe (Either Date DateTime)))
-> Set VTodo
-> ContentParser (Map (Text, Maybe (Either Date DateTime)) VTodo)
forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f (UID -> Text
uidValue (UID -> Text) -> (VTodo -> UID) -> VTodo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VTodo -> UID
vtUID (VTodo -> Text)
-> (VTodo -> Maybe (Either Date DateTime))
-> VTodo
-> (Text, Maybe (Either Date DateTime))
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')
&&& Maybe RecurrenceId -> Maybe (Either Date DateTime)
recur (Maybe RecurrenceId -> Maybe (Either Date DateTime))
-> (VTodo -> Maybe RecurrenceId)
-> VTodo
-> Maybe (Either Date DateTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VTodo -> Maybe RecurrenceId
vtRecurId)
                    (Set VTodo
 -> ContentParser (Map (Text, Maybe (Either Date DateTime)) VTodo))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VTodo)
-> ContentParser (Map (Text, Maybe (Either Date DateTime)) VTodo)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI Text
-> (Content -> ContentParser VTodo)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VTodo)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VTODO" Content -> ContentParser VTodo
parseVTodo
    Map (Text, Maybe (Either Date DateTime)) VJournal
vcJournals <- (VJournal -> (Text, Maybe (Either Date DateTime)))
-> Set VJournal
-> ContentParser
     (Map (Text, Maybe (Either Date DateTime)) VJournal)
forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f (UID -> Text
uidValue (UID -> Text) -> (VJournal -> UID) -> VJournal -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VJournal -> UID
vjUID (VJournal -> Text)
-> (VJournal -> Maybe (Either Date DateTime))
-> VJournal
-> (Text, Maybe (Either Date DateTime))
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')
&&& Maybe RecurrenceId -> Maybe (Either Date DateTime)
recur (Maybe RecurrenceId -> Maybe (Either Date DateTime))
-> (VJournal -> Maybe RecurrenceId)
-> VJournal
-> Maybe (Either Date DateTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VJournal -> Maybe RecurrenceId
vjRecurId)
                    (Set VJournal
 -> ContentParser
      (Map (Text, Maybe (Either Date DateTime)) VJournal))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VJournal)
-> ContentParser
     (Map (Text, Maybe (Either Date DateTime)) VJournal)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI Text
-> (Content -> ContentParser VJournal)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VJournal)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VJOURNAL" Content -> ContentParser VJournal
parseVJournal
    Map Text VFreeBusy
vcFreeBusys <- (VFreeBusy -> Text)
-> Set VFreeBusy -> ContentParser (Map Text VFreeBusy)
forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f (UID -> Text
uidValue (UID -> Text) -> (VFreeBusy -> UID) -> VFreeBusy -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VFreeBusy -> UID
vfbUID) (Set VFreeBusy -> ContentParser (Map Text VFreeBusy))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VFreeBusy)
-> ContentParser (Map Text VFreeBusy)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CI Text
-> (Content -> ContentParser VFreeBusy)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set VFreeBusy)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VFREEBUSY" Content -> ContentParser VFreeBusy
parseVFreeBusy
    Set VOther
vcOtherComps <- ContentParser (Set VOther)
otherComponents
    Set OtherProperty
vcOther <- ContentParser (Set OtherProperty)
otherProperties
    VCalendar -> ContentParser VCalendar
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
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
vcOther :: Set OtherProperty
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
..}
  where recur :: Maybe RecurrenceId -> Maybe (Either Date DateTime)
        recur :: Maybe RecurrenceId -> Maybe (Either Date DateTime)
recur Maybe RecurrenceId
Nothing = Maybe (Either Date DateTime)
forall a. Maybe a
Nothing
        recur (Just (RecurrenceIdDate Date
x Maybe Range
_ OtherParams
_)) = Either Date DateTime -> Maybe (Either Date DateTime)
forall a. a -> Maybe a
Just (Date -> Either Date DateTime
forall a b. a -> Either a b
Left Date
x)
        recur (Just (RecurrenceIdDateTime DateTime
x Maybe Range
_ OtherParams
_)) = Either Date DateTime -> Maybe (Either Date DateTime)
forall a. a -> Maybe a
Just (DateTime -> Either Date DateTime
forall a b. b -> Either a b
Right DateTime
x)
        f :: (Show b, Ord b) => (a -> b) -> Set a -> ContentParser (M.Map b a)
        f :: forall b a.
(Show b, Ord b) =>
(a -> b) -> Set a -> ContentParser (Map b a)
f a -> b
g = (Map b a
 -> a
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Map b a))
-> Map b a
-> Set a
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Map b a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
F.foldlM Map b a
-> a
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Map b a)
forall {m :: * -> *}.
MonadError String m =>
Map b a -> a -> m (Map b a)
h Map b a
forall k a. Map k a
M.empty
          where h :: Map b a -> a -> m (Map b a)
h Map b a
m a
e = let k :: b
k = a -> b
g a
e
                         in if b
k b -> Map b a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map b a
m
                               then String -> m (Map b a)
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (Map b a)) -> String -> m (Map b a)
forall a b. (a -> b) -> a -> b
$ String
"Duplicate UID/RecurId/TZID " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
k
                               else Map b a -> m (Map b a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map b a -> m (Map b a)) -> Map b a -> m (Map b a)
forall a b. (a -> b) -> a -> b
$ b -> a -> Map b a -> Map b a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert b
k a
e Map b a
m
parseVCalendar Content
_ = String -> ContentParser VCalendar
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"parseVCalendar: Content given not a VCALENDAR\
                              \ component."

-- | Parse a VEVENT component. 3.6.1
parseVEvent :: Maybe Method -> Content -> ContentParser VEvent
parseVEvent :: Maybe Method -> Content -> ContentParser VEvent
parseVEvent Maybe Method
mmethod (Component SourcePos
_ CI Text
"VEVENT" [Content]
_) = do
    DTStamp
veDTStamp <- CI Text
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DTSTAMP" ((Content -> ContentParser DTStamp) -> ContentParser DTStamp)
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a b. (a -> b) -> a -> b
$ (UTCTime -> OtherParams -> DTStamp)
-> Content -> ContentParser DTStamp
forall a.
(UTCTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleUTC UTCTime -> OtherParams -> DTStamp
DTStamp
    UID
veUID <- CI Text -> (Content -> ContentParser UID) -> ContentParser UID
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"UID" ((Content -> ContentParser UID) -> ContentParser UID)
-> (Content -> ContentParser UID) -> ContentParser UID
forall a b. (a -> b) -> a -> b
$ (Text -> OtherParams -> UID) -> Content -> ContentParser UID
forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> UID
UID
    Maybe DTStart
veDTStart <- CI Text
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DTSTART" ((Content -> ContentParser (Maybe DTStart))
 -> ContentParser (Maybe DTStart))
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall a b. (a -> b) -> a -> b
$
                  DTStart -> Maybe DTStart
forall a. a -> Maybe a
Just (DTStart -> Maybe DTStart)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> Content
-> ContentParser (Maybe DTStart)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> DTStart)
-> (Date -> OtherParams -> DTStart)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> DTStart
DTStartDateTime Date -> OtherParams -> DTStart
DTStartDate
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Method -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Method
mmethod Bool -> Bool -> Bool
&& Maybe DTStart -> Bool
forall a. Maybe a -> Bool
isNothing Maybe DTStart
veDTStart) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$
        String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"A VEVENT in a VCALENDAR without a METHOD requires a \
                   \DTSTART property."
    Class
veClass <- CI Text -> (Content -> ContentParser Class) -> ContentParser Class
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CLASS" Content -> ContentParser Class
parseClass
    Maybe Created
veCreated <- CI Text
-> (Content -> ContentParser (Maybe Created))
-> ContentParser (Maybe Created)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CREATED" (Created -> Maybe Created
forall a. a -> Maybe a
Just (Created -> Maybe Created)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Created)
-> Content
-> ContentParser (Maybe Created)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Created
parseCreated)
    Maybe Description
veDescription <- CI Text
-> (Content -> ContentParser (Maybe Description))
-> ContentParser (Maybe Description)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DESCRIPTION" ((Content -> ContentParser (Maybe Description))
 -> ContentParser (Maybe Description))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
    -> Content -> ContentParser (Maybe Description))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> ContentParser (Maybe Description)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> Content -> ContentParser (Maybe Description)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
 -> ContentParser (Maybe Description))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> ContentParser (Maybe Description)
forall a b. (a -> b) -> a -> b
$ (((Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> (OtherParams -> Description) -> OtherParams -> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Description) -> OtherParams -> Maybe Description)
-> (Maybe Language -> OtherParams -> Description)
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Description)
 -> Maybe Language -> OtherParams -> Maybe Description)
-> (Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Description)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Description
Description
    Maybe Geo
veGeo <- CI Text
-> (Content -> ContentParser (Maybe Geo))
-> ContentParser (Maybe Geo)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"GEO" (Geo -> Maybe Geo
forall a. a -> Maybe a
Just (Geo -> Maybe Geo)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) Geo)
-> Content
-> ContentParser (Maybe Geo)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Geo
parseGeo)
    Maybe LastModified
veLastMod <- CI Text
-> (Content -> ContentParser (Maybe LastModified))
-> ContentParser (Maybe LastModified)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LAST-MODIFIED" (LastModified -> Maybe LastModified
forall a. a -> Maybe a
Just (LastModified -> Maybe LastModified)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         LastModified)
-> Content
-> ContentParser (Maybe LastModified)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     LastModified
parseLastModified)
    Maybe Location
veLocation <- CI Text
-> (Content -> ContentParser (Maybe Location))
-> ContentParser (Maybe Location)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LOCATION" ((Content -> ContentParser (Maybe Location))
 -> ContentParser (Maybe Location))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
    -> Content -> ContentParser (Maybe Location))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> ContentParser (Maybe Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> Content -> ContentParser (Maybe Location)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
 -> ContentParser (Maybe Location))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> ContentParser (Maybe Location)
forall a b. (a -> b) -> a -> b
$ (((Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location)
-> (OtherParams -> Location) -> OtherParams -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Location) -> OtherParams -> Maybe Location)
-> (Maybe Language -> OtherParams -> Location)
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Location)
 -> Maybe Language -> OtherParams -> Maybe Location)
-> (Maybe URI -> Maybe Language -> OtherParams -> Location)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Location)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> Location)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Location
Location
    Maybe Organizer
veOrganizer <- CI Text
-> (Content -> ContentParser (Maybe Organizer))
-> ContentParser (Maybe Organizer)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"ORGANIZER" (Organizer -> Maybe Organizer
forall a. a -> Maybe a
Just (Organizer -> Maybe Organizer)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Organizer)
-> Content
-> ContentParser (Maybe Organizer)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Organizer
parseOrganizer)
    Priority
vePriority <- CI Text
-> (Content -> ContentParser Priority) -> ContentParser Priority
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"PRIORITY" ((Int -> OtherParams -> Priority)
-> Content -> ContentParser Priority
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Int -> OtherParams -> Priority
Priority)
    Sequence
veSeq <- CI Text
-> (Content -> ContentParser Sequence) -> ContentParser Sequence
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SEQUENCE" ((Integer -> OtherParams -> Sequence)
-> Content -> ContentParser Sequence
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Integer -> OtherParams -> Sequence
Sequence)
    Maybe EventStatus
veStatus <- CI Text
-> (Content -> ContentParser (Maybe EventStatus))
-> ContentParser (Maybe EventStatus)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"STATUS" (EventStatus -> Maybe EventStatus
forall a. a -> Maybe a
Just (EventStatus -> Maybe EventStatus)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         EventStatus)
-> Content
-> ContentParser (Maybe EventStatus)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     EventStatus
parseEventStatus)
    Maybe Summary
veSummary <- CI Text
-> (Content -> ContentParser (Maybe Summary))
-> ContentParser (Maybe Summary)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SUMMARY" ((Content -> ContentParser (Maybe Summary))
 -> ContentParser (Maybe Summary))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
    -> Content -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> Content -> ContentParser (Maybe Summary)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
 -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall a b. (a -> b) -> a -> b
$ (((Summary -> Maybe Summary
forall a. a -> Maybe a
Just (Summary -> Maybe Summary)
-> (OtherParams -> Summary) -> OtherParams -> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Summary) -> OtherParams -> Maybe Summary)
-> (Maybe Language -> OtherParams -> Summary)
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Summary)
 -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Summary)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary
Summary
    TimeTransparency
veTransp <- CI Text
-> (Content -> ContentParser TimeTransparency)
-> ContentParser TimeTransparency
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"TRANSP" Content -> ContentParser TimeTransparency
parseTransp
    Maybe URL
veUrl <- CI Text
-> (Content -> ContentParser (Maybe URL))
-> ContentParser (Maybe URL)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"URL" (URL -> Maybe URL
forall a. a -> Maybe a
Just (URL -> Maybe URL)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL)
-> Content
-> ContentParser (Maybe URL)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (URI -> OtherParams -> URL)
-> Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL
forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> URL
URL)
    Maybe RecurrenceId
veRecurId <- CI Text
-> (Content -> ContentParser (Maybe RecurrenceId))
-> ContentParser (Maybe RecurrenceId)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"RECURRENCE-ID"
                    ((Content -> ContentParser (Maybe RecurrenceId))
 -> ContentParser (Maybe RecurrenceId))
-> (Content -> ContentParser (Maybe RecurrenceId))
-> ContentParser (Maybe RecurrenceId)
forall a b. (a -> b) -> a -> b
$ RecurrenceId -> Maybe RecurrenceId
forall a. a -> Maybe a
Just (RecurrenceId -> Maybe RecurrenceId)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         RecurrenceId)
-> Content
-> ContentParser (Maybe RecurrenceId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Maybe DTStart
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RecurrenceId
parseRecurId Maybe DTStart
veDTStart
    Set RRule
veRRule <- CI Text
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RRULE" ((Content -> ContentParser RRule) -> ContentParser (Set RRule))
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a b. (a -> b) -> a -> b
$ Maybe DTStart -> Content -> ContentParser RRule
parseRRule Maybe DTStart
veDTStart
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set RRule -> Int
forall a. Set a -> Int
S.size Set RRule
veRRule Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"SHOULD NOT have multiple RRules."]
    Maybe (Either DTEnd DurationProp)
veDTEndDuration <- CI Text
-> (DateTime -> OtherParams -> DTEnd)
-> (Date -> OtherParams -> DTEnd)
-> Maybe DTStart
-> ContentParser (Maybe (Either DTEnd DurationProp))
forall a.
CI Text
-> (DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a)
-> Maybe DTStart
-> ContentParser (Maybe (Either a DurationProp))
parseXDurationOpt CI Text
"DTEND" DateTime -> OtherParams -> DTEnd
DTEndDateTime Date -> OtherParams -> DTEnd
DTEndDate
                                         Maybe DTStart
veDTStart
    Set Attachment
veAttach <- CI Text
-> (Content -> ContentParser Attachment)
-> ContentParser (Set Attachment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTACH" Content -> ContentParser Attachment
parseAttachment
    Set Attendee
veAttendee <- CI Text
-> (Content -> ContentParser Attendee)
-> ContentParser (Set Attendee)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTENDEE" Content -> ContentParser Attendee
parseAttendee
    Set Categories
veCategories <- CI Text
-> (Content -> ContentParser Categories)
-> ContentParser (Set Categories)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CATEGORIES" Content -> ContentParser Categories
parseCategories
    Set Comment
veComment <- CI Text
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"COMMENT" ((Content -> ContentParser Comment) -> ContentParser (Set Comment))
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment)
-> Content -> ContentParser Comment
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment
Comment
    Set Contact
veContact <- CI Text
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CONTACT" ((Content -> ContentParser Contact) -> ContentParser (Set Contact))
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact)
-> Content -> ContentParser Contact
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact
Contact
    Set ExDate
veExDate <- CI Text
-> (Content -> ContentParser ExDate) -> ContentParser (Set ExDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"EXDATE" Content -> ContentParser ExDate
parseExDate
    Set RequestStatus
veRStatus <- CI Text
-> (Content -> ContentParser RequestStatus)
-> ContentParser (Set RequestStatus)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"REQUEST-STATUS" Content -> ContentParser RequestStatus
parseRequestStatus
    Set RelatedTo
veRelated <- CI Text
-> (Content -> ContentParser RelatedTo)
-> ContentParser (Set RelatedTo)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RELATED-TO" Content -> ContentParser RelatedTo
parseRelatedTo
    Set Resources
veResources <- CI Text
-> (Content -> ContentParser Resources)
-> ContentParser (Set Resources)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RESOURCES" ((Content -> ContentParser Resources)
 -> ContentParser (Set Resources))
-> (Content -> ContentParser Resources)
-> ContentParser (Set Resources)
forall a b. (a -> b) -> a -> b
$ (Set Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Resources)
-> Content -> ContentParser Resources
forall a.
(Set Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLangN Set Text -> Maybe URI -> Maybe Language -> OtherParams -> Resources
Resources
    Set RDate
veRDate <- CI Text
-> (Content -> ContentParser RDate) -> ContentParser (Set RDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RDATE" Content -> ContentParser RDate
parseRDate
    Set VAlarm
veAlarms <- CI Text
-> (Content -> ContentParser VAlarm) -> ContentParser (Set VAlarm)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VALARM" Content -> ContentParser VAlarm
parseVAlarm
    Set OtherProperty
veOther <- ContentParser (Set OtherProperty)
otherProperties
    VEvent -> ContentParser VEvent
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
veUID :: UID
veRecurId :: Maybe RecurrenceId
veDTStamp :: DTStamp
veUID :: UID
veDTStart :: Maybe DTStart
veClass :: Class
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 :: DTStamp
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
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
..}
parseVEvent Maybe Method
_ Content
x = String -> ContentParser VEvent
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VEvent) -> String -> ContentParser VEvent
forall a b. (a -> b) -> a -> b
$ String
"parseVEvent: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a VTODO component.
parseVTodo :: Content -> ContentParser VTodo
parseVTodo :: Content -> ContentParser VTodo
parseVTodo (Component SourcePos
_ CI Text
"VTODO" [Content]
_) = do
    DTStamp
vtDTStamp <- CI Text
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DTSTAMP" ((Content -> ContentParser DTStamp) -> ContentParser DTStamp)
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a b. (a -> b) -> a -> b
$ (UTCTime -> OtherParams -> DTStamp)
-> Content -> ContentParser DTStamp
forall a.
(UTCTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleUTC UTCTime -> OtherParams -> DTStamp
DTStamp
    UID
vtUID <- CI Text -> (Content -> ContentParser UID) -> ContentParser UID
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"UID" ((Content -> ContentParser UID) -> ContentParser UID)
-> (Content -> ContentParser UID) -> ContentParser UID
forall a b. (a -> b) -> a -> b
$ (Text -> OtherParams -> UID) -> Content -> ContentParser UID
forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> UID
UID
    Class
vtClass <- CI Text -> (Content -> ContentParser Class) -> ContentParser Class
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CLASS" Content -> ContentParser Class
parseClass
    Maybe Completed
vtCompleted <- CI Text
-> (Content -> ContentParser (Maybe Completed))
-> ContentParser (Maybe Completed)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"COMPLETED" ((Content -> ContentParser (Maybe Completed))
 -> ContentParser (Maybe Completed))
-> ((DateTime -> OtherParams -> Maybe Completed)
    -> Content -> ContentParser (Maybe Completed))
-> (DateTime -> OtherParams -> Maybe Completed)
-> ContentParser (Maybe Completed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateTime -> OtherParams -> Maybe Completed)
-> Content -> ContentParser (Maybe Completed)
forall a.
(DateTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateTime ((DateTime -> OtherParams -> Maybe Completed)
 -> ContentParser (Maybe Completed))
-> (DateTime -> OtherParams -> Maybe Completed)
-> ContentParser (Maybe Completed)
forall a b. (a -> b) -> a -> b
$
                (Completed -> Maybe Completed
forall a. a -> Maybe a
Just (Completed -> Maybe Completed)
-> (OtherParams -> Completed) -> OtherParams -> Maybe Completed
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Completed) -> OtherParams -> Maybe Completed)
-> (DateTime -> OtherParams -> Completed)
-> DateTime
-> OtherParams
-> Maybe Completed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateTime -> OtherParams -> Completed
Completed
    Maybe Created
vtCreated <- CI Text
-> (Content -> ContentParser (Maybe Created))
-> ContentParser (Maybe Created)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CREATED" (Created -> Maybe Created
forall a. a -> Maybe a
Just (Created -> Maybe Created)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Created)
-> Content
-> ContentParser (Maybe Created)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Created
parseCreated)
    Maybe DTStart
vtDTStart <- CI Text
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DTSTART" ((Content -> ContentParser (Maybe DTStart))
 -> ContentParser (Maybe DTStart))
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall a b. (a -> b) -> a -> b
$
                DTStart -> Maybe DTStart
forall a. a -> Maybe a
Just (DTStart -> Maybe DTStart)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> Content
-> ContentParser (Maybe DTStart)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> DTStart)
-> (Date -> OtherParams -> DTStart)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> DTStart
DTStartDateTime Date -> OtherParams -> DTStart
DTStartDate
    Maybe Description
vtDescription <- CI Text
-> (Content -> ContentParser (Maybe Description))
-> ContentParser (Maybe Description)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DESCRIPTION" ((Content -> ContentParser (Maybe Description))
 -> ContentParser (Maybe Description))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
    -> Content -> ContentParser (Maybe Description))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> ContentParser (Maybe Description)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> Content -> ContentParser (Maybe Description)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
 -> ContentParser (Maybe Description))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> ContentParser (Maybe Description)
forall a b. (a -> b) -> a -> b
$ (((Description -> Maybe Description
forall a. a -> Maybe a
Just (Description -> Maybe Description)
-> (OtherParams -> Description) -> OtherParams -> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Description) -> OtherParams -> Maybe Description)
-> (Maybe Language -> OtherParams -> Description)
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Description)
 -> Maybe Language -> OtherParams -> Maybe Description)
-> (Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Description)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Description)
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Description
Description
    Maybe Geo
vtGeo <- CI Text
-> (Content -> ContentParser (Maybe Geo))
-> ContentParser (Maybe Geo)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"GEO" (Geo -> Maybe Geo
forall a. a -> Maybe a
Just (Geo -> Maybe Geo)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) Geo)
-> Content
-> ContentParser (Maybe Geo)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Geo
parseGeo)
    Maybe LastModified
vtLastMod <- CI Text
-> (Content -> ContentParser (Maybe LastModified))
-> ContentParser (Maybe LastModified)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LAST-MODIFIED" (LastModified -> Maybe LastModified
forall a. a -> Maybe a
Just (LastModified -> Maybe LastModified)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         LastModified)
-> Content
-> ContentParser (Maybe LastModified)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     LastModified
parseLastModified)
    Maybe Location
vtLocation <- CI Text
-> (Content -> ContentParser (Maybe Location))
-> ContentParser (Maybe Location)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LOCATION" ((Content -> ContentParser (Maybe Location))
 -> ContentParser (Maybe Location))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
    -> Content -> ContentParser (Maybe Location))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> ContentParser (Maybe Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> Content -> ContentParser (Maybe Location)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
 -> ContentParser (Maybe Location))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> ContentParser (Maybe Location)
forall a b. (a -> b) -> a -> b
$ (((Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location)
-> (OtherParams -> Location) -> OtherParams -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Location) -> OtherParams -> Maybe Location)
-> (Maybe Language -> OtherParams -> Location)
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Location)
 -> Maybe Language -> OtherParams -> Maybe Location)
-> (Maybe URI -> Maybe Language -> OtherParams -> Location)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Location)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Location)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> Location)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Location
Location
    Maybe Organizer
vtOrganizer <- CI Text
-> (Content -> ContentParser (Maybe Organizer))
-> ContentParser (Maybe Organizer)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"ORGANIZER" (Organizer -> Maybe Organizer
forall a. a -> Maybe a
Just (Organizer -> Maybe Organizer)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Organizer)
-> Content
-> ContentParser (Maybe Organizer)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Organizer
parseOrganizer)
    Maybe PercentComplete
vtPercent <- CI Text
-> (Content -> ContentParser (Maybe PercentComplete))
-> ContentParser (Maybe PercentComplete)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"PERCENT-COMPLETE" ((Content -> ContentParser (Maybe PercentComplete))
 -> ContentParser (Maybe PercentComplete))
-> (Content -> ContentParser (Maybe PercentComplete))
-> ContentParser (Maybe PercentComplete)
forall a b. (a -> b) -> a -> b
$ PercentComplete -> Maybe PercentComplete
forall a. a -> Maybe a
Just (PercentComplete -> Maybe PercentComplete)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         PercentComplete)
-> Content
-> ContentParser (Maybe PercentComplete)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (Int -> OtherParams -> PercentComplete)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     PercentComplete
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead
                                                             Int -> OtherParams -> PercentComplete
PercentComplete
    Priority
vtPriority <- CI Text
-> (Content -> ContentParser Priority) -> ContentParser Priority
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"PRIORITY" ((Content -> ContentParser Priority) -> ContentParser Priority)
-> (Content -> ContentParser Priority) -> ContentParser Priority
forall a b. (a -> b) -> a -> b
$ (Int -> OtherParams -> Priority)
-> Content -> ContentParser Priority
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Int -> OtherParams -> Priority
Priority
    Maybe RecurrenceId
vtRecurId <- CI Text
-> (Content -> ContentParser (Maybe RecurrenceId))
-> ContentParser (Maybe RecurrenceId)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"RECURRENCE-ID" (RecurrenceId -> Maybe RecurrenceId
forall a. a -> Maybe a
Just (RecurrenceId -> Maybe RecurrenceId)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         RecurrenceId)
-> Content
-> ContentParser (Maybe RecurrenceId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Maybe DTStart
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RecurrenceId
parseRecurId Maybe DTStart
vtDTStart)
    Sequence
vtSeq <- CI Text
-> (Content -> ContentParser Sequence) -> ContentParser Sequence
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SEQUENCE" ((Content -> ContentParser Sequence) -> ContentParser Sequence)
-> (Content -> ContentParser Sequence) -> ContentParser Sequence
forall a b. (a -> b) -> a -> b
$ (Integer -> OtherParams -> Sequence)
-> Content -> ContentParser Sequence
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Integer -> OtherParams -> Sequence
Sequence
    Maybe TodoStatus
vtStatus <- CI Text
-> (Content -> ContentParser (Maybe TodoStatus))
-> ContentParser (Maybe TodoStatus)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"STATUS" (TodoStatus -> Maybe TodoStatus
forall a. a -> Maybe a
Just (TodoStatus -> Maybe TodoStatus)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         TodoStatus)
-> Content
-> ContentParser (Maybe TodoStatus)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     TodoStatus
parseTodoStatus)
    Maybe Summary
vtSummary <- CI Text
-> (Content -> ContentParser (Maybe Summary))
-> ContentParser (Maybe Summary)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SUMMARY" ((Content -> ContentParser (Maybe Summary))
 -> ContentParser (Maybe Summary))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
    -> Content -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> Content -> ContentParser (Maybe Summary)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
 -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall a b. (a -> b) -> a -> b
$ (((Summary -> Maybe Summary
forall a. a -> Maybe a
Just (Summary -> Maybe Summary)
-> (OtherParams -> Summary) -> OtherParams -> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Summary) -> OtherParams -> Maybe Summary)
-> (Maybe Language -> OtherParams -> Summary)
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Summary)
 -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Summary)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary
Summary
    Maybe URL
vtUrl <- CI Text
-> (Content -> ContentParser (Maybe URL))
-> ContentParser (Maybe URL)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"URL" (URL -> Maybe URL
forall a. a -> Maybe a
Just (URL -> Maybe URL)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL)
-> Content
-> ContentParser (Maybe URL)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (URI -> OtherParams -> URL)
-> Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL
forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> URL
URL)
    Set RRule
vtRRule <- CI Text
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RRULE" ((Content -> ContentParser RRule) -> ContentParser (Set RRule))
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a b. (a -> b) -> a -> b
$ Maybe DTStart -> Content -> ContentParser RRule
parseRRule Maybe DTStart
vtDTStart
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set RRule -> Int
forall a. Set a -> Int
S.size Set RRule
vtRRule Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"SHOULD NOT have multiple RRules."]
    Maybe (Either Due DurationProp)
vtDueDuration <- CI Text
-> (DateTime -> OtherParams -> Due)
-> (Date -> OtherParams -> Due)
-> Maybe DTStart
-> ContentParser (Maybe (Either Due DurationProp))
forall a.
CI Text
-> (DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a)
-> Maybe DTStart
-> ContentParser (Maybe (Either a DurationProp))
parseXDurationOpt CI Text
"DUE" DateTime -> OtherParams -> Due
DueDateTime Date -> OtherParams -> Due
DueDate Maybe DTStart
vtDTStart

    Set Attachment
vtAttach <- CI Text
-> (Content -> ContentParser Attachment)
-> ContentParser (Set Attachment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTACH" Content -> ContentParser Attachment
parseAttachment
    Set Attendee
vtAttendee <- CI Text
-> (Content -> ContentParser Attendee)
-> ContentParser (Set Attendee)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTENDEE" Content -> ContentParser Attendee
parseAttendee
    Set Categories
vtCategories <- CI Text
-> (Content -> ContentParser Categories)
-> ContentParser (Set Categories)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CATEGORIES" Content -> ContentParser Categories
parseCategories
    Set Comment
vtComment <- CI Text
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"COMMENT" ((Content -> ContentParser Comment) -> ContentParser (Set Comment))
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment)
-> Content -> ContentParser Comment
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment
Comment
    Set Contact
vtContact <- CI Text
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CONTACT" ((Content -> ContentParser Contact) -> ContentParser (Set Contact))
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact)
-> Content -> ContentParser Contact
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact
Contact
    Set ExDate
vtExDate <- CI Text
-> (Content -> ContentParser ExDate) -> ContentParser (Set ExDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"EXDATE" Content -> ContentParser ExDate
parseExDate
    Set RequestStatus
vtRStatus <- CI Text
-> (Content -> ContentParser RequestStatus)
-> ContentParser (Set RequestStatus)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"REQUEST-STATUS" Content -> ContentParser RequestStatus
parseRequestStatus
    Set RelatedTo
vtRelated <- CI Text
-> (Content -> ContentParser RelatedTo)
-> ContentParser (Set RelatedTo)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RELATED-TO" Content -> ContentParser RelatedTo
parseRelatedTo
    Set Resources
vtResources <- CI Text
-> (Content -> ContentParser Resources)
-> ContentParser (Set Resources)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RESOURCES" ((Content -> ContentParser Resources)
 -> ContentParser (Set Resources))
-> (Content -> ContentParser Resources)
-> ContentParser (Set Resources)
forall a b. (a -> b) -> a -> b
$ (Set Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Resources)
-> Content -> ContentParser Resources
forall a.
(Set Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLangN Set Text -> Maybe URI -> Maybe Language -> OtherParams -> Resources
Resources
    Set RDate
vtRDate <- CI Text
-> (Content -> ContentParser RDate) -> ContentParser (Set RDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RDATE" Content -> ContentParser RDate
parseRDate
    Set VAlarm
vtAlarms <- CI Text
-> (Content -> ContentParser VAlarm) -> ContentParser (Set VAlarm)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"VALARM" Content -> ContentParser VAlarm
parseVAlarm
    Set OtherProperty
vtOther <- ContentParser (Set OtherProperty)
otherProperties
    VTodo -> ContentParser VTodo
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
vtUID :: UID
vtRecurId :: Maybe RecurrenceId
vtDTStamp :: DTStamp
vtUID :: UID
vtClass :: Class
vtCompleted :: Maybe Completed
vtCreated :: Maybe Created
vtDTStart :: Maybe DTStart
vtDescription :: Maybe Description
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 :: DTStamp
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
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
..}
parseVTodo Content
x = String -> ContentParser VTodo
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VTodo) -> String -> ContentParser VTodo
forall a b. (a -> b) -> a -> b
$ String
"parseVTodo: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a VTIMEZONE component. 3.6.5
parseVTimeZone :: Content -> ContentParser VTimeZone
parseVTimeZone :: Content -> ContentParser VTimeZone
parseVTimeZone (Component SourcePos
_ CI Text
"VTIMEZONE" [Content]
_) = do
    TZID
vtzId <- CI Text -> (Content -> ContentParser TZID) -> ContentParser TZID
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"TZID" Content -> ContentParser TZID
parseTZID
    Maybe LastModified
vtzLastMod <- CI Text
-> (Content -> ContentParser (Maybe LastModified))
-> ContentParser (Maybe LastModified)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LAST-MODIFIED" (LastModified -> Maybe LastModified
forall a. a -> Maybe a
Just (LastModified -> Maybe LastModified)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         LastModified)
-> Content
-> ContentParser (Maybe LastModified)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     LastModified
parseLastModified)
    Maybe TZUrl
vtzUrl <- CI Text
-> (Content -> ContentParser (Maybe TZUrl))
-> ContentParser (Maybe TZUrl)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"TZURL" (TZUrl -> Maybe TZUrl
forall a. a -> Maybe a
Just (TZUrl -> Maybe TZUrl)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         TZUrl)
-> Content
-> ContentParser (Maybe TZUrl)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (URI -> OtherParams -> TZUrl)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     TZUrl
forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> TZUrl
TZUrl)
    Set TZProp
vtzStandardC <- CI Text
-> (Content -> ContentParser TZProp) -> ContentParser (Set TZProp)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"STANDARD" Content -> ContentParser TZProp
parseTZProp
    Set TZProp
vtzDaylightC <- CI Text
-> (Content -> ContentParser TZProp) -> ContentParser (Set TZProp)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
"DAYLIGHT" Content -> ContentParser TZProp
parseTZProp
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set TZProp -> Int
forall a. Set a -> Int
S.size Set TZProp
vtzStandardC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set TZProp -> Int
forall a. Set a -> Int
S.size Set TZProp
vtzDaylightC Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"VTIMEZONE must include at least one of the STANDARD or \
                     \DAYLIGHT components."
    Set OtherProperty
vtzOther <- ContentParser (Set OtherProperty)
otherProperties
    VTimeZone -> ContentParser VTimeZone
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VTimeZone {Maybe LastModified
Maybe TZUrl
Set OtherProperty
Set TZProp
TZID
vtzId :: TZID
vtzId :: TZID
vtzLastMod :: Maybe LastModified
vtzUrl :: Maybe TZUrl
vtzStandardC :: Set TZProp
vtzDaylightC :: Set TZProp
vtzOther :: Set OtherProperty
vtzLastMod :: Maybe LastModified
vtzUrl :: Maybe TZUrl
vtzStandardC :: Set TZProp
vtzDaylightC :: Set TZProp
vtzOther :: Set OtherProperty
..}
parseVTimeZone Content
x = String -> ContentParser VTimeZone
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VTimeZone)
-> String -> ContentParser VTimeZone
forall a b. (a -> b) -> a -> b
$ String
"parseVTimeZone: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a STANDARD or DAYLIGHT component, tzprop. 3.6.5
parseTZProp :: Content -> ContentParser TZProp
parseTZProp :: Content -> ContentParser TZProp
parseTZProp (Component SourcePos
_ CI Text
n [Content]
_) | CI Text
n CI Text -> [CI Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CI Text
"STANDARD", CI Text
"DAYLIGHT"] = do
    DTStart
tzpDTStart <- CI Text
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DTSTART" ((Content
  -> ExceptT
       String
       (RWS DecodingFunctions [String] (SourcePos, [Content]))
       DTStart)
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      DTStart)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a b. (a -> b) -> a -> b
$
                    (DateTime -> OtherParams -> DTStart)
-> (Date -> OtherParams -> DTStart)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> DTStart
DTStartDateTime Date -> OtherParams -> DTStart
DTStartDate
    UTCOffset
tzpTZOffsetTo <- CI Text
-> (Content -> ContentParser UTCOffset) -> ContentParser UTCOffset
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"TZOFFSETTO" Content -> ContentParser UTCOffset
parseUTCOffset
    UTCOffset
tzpTZOffsetFrom <- CI Text
-> (Content -> ContentParser UTCOffset) -> ContentParser UTCOffset
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"TZOFFSETFROM" Content -> ContentParser UTCOffset
parseUTCOffset
    Set RRule
tzpRRule <- CI Text
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RRULE" (Maybe DTStart -> Content -> ContentParser RRule
parseRRule (Maybe DTStart -> Content -> ContentParser RRule)
-> Maybe DTStart -> Content -> ContentParser RRule
forall a b. (a -> b) -> a -> b
$ DTStart -> Maybe DTStart
forall a. a -> Maybe a
Just DTStart
tzpDTStart)
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set RRule -> Int
forall a. Set a -> Int
S.size Set RRule
tzpRRule Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"SHOULD NOT have multiple RRules."]
    Set Comment
tzpComment <- CI Text
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"COMMENT" ((Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment)
-> Content -> ContentParser Comment
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment
Comment)
    Set RDate
tzpRDate <- CI Text
-> (Content -> ContentParser RDate) -> ContentParser (Set RDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RDATE" Content -> ContentParser RDate
parseRDate
    Set TZName
tzpTZName <- CI Text
-> (Content -> ContentParser TZName) -> ContentParser (Set TZName)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"TZNAME" Content -> ContentParser TZName
parseTZName
    Set OtherProperty
tzpOther <- ContentParser (Set OtherProperty)
otherProperties
    TZProp -> ContentParser TZProp
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: DTStart
tzpTZOffsetTo :: UTCOffset
tzpTZOffsetFrom :: UTCOffset
tzpRRule :: Set RRule
tzpComment :: Set Comment
tzpRDate :: Set RDate
tzpTZName :: Set TZName
tzpOther :: Set OtherProperty
..}
parseTZProp Content
x = String -> ContentParser TZProp
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser TZProp) -> String -> ContentParser TZProp
forall a b. (a -> b) -> a -> b
$ String
"parseTZProp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a VALARM component. 3.6.6
parseVAlarm :: Content -> ContentParser VAlarm
parseVAlarm :: Content -> ContentParser VAlarm
parseVAlarm (Component SourcePos
_ CI Text
"VALARM" [Content]
_) = do
    ([(CI Text, [Text])]
ao, ByteString
a') <- CI Text
-> (Content -> ContentParser ([(CI Text, [Text])], ByteString))
-> ContentParser ([(CI Text, [Text])], ByteString)
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"ACTION" (\(ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) -> ([(CI Text, [Text])], ByteString)
-> ContentParser ([(CI Text, [Text])], ByteString)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(CI Text, [Text])]
o, ByteString
bs))
    Text
a <- [Text] -> ContentParser Text
forall a. [a] -> ContentParser a
valueOnlyOne ([Text] -> ContentParser Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
-> ContentParser Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
parseText ByteString
a'
    Trigger
vaTrigger <- CI Text
-> (Content -> ContentParser Trigger) -> ContentParser Trigger
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"TRIGGER" Content -> ContentParser Trigger
parseTrigger
    let vaActionOther :: OtherParams
vaActionOther = [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
ao
    case Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
a of
         CI Text
"AUDIO"   -> do
            (Repeat
vaRepeat, Maybe DurationProp
vaDuration) <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (Repeat, Maybe DurationProp)
repAndDur
            Maybe Attachment
vaAudioAttach <- CI Text
-> (Content -> ContentParser (Maybe Attachment))
-> ContentParser (Maybe Attachment)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"ATTACH" ((Content -> ContentParser (Maybe Attachment))
 -> ContentParser (Maybe Attachment))
-> (Content -> ContentParser (Maybe Attachment))
-> ContentParser (Maybe Attachment)
forall a b. (a -> b) -> a -> b
$ Attachment -> Maybe Attachment
forall a. a -> Maybe a
Just (Attachment -> Maybe Attachment)
-> (Content -> ContentParser Attachment)
-> Content
-> ContentParser (Maybe Attachment)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content -> ContentParser Attachment
parseAttachment
            Set OtherProperty
vaOther <- ContentParser (Set OtherProperty)
otherProperties
            VAlarm -> ContentParser VAlarm
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VAlarmAudio {Maybe DurationProp
Maybe Attachment
Set OtherProperty
Trigger
Repeat
OtherParams
vaTrigger :: Trigger
vaActionOther :: OtherParams
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaAudioAttach :: Maybe Attachment
vaOther :: Set OtherProperty
vaTrigger :: Trigger
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaAudioAttach :: Maybe Attachment
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
..}
         CI Text
"DISPLAY" -> do
             (Repeat
vaRepeat, Maybe DurationProp
vaDuration) <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (Repeat, Maybe DurationProp)
repAndDur
             Description
vaDescription <- CI Text
-> (Content -> ContentParser Description)
-> ContentParser Description
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DESCRIPTION" ((Content -> ContentParser Description)
 -> ContentParser Description)
-> (Content -> ContentParser Description)
-> ContentParser Description
forall a b. (a -> b) -> a -> b
$
                 (Text -> Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Content -> ContentParser Description
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Description
Description
             Set OtherProperty
vaOther <- ContentParser (Set OtherProperty)
otherProperties
             VAlarm -> ContentParser VAlarm
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VAlarmDisplay {Maybe DurationProp
Set OtherProperty
Trigger
Repeat
Description
OtherParams
vaTrigger :: Trigger
vaActionOther :: OtherParams
vaTrigger :: Trigger
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaDescription :: Description
vaOther :: Set OtherProperty
vaDescription :: Description
..}
         CI Text
"EMAIL"   -> do
             (Repeat
vaRepeat, Maybe DurationProp
vaDuration) <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (Repeat, Maybe DurationProp)
repAndDur
             Description
vaDescription <- CI Text
-> (Content -> ContentParser Description)
-> ContentParser Description
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DESCRIPTION" ((Content -> ContentParser Description)
 -> ContentParser Description)
-> (Content -> ContentParser Description)
-> ContentParser Description
forall a b. (a -> b) -> a -> b
$
                (Text -> Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Content -> ContentParser Description
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Description
Description
             Summary
vaSummary <- CI Text
-> (Content -> ContentParser Summary) -> ContentParser Summary
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"SUMMARY" ((Content -> ContentParser Summary) -> ContentParser Summary)
-> (Content -> ContentParser Summary) -> ContentParser Summary
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Content -> ContentParser Summary
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary
Summary
             Set Attendee
vaAttendee <- CI Text
-> (Content -> ContentParser Attendee)
-> ContentParser (Set Attendee)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
reqLineN CI Text
"ATTENDEE" Content -> ContentParser Attendee
parseAttendee
             Set Attachment
vaMailAttach <- CI Text
-> (Content -> ContentParser Attachment)
-> ContentParser (Set Attachment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTACH" Content -> ContentParser Attachment
parseAttachment
             Set OtherProperty
vaOther <- ContentParser (Set OtherProperty)
otherProperties
             VAlarm -> ContentParser VAlarm
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VAlarmEmail {Maybe DurationProp
Set OtherProperty
Set Attendee
Set Attachment
Trigger
Repeat
Summary
Description
OtherParams
vaTrigger :: Trigger
vaActionOther :: OtherParams
vaTrigger :: Trigger
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaDescription :: Description
vaRepeat :: Repeat
vaDuration :: Maybe DurationProp
vaDescription :: Description
vaSummary :: Summary
vaAttendee :: Set Attendee
vaMailAttach :: Set Attachment
vaOther :: Set OtherProperty
vaSummary :: Summary
vaAttendee :: Set Attendee
vaMailAttach :: Set Attachment
..}
         CI Text
vaAction  -> do Set OtherProperty
vaOther <- ContentParser (Set OtherProperty)
otherProperties
                         VAlarm -> ContentParser VAlarm
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VAlarmX {CI Text
Set OtherProperty
Trigger
OtherParams
vaTrigger :: Trigger
vaActionOther :: OtherParams
vaTrigger :: Trigger
vaOther :: Set OtherProperty
vaActionOther :: OtherParams
vaAction :: CI Text
vaOther :: Set OtherProperty
vaAction :: CI Text
..}
  where repAndDur :: ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (Repeat, Maybe DurationProp)
repAndDur = do
             Repeat
rep <- CI Text
-> (Content -> ContentParser Repeat) -> ContentParser Repeat
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"REPEAT" ((Content -> ContentParser Repeat) -> ContentParser Repeat)
-> (Content -> ContentParser Repeat) -> ContentParser Repeat
forall a b. (a -> b) -> a -> b
$ (Integer -> OtherParams -> Repeat)
-> Content -> ContentParser Repeat
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Integer -> OtherParams -> Repeat
Repeat
             Maybe DurationProp
dur <- CI Text
-> (Content -> ContentParser (Maybe DurationProp))
-> ContentParser (Maybe DurationProp)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DURATION" ((Content -> ContentParser (Maybe DurationProp))
 -> ContentParser (Maybe DurationProp))
-> (Content -> ContentParser (Maybe DurationProp))
-> ContentParser (Maybe DurationProp)
forall a b. (a -> b) -> a -> b
$ DurationProp -> Maybe DurationProp
forall a. a -> Maybe a
Just (DurationProp -> Maybe DurationProp)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DurationProp)
-> Content
-> ContentParser (Maybe DurationProp)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Maybe DTStart
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
parseDurationProp Maybe DTStart
forall a. Maybe a
Nothing
             -- Liberal interpretation:
             Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Repeat -> Integer
repeatValue Repeat
rep Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Maybe DurationProp -> Bool
forall a. Maybe a -> Bool
isNothing Maybe DurationProp
dur) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"parseVAlarm: when REPEAT > 0, DURATION must \
                              \ be specified."
             (Repeat, Maybe DurationProp)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Repeat, Maybe DurationProp)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Repeat
rep, Maybe DurationProp
dur)
parseVAlarm Content
x = String -> ContentParser VAlarm
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VAlarm) -> String -> ContentParser VAlarm
forall a b. (a -> b) -> a -> b
$ String
"parseVAlarm: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseVJournal :: Content -> ContentParser VJournal
parseVJournal :: Content -> ContentParser VJournal
parseVJournal (Component SourcePos
_ CI Text
"VJOURNAL" [Content]
_) = do
    DTStamp
vjDTStamp <- CI Text
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DTSTAMP" ((Content -> ContentParser DTStamp) -> ContentParser DTStamp)
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a b. (a -> b) -> a -> b
$ (UTCTime -> OtherParams -> DTStamp)
-> Content -> ContentParser DTStamp
forall a.
(UTCTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleUTC UTCTime -> OtherParams -> DTStamp
DTStamp
    UID
vjUID <- CI Text -> (Content -> ContentParser UID) -> ContentParser UID
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"UID" ((Content -> ContentParser UID) -> ContentParser UID)
-> (Content -> ContentParser UID) -> ContentParser UID
forall a b. (a -> b) -> a -> b
$ (Text -> OtherParams -> UID) -> Content -> ContentParser UID
forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> UID
UID
    Class
vjClass <- CI Text -> (Content -> ContentParser Class) -> ContentParser Class
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CLASS" Content -> ContentParser Class
parseClass
    Maybe Created
vjCreated <- CI Text
-> (Content -> ContentParser (Maybe Created))
-> ContentParser (Maybe Created)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CREATED" (Created -> Maybe Created
forall a. a -> Maybe a
Just (Created -> Maybe Created)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Created)
-> Content
-> ContentParser (Maybe Created)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Created
parseCreated)
    Maybe DTStart
vjDTStart <- CI Text
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DTSTART" ((Content -> ContentParser (Maybe DTStart))
 -> ContentParser (Maybe DTStart))
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall a b. (a -> b) -> a -> b
$
                DTStart -> Maybe DTStart
forall a. a -> Maybe a
Just (DTStart -> Maybe DTStart)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> Content
-> ContentParser (Maybe DTStart)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> DTStart)
-> (Date -> OtherParams -> DTStart)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> DTStart
DTStartDateTime Date -> OtherParams -> DTStart
DTStartDate
    Set Description
vjDescription <- CI Text
-> (Content -> ContentParser Description)
-> ContentParser (Set Description)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"DESCRIPTION" ((Content -> ContentParser Description)
 -> ContentParser (Set Description))
-> (Content -> ContentParser Description)
-> ContentParser (Set Description)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Description)
-> Content -> ContentParser Description
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Description
Description
    Maybe LastModified
vjLastMod <- CI Text
-> (Content -> ContentParser (Maybe LastModified))
-> ContentParser (Maybe LastModified)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"LAST-MODIFIED" (LastModified -> Maybe LastModified
forall a. a -> Maybe a
Just (LastModified -> Maybe LastModified)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         LastModified)
-> Content
-> ContentParser (Maybe LastModified)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     LastModified
parseLastModified)
    Maybe Organizer
vjOrganizer <- CI Text
-> (Content -> ContentParser (Maybe Organizer))
-> ContentParser (Maybe Organizer)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"ORGANIZER" (Organizer -> Maybe Organizer
forall a. a -> Maybe a
Just (Organizer -> Maybe Organizer)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Organizer)
-> Content
-> ContentParser (Maybe Organizer)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Organizer
parseOrganizer)
    Maybe RecurrenceId
vjRecurId <- CI Text
-> (Content -> ContentParser (Maybe RecurrenceId))
-> ContentParser (Maybe RecurrenceId)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"RECURRENCE-ID" (RecurrenceId -> Maybe RecurrenceId
forall a. a -> Maybe a
Just (RecurrenceId -> Maybe RecurrenceId)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         RecurrenceId)
-> Content
-> ContentParser (Maybe RecurrenceId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Maybe DTStart
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RecurrenceId
parseRecurId Maybe DTStart
vjDTStart)
    Sequence
vjSeq <- CI Text
-> (Content -> ContentParser Sequence) -> ContentParser Sequence
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SEQUENCE" ((Content -> ContentParser Sequence) -> ContentParser Sequence)
-> (Content -> ContentParser Sequence) -> ContentParser Sequence
forall a b. (a -> b) -> a -> b
$ (Integer -> OtherParams -> Sequence)
-> Content -> ContentParser Sequence
forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead Integer -> OtherParams -> Sequence
Sequence
    Maybe JournalStatus
vjStatus <- CI Text
-> (Content -> ContentParser (Maybe JournalStatus))
-> ContentParser (Maybe JournalStatus)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"STATUS" (JournalStatus -> Maybe JournalStatus
forall a. a -> Maybe a
Just (JournalStatus -> Maybe JournalStatus)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         JournalStatus)
-> Content
-> ContentParser (Maybe JournalStatus)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     JournalStatus
parseJournalStatus)
    Maybe Summary
vjSummary <- CI Text
-> (Content -> ContentParser (Maybe Summary))
-> ContentParser (Maybe Summary)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"SUMMARY" ((Content -> ContentParser (Maybe Summary))
 -> ContentParser (Maybe Summary))
-> ((Text
     -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
    -> Content -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (Text
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> Content -> ContentParser (Maybe Summary)
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang ((Text
  -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
 -> ContentParser (Maybe Summary))
-> (Text
    -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> ContentParser (Maybe Summary)
forall a b. (a -> b) -> a -> b
$ (((Summary -> Maybe Summary
forall a. a -> Maybe a
Just (Summary -> Maybe Summary)
-> (OtherParams -> Summary) -> OtherParams -> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((OtherParams -> Summary) -> OtherParams -> Maybe Summary)
-> (Maybe Language -> OtherParams -> Summary)
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe Language -> OtherParams -> Summary)
 -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe URI -> Maybe Language -> OtherParams -> Summary)
 -> Maybe URI -> Maybe Language -> OtherParams -> Maybe Summary)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary)
-> Text
-> Maybe URI
-> Maybe Language
-> OtherParams
-> Maybe Summary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe URI -> Maybe Language -> OtherParams -> Summary
Summary
    Maybe URL
vjUrl <- CI Text
-> (Content -> ContentParser (Maybe URL))
-> ContentParser (Maybe URL)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"URL" (URL -> Maybe URL
forall a. a -> Maybe a
Just (URL -> Maybe URL)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL)
-> Content
-> ContentParser (Maybe URL)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (URI -> OtherParams -> URL)
-> Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL
forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> URL
URL)
    Set RRule
vjRRule <- CI Text
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RRULE" ((Content -> ContentParser RRule) -> ContentParser (Set RRule))
-> (Content -> ContentParser RRule) -> ContentParser (Set RRule)
forall a b. (a -> b) -> a -> b
$ Maybe DTStart -> Content -> ContentParser RRule
parseRRule Maybe DTStart
vjDTStart
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set RRule -> Int
forall a. Set a -> Int
S.size Set RRule
vjRRule Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"SHOULD NOT have multiple RRules."]
    Set Attachment
vjAttach <- CI Text
-> (Content -> ContentParser Attachment)
-> ContentParser (Set Attachment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTACH" Content -> ContentParser Attachment
parseAttachment
    Set Attendee
vjAttendee <- CI Text
-> (Content -> ContentParser Attendee)
-> ContentParser (Set Attendee)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTENDEE" Content -> ContentParser Attendee
parseAttendee
    Set Categories
vjCategories <- CI Text
-> (Content -> ContentParser Categories)
-> ContentParser (Set Categories)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CATEGORIES" Content -> ContentParser Categories
parseCategories
    Set Comment
vjComment <- CI Text
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"COMMENT" ((Content -> ContentParser Comment) -> ContentParser (Set Comment))
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment)
-> Content -> ContentParser Comment
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment
Comment
    Set Contact
vjContact <- CI Text
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"CONTACT" ((Content -> ContentParser Contact) -> ContentParser (Set Contact))
-> (Content -> ContentParser Contact)
-> ContentParser (Set Contact)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact)
-> Content -> ContentParser Contact
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact
Contact
    Set ExDate
vjExDate <- CI Text
-> (Content -> ContentParser ExDate) -> ContentParser (Set ExDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"EXDATE" Content -> ContentParser ExDate
parseExDate
    Set RequestStatus
vjRStatus <- CI Text
-> (Content -> ContentParser RequestStatus)
-> ContentParser (Set RequestStatus)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"REQUEST-STATUS" Content -> ContentParser RequestStatus
parseRequestStatus
    Set RelatedTo
vjRelated <- CI Text
-> (Content -> ContentParser RelatedTo)
-> ContentParser (Set RelatedTo)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RELATED-TO" Content -> ContentParser RelatedTo
parseRelatedTo
    Set RDate
vjRDate <- CI Text
-> (Content -> ContentParser RDate) -> ContentParser (Set RDate)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"RDATE" Content -> ContentParser RDate
parseRDate
    Set OtherProperty
vjOther <- ContentParser (Set OtherProperty)
otherProperties
    VJournal -> ContentParser VJournal
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return 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
vjUID :: UID
vjRecurId :: Maybe RecurrenceId
vjDTStamp :: DTStamp
vjUID :: UID
vjClass :: Class
vjCreated :: Maybe Created
vjDTStart :: Maybe DTStart
vjDescription :: Set Description
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
vjExDate :: Set ExDate
vjRStatus :: Set RequestStatus
vjRelated :: Set RelatedTo
vjRDate :: Set RDate
vjOther :: Set OtherProperty
vjDTStamp :: DTStamp
vjClass :: Class
vjCreated :: Maybe Created
vjDTStart :: Maybe DTStart
vjLastMod :: Maybe LastModified
vjOrganizer :: Maybe Organizer
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
..}
parseVJournal Content
x = String -> ContentParser VJournal
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VJournal)
-> String -> ContentParser VJournal
forall a b. (a -> b) -> a -> b
$ String
"parseVJournal: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseVFreeBusy :: Content -> ContentParser VFreeBusy
parseVFreeBusy :: Content -> ContentParser VFreeBusy
parseVFreeBusy (Component SourcePos
_ CI Text
"VFreeBusy" [Content]
_) = do
    DTStamp
vfbDTStamp <- CI Text
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"DTSTAMP" ((Content -> ContentParser DTStamp) -> ContentParser DTStamp)
-> (Content -> ContentParser DTStamp) -> ContentParser DTStamp
forall a b. (a -> b) -> a -> b
$ (UTCTime -> OtherParams -> DTStamp)
-> Content -> ContentParser DTStamp
forall a.
(UTCTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleUTC UTCTime -> OtherParams -> DTStamp
DTStamp
    UID
vfbUID <- CI Text -> (Content -> ContentParser UID) -> ContentParser UID
forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
"UID" ((Content -> ContentParser UID) -> ContentParser UID)
-> (Content -> ContentParser UID) -> ContentParser UID
forall a b. (a -> b) -> a -> b
$ (Text -> OtherParams -> UID) -> Content -> ContentParser UID
forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> UID
UID
    Maybe Contact
vfbContact <- CI Text
-> (Content -> ContentParser (Maybe Contact))
-> ContentParser (Maybe Contact)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"CONTACT" ((Content -> ContentParser (Maybe Contact))
 -> ContentParser (Maybe Contact))
-> (Content -> ContentParser (Maybe Contact))
-> ContentParser (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ Contact -> Maybe Contact
forall a. a -> Maybe a
Just (Contact -> Maybe Contact)
-> (Content -> ContentParser Contact)
-> Content
-> ContentParser (Maybe Contact)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact)
-> Content -> ContentParser Contact
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Contact
Contact
    Maybe DTStart
vfbDTStart <- CI Text
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DTSTART" ((Content -> ContentParser (Maybe DTStart))
 -> ContentParser (Maybe DTStart))
-> (Content -> ContentParser (Maybe DTStart))
-> ContentParser (Maybe DTStart)
forall a b. (a -> b) -> a -> b
$
                  DTStart -> Maybe DTStart
forall a. a -> Maybe a
Just (DTStart -> Maybe DTStart)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTStart)
-> Content
-> ContentParser (Maybe DTStart)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> DTStart)
-> (Date -> OtherParams -> DTStart)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTStart
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> DTStart
DTStartDateTime Date -> OtherParams -> DTStart
DTStartDate
    Maybe DTEnd
vfbDTEnd <- CI Text
-> (Content -> ContentParser (Maybe DTEnd))
-> ContentParser (Maybe DTEnd)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"DTEND" ((Content -> ContentParser (Maybe DTEnd))
 -> ContentParser (Maybe DTEnd))
-> (Content -> ContentParser (Maybe DTEnd))
-> ContentParser (Maybe DTEnd)
forall a b. (a -> b) -> a -> b
$ DTEnd -> Maybe DTEnd
forall a. a -> Maybe a
Just (DTEnd -> Maybe DTEnd)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         DTEnd)
-> Content
-> ContentParser (Maybe DTEnd)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> DTEnd)
-> (Date -> OtherParams -> DTEnd)
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DTEnd
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime
                                                DateTime -> OtherParams -> DTEnd
DTEndDateTime Date -> OtherParams -> DTEnd
DTEndDate
    Maybe Organizer
vfbOrganizer <- CI Text
-> (Content -> ContentParser (Maybe Organizer))
-> ContentParser (Maybe Organizer)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"ORGANIZER" ((Content -> ContentParser (Maybe Organizer))
 -> ContentParser (Maybe Organizer))
-> (Content -> ContentParser (Maybe Organizer))
-> ContentParser (Maybe Organizer)
forall a b. (a -> b) -> a -> b
$ Organizer -> Maybe Organizer
forall a. a -> Maybe a
Just (Organizer -> Maybe Organizer)
-> (Content
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Organizer)
-> Content
-> ContentParser (Maybe Organizer)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Organizer
parseOrganizer
    Set Attendee
vfbAttendee <- CI Text
-> (Content -> ContentParser Attendee)
-> ContentParser (Set Attendee)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"ATTENDEE" Content -> ContentParser Attendee
parseAttendee
    Set Comment
vfbComment <- CI Text
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"COMMENT" ((Content -> ContentParser Comment) -> ContentParser (Set Comment))
-> (Content -> ContentParser Comment)
-> ContentParser (Set Comment)
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment)
-> Content -> ContentParser Comment
forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang Text -> Maybe URI -> Maybe Language -> OtherParams -> Comment
Comment
    Set RequestStatus
vfbRStatus <- CI Text
-> (Content -> ContentParser RequestStatus)
-> ContentParser (Set RequestStatus)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"REQUEST-STATUS" Content -> ContentParser RequestStatus
parseRequestStatus
    Maybe URL
vfbUrl <- CI Text
-> (Content -> ContentParser (Maybe URL))
-> ContentParser (Maybe URL)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
"URL" (URL -> Maybe URL
forall a. a -> Maybe a
Just (URL -> Maybe URL)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL)
-> Content
-> ContentParser (Maybe URL)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (URI -> OtherParams -> URL)
-> Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) URL
forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> URL
URL)
    Set FreeBusy
vfbFreeBusy <- CI Text
-> (Content -> ContentParser FreeBusy)
-> ContentParser (Set FreeBusy)
forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
"FREEBUSY" Content -> ContentParser FreeBusy
parseFreeBusy
    Set OtherProperty
vfbOther <- ContentParser (Set OtherProperty)
otherProperties
    VFreeBusy -> ContentParser VFreeBusy
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VFreeBusy {Maybe URL
Maybe Organizer
Maybe Contact
Maybe DTStart
Maybe DTEnd
Set OtherProperty
Set RequestStatus
Set Attendee
Set FreeBusy
Set Comment
DTStamp
UID
vfbUID :: UID
vfbDTStamp :: DTStamp
vfbUID :: UID
vfbContact :: Maybe Contact
vfbDTStart :: Maybe DTStart
vfbDTEnd :: Maybe DTEnd
vfbOrganizer :: Maybe Organizer
vfbAttendee :: Set Attendee
vfbComment :: Set Comment
vfbRStatus :: Set RequestStatus
vfbUrl :: Maybe URL
vfbFreeBusy :: Set FreeBusy
vfbOther :: Set OtherProperty
vfbDTStamp :: DTStamp
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
..}
parseVFreeBusy Content
x = String -> ContentParser VFreeBusy
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VFreeBusy)
-> String -> ContentParser VFreeBusy
forall a b. (a -> b) -> a -> b
$ String
"parseVFreeBusy: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

otherComponents :: ContentParser (Set VOther)
otherComponents :: ContentParser (Set VOther)
otherComponents = (Content -> ContentParser VOther)
-> ([Content], [Content]) -> ContentParser (Set VOther)
forall b.
Ord b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser (Set b)
optN Content -> ContentParser VOther
parseVOther (([Content], [Content]) -> ContentParser (Set VOther))
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser (Set VOther)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Content -> Bool
isComponent ([Content] -> ContentParser (Set VOther))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser (Set VOther)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

parseVOther :: Content -> ContentParser VOther
parseVOther :: Content -> ContentParser VOther
parseVOther (Component SourcePos
_ CI Text
voName [Content]
_) = do
    Set OtherProperty
voProps <- ContentParser (Set OtherProperty)
otherProperties
    VOther -> ContentParser VOther
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return VOther {CI Text
Set OtherProperty
voName :: CI Text
voProps :: Set OtherProperty
voName :: CI Text
voProps :: Set OtherProperty
..}
parseVOther Content
x = String -> ContentParser VOther
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser VOther) -> String -> ContentParser VOther
forall a b. (a -> b) -> a -> b
$ String
"parseVOther: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x