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

import           Control.Applicative
import           Control.Monad                (when, (<=<))
import           Control.Monad.Except         hiding (mapM)
import           Control.Monad.RWS            (asks)
import qualified Data.ByteString.Base64.Lazy  as B64
import qualified Data.ByteString.Lazy.Char8   as B
import           Data.CaseInsensitive         (CI)
import qualified Data.CaseInsensitive         as CI
import           Data.Char
import           Data.Default
import           Data.Maybe
import qualified Data.Set                     as S
import           Data.Text.Lazy               (Text)
import qualified Data.Text.Lazy               as T
import           Data.Traversable             (mapM)
import qualified Data.Version                 as Ver
import           Prelude                      hiding (mapM)
import           Text.ParserCombinators.ReadP (readP_to_S)

import Text.Parsec.Prim hiding ((<|>))

import Text.ICalendar.Parser.Common
import Text.ICalendar.Parser.Parameters
import Text.ICalendar.Types

parseFreeBusy :: Content -> ContentParser FreeBusy
parseFreeBusy :: Content -> ContentParser FreeBusy
parseFreeBusy (ContentLine SourcePos
_ CI Text
"FREEBUSY" [(CI Text, [Text])]
o ByteString
bs) = do
    FBType
typ <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  FBType
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         FBType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     FBType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FBType
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     FBType
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return FBType
forall a. Default a => a
def) (CI Text -> FBType
parseFBType (CI Text -> FBType) -> (Text -> CI Text) -> Text -> FBType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> FBType)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     FBType
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      FBType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     FBType
forall a b. (a -> b) -> a -> b
$
                     CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"FBTYPE" [(CI Text, [Text])]
o
    Set UTCPeriod
periods <- [UTCPeriod] -> Set UTCPeriod
forall a. Ord a => [a] -> Set a
S.fromList ([UTCPeriod] -> Set UTCPeriod)
-> ([ByteString]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [UTCPeriod])
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set UTCPeriod)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (ByteString
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      UTCPeriod)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [UTCPeriod]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     UTCPeriod
parseUTCPeriod ([ByteString]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set UTCPeriod))
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set UTCPeriod)
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
B.split Char
',' ByteString
bs
    FreeBusy -> ContentParser FreeBusy
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeBusy -> ContentParser FreeBusy)
-> FreeBusy -> ContentParser FreeBusy
forall a b. (a -> b) -> a -> b
$ FBType -> Set UTCPeriod -> OtherParams -> FreeBusy
FreeBusy FBType
typ Set UTCPeriod
periods ([(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])] -> OtherParams
forall a b. (a -> b) -> a -> b
$ ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/=CI Text
"FBTYPE")(CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o)
parseFreeBusy Content
x = String -> ContentParser FreeBusy
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser FreeBusy)
-> String -> ContentParser FreeBusy
forall a b. (a -> b) -> a -> b
$ String
"parseFreeBusy: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseXDurationOpt :: CI Text
                  -> (DateTime -> OtherParams -> a)
                  -> (Date     -> OtherParams -> a)
                  -> Maybe DTStart
                  -> ContentParser (Maybe (Either a DurationProp))
parseXDurationOpt :: forall a.
CI Text
-> (DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a)
-> Maybe DTStart
-> ContentParser (Maybe (Either a DurationProp))
parseXDurationOpt CI Text
w DateTime -> OtherParams -> a
a Date -> OtherParams -> a
b Maybe DTStart
dts = do
    Maybe a
dte <- CI Text
-> (Content -> ContentParser (Maybe a)) -> ContentParser (Maybe a)
forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
w ((Content -> ContentParser (Maybe a)) -> ContentParser (Maybe a))
-> (Content -> ContentParser (Maybe a)) -> ContentParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> (Content
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) a)
-> Content
-> ContentParser (Maybe a)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a)
-> Content
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> a
a Date -> OtherParams -> a
b
    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
dts
    case (Maybe a
dte, Maybe DurationProp
dur) of
         (Maybe a
Nothing, Maybe DurationProp
Nothing) -> Maybe (Either a DurationProp)
-> ContentParser (Maybe (Either a DurationProp))
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either a DurationProp)
forall a. Maybe a
Nothing
         (Just a
x, Maybe DurationProp
Nothing) -> Maybe (Either a DurationProp)
-> ContentParser (Maybe (Either a DurationProp))
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either a DurationProp)
 -> ContentParser (Maybe (Either a DurationProp)))
-> (Either a DurationProp -> Maybe (Either a DurationProp))
-> Either a DurationProp
-> ContentParser (Maybe (Either a DurationProp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a DurationProp -> Maybe (Either a DurationProp)
forall a. a -> Maybe a
Just (Either a DurationProp
 -> ContentParser (Maybe (Either a DurationProp)))
-> Either a DurationProp
-> ContentParser (Maybe (Either a DurationProp))
forall a b. (a -> b) -> a -> b
$ a -> Either a DurationProp
forall a b. a -> Either a b
Left a
x
         (Maybe a
Nothing, Just DurationProp
x) -> Maybe (Either a DurationProp)
-> ContentParser (Maybe (Either a DurationProp))
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either a DurationProp)
 -> ContentParser (Maybe (Either a DurationProp)))
-> (Either a DurationProp -> Maybe (Either a DurationProp))
-> Either a DurationProp
-> ContentParser (Maybe (Either a DurationProp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a DurationProp -> Maybe (Either a DurationProp)
forall a. a -> Maybe a
Just (Either a DurationProp
 -> ContentParser (Maybe (Either a DurationProp)))
-> Either a DurationProp
-> ContentParser (Maybe (Either a DurationProp))
forall a b. (a -> b) -> a -> b
$ DurationProp -> Either a DurationProp
forall a b. b -> Either a b
Right DurationProp
x
         (Maybe a, Maybe DurationProp)
_ -> String -> ContentParser (Maybe (Either a DurationProp))
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Either DTEND or DURATION can be specified, but not \
                         \both."

-- | Parse trigger. 3.8.6.3
parseTrigger :: Content -> ContentParser Trigger
parseTrigger :: Content -> ContentParser Trigger
parseTrigger (ContentLine SourcePos
_ CI Text
"TRIGGER" [(CI Text, [Text])]
o ByteString
bs) = do
    Text
value <- [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> (Maybe [Text] -> [Text])
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text
"DURATION"] (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"VALUE" [(CI Text, [Text])]
o
    case Text
value of
         Text
"DURATION" -> do
            AlarmTriggerRelationship
rel <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  AlarmTriggerRelationship
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         AlarmTriggerRelationship)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AlarmTriggerRelationship
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return AlarmTriggerRelationship
forall a. Default a => a
def)
                         (CI Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
parseAlarmTriggerRelationship (CI Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      AlarmTriggerRelationship)
-> (Text -> CI Text)
-> Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk
                               (Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      AlarmTriggerRelationship)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      AlarmTriggerRelationship)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     AlarmTriggerRelationship
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"RELATED" [(CI Text, [Text])]
o
            let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x,[Text]
_) -> CI Text
x CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/= CI Text
"VALUE" Bool -> Bool -> Bool
&& CI Text
x CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/= CI Text
"RELATED") [(CI Text, [Text])]
o
            Duration
val <- String -> ByteString -> ContentParser Duration
parseDuration String
"TRIGGER" ByteString
bs
            Trigger -> ContentParser Trigger
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Trigger -> ContentParser Trigger)
-> Trigger -> ContentParser Trigger
forall a b. (a -> b) -> a -> b
$ Duration -> AlarmTriggerRelationship -> OtherParams -> Trigger
TriggerDuration Duration
val AlarmTriggerRelationship
rel ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o')
         Text
"DATE-TIME" -> do UTCTime
val <- DateTime -> ContentParser UTCTime
mustBeUTC (DateTime -> ContentParser UTCTime)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
-> ContentParser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
parseDateTime Maybe Text
forall a. Maybe a
Nothing ByteString
bs
                           let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x, [Text]
_) -> CI Text
x CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/= CI Text
"VALUE") [(CI Text, [Text])]
o
                           Trigger -> ContentParser Trigger
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Trigger -> ContentParser Trigger)
-> Trigger -> ContentParser Trigger
forall a b. (a -> b) -> a -> b
$ UTCTime -> OtherParams -> Trigger
TriggerDateTime UTCTime
val ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o')
         Text
x -> String -> ContentParser Trigger
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Trigger)
-> String -> ContentParser Trigger
forall a b. (a -> b) -> a -> b
$ String
"parseTrigger: invalid value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
x
parseTrigger Content
x = String -> ContentParser Trigger
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Trigger)
-> String -> ContentParser Trigger
forall a b. (a -> b) -> a -> b
$ String
"parseTrigger: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x


-- | Parse related to. 3.8.4.5
parseRelatedTo :: Content -> ContentParser RelatedTo
parseRelatedTo :: Content -> ContentParser RelatedTo
parseRelatedTo (ContentLine SourcePos
_ CI Text
"RELATED-TO" [(CI Text, [Text])]
o ByteString
bs) = do
    Text
val <- [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
valueOnlyOne ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) 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
bs
    RelationshipType
typ <- ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  RelationshipType
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         RelationshipType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RelationshipType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RelationshipType
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RelationshipType
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return RelationshipType
forall a. Default a => a
def) (CI Text -> RelationshipType
parseRelationshipType (CI Text -> RelationshipType)
-> (Text -> CI Text) -> Text -> RelationshipType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> RelationshipType)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RelationshipType
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      RelationshipType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     RelationshipType
forall a b. (a -> b) -> a -> b
$
                CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"RELTYPE" [(CI Text, [Text])]
o
    RelatedTo -> ContentParser RelatedTo
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelatedTo -> ContentParser RelatedTo)
-> RelatedTo -> ContentParser RelatedTo
forall a b. (a -> b) -> a -> b
$ Text -> RelationshipType -> OtherParams -> RelatedTo
RelatedTo Text
val RelationshipType
typ ([(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])] -> OtherParams
forall a b. (a -> b) -> a -> b
$ ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x,[Text]
_) -> CI Text
x CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/= CI Text
"RELTYPE") [(CI Text, [Text])]
o)
parseRelatedTo Content
x = String -> ContentParser RelatedTo
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RelatedTo)
-> String -> ContentParser RelatedTo
forall a b. (a -> b) -> a -> b
$ String
"parseRelatedTo: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x


-- | Parse request status. 3.8.8.3
parseRequestStatus :: Content -> ContentParser RequestStatus
parseRequestStatus :: Content -> ContentParser RequestStatus
parseRequestStatus (ContentLine SourcePos
_ CI Text
"REQUEST-STATUS" [(CI Text, [Text])]
o ByteString
bs) = do
    let (ByteString
statcode', ByteString
rest) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') ByteString
bs
        statcode :: Maybe [Int]
        statcode :: Maybe [Int]
statcode = (ByteString -> Maybe Int) -> [ByteString] -> Maybe [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> Maybe Int
forall a. Read a => String -> Maybe a
maybeRead (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack) ([ByteString] -> Maybe [Int]) -> [ByteString] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
B.split Char
'.' ByteString
statcode'
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe [Int] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Int]
statcode) (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
"parseRequestStatus: invalid code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
rest) (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
"parseRequestStatus: missing statdesc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
    (Text
statdesc, ByteString
rest') <- (\([Text]
a,ByteString
b) -> (,ByteString
b) (Text -> (Text, ByteString))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Text, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
valueOnlyOne [Text]
a)
                                   (([Text], ByteString)
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Text, ByteString))
-> (ByteString
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         ([Text], ByteString))
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Text, ByteString)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     ([Text], ByteString)
parseText' (ByteString
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Text, ByteString))
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Text, ByteString)
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
rest
    Maybe Text
statext <- if ByteString -> Bool
B.null ByteString
rest'
                  then Maybe Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
                  else do Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Char
B.head ByteString
rest' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') (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
"parseRequestStatus: bad desc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                               ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
                          Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
valueOnlyOne ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
parseText (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
rest'))
    Maybe Language
lang <- ([Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$ CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language) -> Maybe [Text] -> Maybe [Language]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x, [Text]
_) -> CI Text
x CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CI Text
"LANGUAGE"]) [(CI Text, [Text])]
o
    RequestStatus -> ContentParser RequestStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestStatus -> ContentParser RequestStatus)
-> RequestStatus -> ContentParser RequestStatus
forall a b. (a -> b) -> a -> b
$ [Int]
-> Text
-> Maybe Language
-> Maybe Text
-> OtherParams
-> RequestStatus
RequestStatus (Maybe [Int] -> [Int]
forall a. HasCallStack => Maybe a -> a
fromJust Maybe [Int]
statcode) Text
statdesc Maybe Language
lang Maybe Text
statext ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o')
parseRequestStatus Content
x = String -> ContentParser RequestStatus
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RequestStatus)
-> String -> ContentParser RequestStatus
forall a b. (a -> b) -> a -> b
$ String
"parseRequestStatus: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse exception date-times. 3.8.5.1
parseExDate :: Content -> ContentParser ExDate
parseExDate :: Content -> ContentParser ExDate
parseExDate (ContentLine SourcePos
_ CI Text
"EXDATE" [(CI Text, [Text])]
o ByteString
bs) = do
    (Text
typ, Maybe Text
tzid, [(CI Text, [Text])]
o') <- [(CI Text, [Text])]
-> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
typTzIdO [(CI Text, [Text])]
o
    let bs' :: [ByteString]
bs' = Char -> ByteString -> [ByteString]
B.split Char
',' ByteString
bs
    case Text
typ of
         Text
"DATE-TIME" -> do [DateTime]
xs <- (ByteString
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      DateTime)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [DateTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe Text
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
parseDateTime Maybe Text
tzid) [ByteString]
bs'
                           ExDate -> ContentParser ExDate
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExDate -> ContentParser ExDate)
-> (OtherParams -> ExDate) -> OtherParams -> ContentParser ExDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DateTime -> OtherParams -> ExDate
ExDateTimes ([DateTime] -> Set DateTime
forall a. Ord a => [a] -> Set a
S.fromList [DateTime]
xs) (OtherParams -> ContentParser ExDate)
-> OtherParams -> ContentParser ExDate
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
"DATE" -> do [Date]
xs <- (ByteString
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Date)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Date]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Date
parseDate [ByteString]
bs'
                      ExDate -> ContentParser ExDate
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExDate -> ContentParser ExDate)
-> (OtherParams -> ExDate) -> OtherParams -> ContentParser ExDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Date -> OtherParams -> ExDate
ExDates ([Date] -> Set Date
forall a. Ord a => [a] -> Set a
S.fromList [Date]
xs) (OtherParams -> ContentParser ExDate)
-> OtherParams -> ContentParser ExDate
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
_ -> String -> ContentParser ExDate
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser ExDate) -> String -> ContentParser ExDate
forall a b. (a -> b) -> a -> b
$ String
"Invalid type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
typ
parseExDate Content
x = String -> ContentParser ExDate
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser ExDate) -> String -> ContentParser ExDate
forall a b. (a -> b) -> a -> b
$ String
"parseExDate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse categories. 3.8.1.2
parseCategories :: Content -> ContentParser Categories
parseCategories :: Content -> ContentParser Categories
parseCategories (ContentLine SourcePos
_ CI Text
"CATEGORIES" [(CI Text, [Text])]
o ByteString
bs) = do
    [Text]
vals <- ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
parseText ByteString
bs
    Maybe Language
lang <- ([Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$ CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language) -> Maybe [Text] -> Maybe [Language]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x, [Text]
_) -> CI Text
x CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CI Text
"LANGUAGE"]) [(CI Text, [Text])]
o
    Categories -> ContentParser Categories
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Categories -> ContentParser Categories)
-> Categories -> ContentParser Categories
forall a b. (a -> b) -> a -> b
$ Set Text -> Maybe Language -> OtherParams -> Categories
Categories ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
vals) Maybe Language
lang ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o')
parseCategories Content
x = String -> ContentParser Categories
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Categories)
-> String -> ContentParser Categories
forall a b. (a -> b) -> a -> b
$ String
"parseCategories: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse attendee. 3.8.4.1
parseAttendee :: Content -> ContentParser Attendee
parseAttendee :: Content -> ContentParser Attendee
parseAttendee (ContentLine SourcePos
_ CI Text
"ATTENDEE" [(CI Text, [Text])]
o ByteString
bs) = do
    CalAddress
attendeeValue <- String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
-> ContentParser CalAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text)
    CUType
attendeeCUType <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      CUType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     CUType
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g (CI Text -> CUType
parseCUType (CI Text -> CUType) -> (Text -> CI Text) -> Text -> CUType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CUType)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     CUType
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      CUType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     CUType
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"CUTYPE" [(CI Text, [Text])]
o
    Set CalAddress
attendeeMember <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g ([CalAddress] -> Set CalAddress
forall a. Ord a => [a] -> Set a
S.fromList ([CalAddress] -> Set CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [CalAddress])
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (Text -> ContentParser CalAddress)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [CalAddress]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"MEMBER" [(CI Text, [Text])]
o
    Role
attendeeRole <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Role)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Role
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g (CI Text -> Role
parseRole (CI Text -> Role) -> (Text -> CI Text) -> Text -> Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Role)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Role
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Role)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Role
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"ROLE" [(CI Text, [Text])]
o
    PartStat
attendeePartStat <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      PartStat)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     PartStat
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g (CI Text -> PartStat
parsePartStat (CI Text -> PartStat) -> (Text -> CI Text) -> Text -> PartStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> PartStat)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     PartStat
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      PartStat)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     PartStat
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"PARTSTAT" [(CI Text, [Text])]
o
    Bool
attendeeRSVP <- ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Bool)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (CI Text
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
parseBool (CI Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Bool)
-> (Text -> CI Text)
-> Text
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Bool)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Bool)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Bool
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"RSVP" [(CI Text, [Text])]
o
    Set CalAddress
attendeeDelTo <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g ([CalAddress] -> Set CalAddress
forall a. Ord a => [a] -> Set a
S.fromList ([CalAddress] -> Set CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [CalAddress])
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (Text -> ContentParser CalAddress)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [CalAddress]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"DELEGATED-TO" [(CI Text, [Text])]
o
    Set CalAddress
attendeeDelFrom <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g ([CalAddress] -> Set CalAddress
forall a. Ord a => [a] -> Set a
S.fromList ([CalAddress] -> Set CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [CalAddress])
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (Text -> ContentParser CalAddress)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [CalAddress]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set CalAddress)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"DELEGATED-FROM" [(CI Text, [Text])]
o
    Maybe CalAddress
attendeeSentBy <- ([Text] -> ContentParser CalAddress)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ContentParser CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ContentParser CalAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"SENT-BY" [(CI Text, [Text])]
o
    Maybe Text
attendeeCN <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"CN" [(CI Text, [Text])]
o
    Maybe CalAddress
attendeeDir <- ([Text] -> ContentParser CalAddress)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ContentParser CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ContentParser CalAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"DIR" [(CI Text, [Text])]
o
    Maybe Language
attendeeLanguage <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$
                        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    let attendeeOther :: OtherParams
attendeeOther = [(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])] -> OtherParams
forall a b. (a -> b) -> a -> b
$ ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI Text, [Text]) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
f [(CI Text, [Text])]
o
        f :: (a, b) -> Bool
f (a
x, b
_) = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ a
"CUTYPE", a
"MEMBER", a
"ROLE", a
"PARTSTAT", a
"RSVP"
                               , a
"DELEGATED-TO", a
"DELEGATED-FROM", a
"SENT-BY"
                               , a
"CN", a
"DIR"]
    Attendee -> ContentParser Attendee
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Attendee {Bool
Maybe CalAddress
Maybe Text
Maybe Language
Set CalAddress
CalAddress
PartStat
Role
CUType
OtherParams
attendeeValue :: CalAddress
attendeeCUType :: CUType
attendeeMember :: Set CalAddress
attendeeRole :: Role
attendeePartStat :: PartStat
attendeeRSVP :: Bool
attendeeDelTo :: Set CalAddress
attendeeDelFrom :: Set CalAddress
attendeeSentBy :: Maybe CalAddress
attendeeCN :: Maybe Text
attendeeDir :: Maybe CalAddress
attendeeLanguage :: Maybe Language
attendeeOther :: OtherParams
attendeeValue :: CalAddress
attendeeCUType :: CUType
attendeeMember :: Set CalAddress
attendeeRole :: Role
attendeePartStat :: PartStat
attendeeRSVP :: Bool
attendeeDelTo :: Set CalAddress
attendeeDelFrom :: Set CalAddress
attendeeSentBy :: Maybe CalAddress
attendeeCN :: Maybe Text
attendeeDir :: Maybe CalAddress
attendeeLanguage :: Maybe Language
attendeeOther :: OtherParams
..}
  where g :: (Monad m, Default b) => (a -> m b) -> Maybe a -> m b
        g :: forall (m :: * -> *) b a.
(Monad m, Default b) =>
(a -> m b) -> Maybe a -> m b
g = m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (m b -> (a -> m b) -> Maybe a -> m b)
-> m b -> (a -> m b) -> Maybe a -> m b
forall a b. (a -> b) -> a -> b
$ b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def
parseAttendee Content
x = String -> ContentParser Attendee
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Attendee)
-> String -> ContentParser Attendee
forall a b. (a -> b) -> a -> b
$ String
"parseAttendee: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x


-- | Parse attachment. 3.8.1.1
parseAttachment :: Content -> ContentParser Attachment
parseAttachment :: Content -> ContentParser Attachment
parseAttachment (ContentLine SourcePos
_ CI Text
"ATTACH" [(CI Text, [Text])]
o ByteString
bs) = do
    Maybe MIMEType
fmt <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      MIMEType)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe MIMEType)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     MIMEType
parseMime (Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      MIMEType)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     MIMEType
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe MIMEType))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe MIMEType)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"FMTTYPE" [(CI Text, [Text])]
o
    Maybe Text
val <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"VALUE" [(CI Text, [Text])]
o
    case Maybe Text
val of
         Just Text
"BINARY" -> do
             Maybe Text
enc <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"ENCODING" [(CI Text, [Text])]
o
             case Maybe Text
enc of
                  Just Text
"BASE64" ->
                      case ByteString -> Either String ByteString
B64.decode ByteString
bs of
                           Left String
e -> String -> ContentParser Attachment
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Attachment)
-> String -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ String
"parseAttachment: invalid \
                                                  \base64: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
                           Right ByteString
v -> Attachment -> ContentParser Attachment
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attachment -> ContentParser Attachment)
-> Attachment -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ Maybe MIMEType -> ByteString -> OtherParams -> Attachment
BinaryAttachment Maybe MIMEType
fmt ByteString
v
                                                  ([(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])] -> OtherParams
forall a b. (a -> b) -> a -> b
$ ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI Text, [Text]) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
binF [(CI Text, [Text])]
o)
                  Maybe Text
_ -> String -> ContentParser Attachment
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Attachment)
-> String -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ String
"parseAttachment: invalid encoding: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                        Maybe Text -> String
forall a. Show a => a -> String
show Maybe Text
enc
         Maybe Text
Nothing -> do CalAddress
uri <- String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
-> ContentParser CalAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text)
                       Attachment -> ContentParser Attachment
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Attachment -> ContentParser Attachment)
-> Attachment -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ Maybe MIMEType -> CalAddress -> OtherParams -> Attachment
UriAttachment Maybe MIMEType
fmt CalAddress
uri ([(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])] -> OtherParams
forall a b. (a -> b) -> a -> b
$ ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI Text, [Text]) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
f [(CI Text, [Text])]
o)
         Maybe Text
_ -> String -> ContentParser Attachment
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Attachment)
-> String -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ String
"parseAttachment: invalid value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Text -> String
forall a. Show a => a -> String
show Maybe Text
val
  where binF :: (a, b) -> Bool
binF a :: (a, b)
a@(a
x, b
_) = (a, b) -> Bool
forall {a} {b}. (Eq a, IsString a) => (a, b) -> Bool
f (a, b)
a Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"VALUE" Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"ENCODING"
        f :: (a, b) -> Bool
f (a
x, b
_) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"FMTTYPE"
parseAttachment Content
x = String -> ContentParser Attachment
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Attachment)
-> String -> ContentParser Attachment
forall a b. (a -> b) -> a -> b
$ String
"parseAttachment: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseDurationProp :: Maybe DTStart -> Content -> ContentParser DurationProp
parseDurationProp :: Maybe DTStart
-> Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
parseDurationProp Maybe DTStart
dts (ContentLine SourcePos
_ CI Text
"DURATION" [(CI Text, [Text])]
o ByteString
bs) = do
    Duration
val <- String -> ByteString -> ContentParser Duration
parseDuration String
"DURATION" ByteString
bs
    case (Maybe DTStart
dts, Duration
val) of
         (Just DTStartDate {}, DurationDate {Int
Sign
durSign :: Sign
durDay :: Int
durHour :: Int
durMinute :: Int
durSecond :: Int
durSign :: Duration -> Sign
durDay :: Duration -> Int
durHour :: Duration -> Int
durMinute :: Duration -> Int
durSecond :: Duration -> Int
..})
            | Int
durHour Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
durMinute Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
durSecond Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         (Just DTStartDate {}, DurationWeek {}) -> ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         (Just DTStartDate {}, Duration
_) ->
             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
"DURATION must be in weeks or days when DTSTART \
                        \has VALUE DATE and not DATE-TIME."
         (Maybe DTStart, Duration)
_ -> ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    DurationProp
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DurationProp
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      DurationProp)
-> (OtherParams -> DurationProp)
-> OtherParams
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> OtherParams -> DurationProp
DurationProp Duration
val (OtherParams
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      DurationProp)
-> OtherParams
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseDurationProp Maybe DTStart
_ Content
x = String
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
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]))
      DurationProp)
-> String
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DurationProp
forall a b. (a -> b) -> a -> b
$ String
"parseDurationProp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseRecurId :: Maybe DTStart -> Content -> ContentParser RecurrenceId
parseRecurId :: Maybe DTStart -> Content -> ContentParser RecurrenceId
parseRecurId Maybe DTStart
dts (ContentLine SourcePos
p CI Text
"RECURRENCE-ID" [(CI Text, [Text])]
o ByteString
bs) = do
    Maybe Range
range' <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Range)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Range)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (CI Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Range
parseRange (CI Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Range)
-> (Text -> CI Text)
-> Text
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Range)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Range
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Range))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Range)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"RANGE" [(CI Text, [Text])]
o
    RecurrenceId
recurid <- (DateTime -> OtherParams -> RecurrenceId)
-> (Date -> OtherParams -> RecurrenceId)
-> Content
-> ContentParser RecurrenceId
forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime
            (((Maybe Range -> OtherParams -> RecurrenceId)
-> Maybe Range -> OtherParams -> RecurrenceId
forall a b. (a -> b) -> a -> b
$ Maybe Range
range') ((Maybe Range -> OtherParams -> RecurrenceId)
 -> OtherParams -> RecurrenceId)
-> (DateTime -> Maybe Range -> OtherParams -> RecurrenceId)
-> DateTime
-> OtherParams
-> RecurrenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateTime -> Maybe Range -> OtherParams -> RecurrenceId
RecurrenceIdDateTime)
            (((Maybe Range -> OtherParams -> RecurrenceId)
-> Maybe Range -> OtherParams -> RecurrenceId
forall a b. (a -> b) -> a -> b
$ Maybe Range
range') ((Maybe Range -> OtherParams -> RecurrenceId)
 -> OtherParams -> RecurrenceId)
-> (Date -> Maybe Range -> OtherParams -> RecurrenceId)
-> Date
-> OtherParams
-> RecurrenceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Maybe Range -> OtherParams -> RecurrenceId
RecurrenceIdDate)
            (SourcePos
-> CI Text -> [(CI Text, [Text])] -> ByteString -> Content
ContentLine SourcePos
p CI Text
"RECURRENCE-ID" (((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/=CI Text
"RANGE")(CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o) ByteString
bs)
    case (Maybe DTStart
dts, RecurrenceId
recurid) of
         (Maybe DTStart
Nothing, RecurrenceId
_) -> RecurrenceId -> ContentParser RecurrenceId
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return RecurrenceId
recurid
         (Just DTStartDate {}, RecurrenceIdDate {}) ->
             RecurrenceId -> ContentParser RecurrenceId
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return RecurrenceId
recurid
         (Just DTStartDateTime {dtStartDateTimeValue :: DTStart -> DateTime
dtStartDateTimeValue = DateTime
v},
          RecurrenceIdDateTime {recurrenceIdDateTime :: RecurrenceId -> DateTime
recurrenceIdDateTime = DateTime
r}) ->
               case (DateTime
v, DateTime
r) of -- TODO: Check this. iff confuse me.
                    (UTCDateTime {}, FloatingDateTime {}) -> Maybe DTStart -> RecurrenceId -> ContentParser RecurrenceId
forall {m :: * -> *} {a} {b} {a}.
(MonadError String m, Show a, Show b) =>
a -> b -> m a
err Maybe DTStart
dts RecurrenceId
recurid
                    (UTCDateTime {}, ZonedDateTime {})    -> Maybe DTStart -> RecurrenceId -> ContentParser RecurrenceId
forall {m :: * -> *} {a} {b} {a}.
(MonadError String m, Show a, Show b) =>
a -> b -> m a
err Maybe DTStart
dts RecurrenceId
recurid
                    (FloatingDateTime {}, UTCDateTime {}) -> Maybe DTStart -> RecurrenceId -> ContentParser RecurrenceId
forall {m :: * -> *} {a} {b} {a}.
(MonadError String m, Show a, Show b) =>
a -> b -> m a
err Maybe DTStart
dts RecurrenceId
recurid
                    (ZonedDateTime {}, UTCDateTime {})    -> Maybe DTStart -> RecurrenceId -> ContentParser RecurrenceId
forall {m :: * -> *} {a} {b} {a}.
(MonadError String m, Show a, Show b) =>
a -> b -> m a
err Maybe DTStart
dts RecurrenceId
recurid
                    (DateTime, DateTime)
_ -> RecurrenceId -> ContentParser RecurrenceId
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return RecurrenceId
recurid
         (Maybe DTStart, RecurrenceId)
_ -> Maybe DTStart -> RecurrenceId -> ContentParser RecurrenceId
forall {m :: * -> *} {a} {b} {a}.
(MonadError String m, Show a, Show b) =>
a -> b -> m a
err Maybe DTStart
dts RecurrenceId
recurid
  where err :: a -> b -> m a
err a
d b
r = String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"parseRecurId: DTSTART local time mismatch: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                (a, b) -> String
forall a. Show a => a -> String
show (a
d, b
r)
parseRecurId Maybe DTStart
_ Content
x = String -> ContentParser RecurrenceId
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RecurrenceId)
-> String -> ContentParser RecurrenceId
forall a b. (a -> b) -> a -> b
$ String
"parseRecurId: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse time transparency. 3.8.2.7
parseTransp :: Content -> ContentParser TimeTransparency
parseTransp :: Content -> ContentParser TimeTransparency
parseTransp (ContentLine SourcePos
_ CI Text
"TRANSP" [(CI Text, [Text])]
o ByteString
x)
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"OPAQUE" = TimeTransparency -> ContentParser TimeTransparency
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeTransparency -> ContentParser TimeTransparency)
-> (OtherParams -> TimeTransparency)
-> OtherParams
-> ContentParser TimeTransparency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TimeTransparency
Opaque (OtherParams -> ContentParser TimeTransparency)
-> OtherParams -> ContentParser TimeTransparency
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"TRANSPARENT" = TimeTransparency -> ContentParser TimeTransparency
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeTransparency -> ContentParser TimeTransparency)
-> (OtherParams -> TimeTransparency)
-> OtherParams
-> ContentParser TimeTransparency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TimeTransparency
Transparent (OtherParams -> ContentParser TimeTransparency)
-> OtherParams -> ContentParser TimeTransparency
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseTransp Content
x = String -> ContentParser TimeTransparency
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser TimeTransparency)
-> String -> ContentParser TimeTransparency
forall a b. (a -> b) -> a -> b
$ String
"parseTransp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse event status. 3.8.1.11
parseEventStatus :: Content -> ContentParser EventStatus
parseEventStatus :: Content -> ContentParser EventStatus
parseEventStatus (ContentLine SourcePos
_ CI Text
"STATUS" [(CI Text, [Text])]
o ByteString
x)
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"TENTATIVE" = EventStatus -> ContentParser EventStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventStatus -> ContentParser EventStatus)
-> (OtherParams -> EventStatus)
-> OtherParams
-> ContentParser EventStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> EventStatus
TentativeEvent (OtherParams -> ContentParser EventStatus)
-> OtherParams -> ContentParser EventStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"CONFIRMED" = EventStatus -> ContentParser EventStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventStatus -> ContentParser EventStatus)
-> (OtherParams -> EventStatus)
-> OtherParams
-> ContentParser EventStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> EventStatus
ConfirmedEvent (OtherParams -> ContentParser EventStatus)
-> OtherParams -> ContentParser EventStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"CANCELLED" = EventStatus -> ContentParser EventStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventStatus -> ContentParser EventStatus)
-> (OtherParams -> EventStatus)
-> OtherParams
-> ContentParser EventStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> EventStatus
CancelledEvent (OtherParams -> ContentParser EventStatus)
-> OtherParams -> ContentParser EventStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseEventStatus Content
x = String -> ContentParser EventStatus
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser EventStatus)
-> String -> ContentParser EventStatus
forall a b. (a -> b) -> a -> b
$ String
"parseEventStatus: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse todo status. 3.8.1.11
parseTodoStatus :: Content -> ContentParser TodoStatus
parseTodoStatus :: Content -> ContentParser TodoStatus
parseTodoStatus (ContentLine SourcePos
_ CI Text
"STATUS" [(CI Text, [Text])]
o ByteString
x)
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"NEEDS-ACTION" = TodoStatus -> ContentParser TodoStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TodoStatus -> ContentParser TodoStatus)
-> (OtherParams -> TodoStatus)
-> OtherParams
-> ContentParser TodoStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TodoStatus
TodoNeedsAction (OtherParams -> ContentParser TodoStatus)
-> OtherParams -> ContentParser TodoStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"COMPLETED"    = TodoStatus -> ContentParser TodoStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TodoStatus -> ContentParser TodoStatus)
-> (OtherParams -> TodoStatus)
-> OtherParams
-> ContentParser TodoStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TodoStatus
CompletedTodo   (OtherParams -> ContentParser TodoStatus)
-> OtherParams -> ContentParser TodoStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"IN-PROCESS"   = TodoStatus -> ContentParser TodoStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TodoStatus -> ContentParser TodoStatus)
-> (OtherParams -> TodoStatus)
-> OtherParams
-> ContentParser TodoStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TodoStatus
InProcessTodo   (OtherParams -> ContentParser TodoStatus)
-> OtherParams -> ContentParser TodoStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"CANCELLED"    = TodoStatus -> ContentParser TodoStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TodoStatus -> ContentParser TodoStatus)
-> (OtherParams -> TodoStatus)
-> OtherParams
-> ContentParser TodoStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> TodoStatus
CancelledTodo   (OtherParams -> ContentParser TodoStatus)
-> OtherParams -> ContentParser TodoStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseTodoStatus Content
x = String -> ContentParser TodoStatus
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser TodoStatus)
-> String -> ContentParser TodoStatus
forall a b. (a -> b) -> a -> b
$ String
"parseTodoStatus: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse journal status. 3.8.1.11
parseJournalStatus :: Content -> ContentParser JournalStatus
parseJournalStatus :: Content -> ContentParser JournalStatus
parseJournalStatus (ContentLine SourcePos
_ CI Text
"STATUS" [(CI Text, [Text])]
o ByteString
x)
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"DRAFT"     = JournalStatus -> ContentParser JournalStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (JournalStatus -> ContentParser JournalStatus)
-> (OtherParams -> JournalStatus)
-> OtherParams
-> ContentParser JournalStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> JournalStatus
DraftJournal     (OtherParams -> ContentParser JournalStatus)
-> OtherParams -> ContentParser JournalStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"FINAL"     = JournalStatus -> ContentParser JournalStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (JournalStatus -> ContentParser JournalStatus)
-> (OtherParams -> JournalStatus)
-> OtherParams
-> ContentParser JournalStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> JournalStatus
FinalJournal     (OtherParams -> ContentParser JournalStatus)
-> OtherParams -> ContentParser JournalStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    | ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
x CI ByteString -> CI ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== CI ByteString
"CANCELLED" = JournalStatus -> ContentParser JournalStatus
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (JournalStatus -> ContentParser JournalStatus)
-> (OtherParams -> JournalStatus)
-> OtherParams
-> ContentParser JournalStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OtherParams -> JournalStatus
CancelledJournal (OtherParams -> ContentParser JournalStatus)
-> OtherParams -> ContentParser JournalStatus
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseJournalStatus Content
x = String -> ContentParser JournalStatus
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser JournalStatus)
-> String -> ContentParser JournalStatus
forall a b. (a -> b) -> a -> b
$ String
"parseJournalStatus: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse organizer. 3.8.4.3
parseOrganizer :: Content -> ContentParser Organizer
parseOrganizer :: Content -> ContentParser Organizer
parseOrganizer (ContentLine SourcePos
_ CI Text
"ORGANIZER" [(CI Text, [Text])]
o ByteString
bs) = do
    CalAddress
organizerValue <- String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
-> ContentParser CalAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text)
    Maybe Text
organizerCN <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"CN" [(CI Text, [Text])]
o
    Maybe CalAddress
organizerDir <- ([Text] -> ContentParser CalAddress)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ContentParser CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ContentParser CalAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"DIR" [(CI Text, [Text])]
o
    Maybe CalAddress
organizerSentBy <- ([Text] -> ContentParser CalAddress)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String -> ContentParser CalAddress
parseURI (String -> ContentParser CalAddress)
-> (Text -> String) -> Text -> ContentParser CalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ContentParser CalAddress)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ContentParser CalAddress
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe CalAddress))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe CalAddress)
forall a b. (a -> b) -> a -> b
$
        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"SENT-BY" [(CI Text, [Text])]
o
    Maybe Language
organizerLanguage <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language)
-> ([Text]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         Text)
-> [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$
        CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    let f :: a -> Bool
f a
x = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a
"CN", a
"DIR", a
"SENT-BY", a
"LANGUAGE"]
        o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
f (CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o
    Organizer -> ContentParser Organizer
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Organizer { organizerOther :: OtherParams
organizerOther = [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o', Maybe CalAddress
Maybe Text
Maybe Language
CalAddress
organizerValue :: CalAddress
organizerCN :: Maybe Text
organizerDir :: Maybe CalAddress
organizerSentBy :: Maybe CalAddress
organizerLanguage :: Maybe Language
organizerValue :: CalAddress
organizerCN :: Maybe Text
organizerDir :: Maybe CalAddress
organizerSentBy :: Maybe CalAddress
organizerLanguage :: Maybe Language
.. }
parseOrganizer Content
x = String -> ContentParser Organizer
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Organizer)
-> String -> ContentParser Organizer
forall a b. (a -> b) -> a -> b
$ String
"parseOrganizer: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse geographic position. 3.8.1.6
parseGeo :: Content -> ContentParser Geo
parseGeo :: Content -> ContentParser Geo
parseGeo (ContentLine SourcePos
_ CI Text
"GEO" [(CI Text, [Text])]
o ByteString
bs) = do
    let (ByteString
lat', ByteString
long') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') ByteString
bs
        lat :: Maybe Float
lat = String -> Maybe Float
forall a. Read a => String -> Maybe a
maybeRead (String -> Maybe Float)
-> (String -> String) -> String -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripPlus (String -> Maybe Float) -> String -> Maybe Float
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
lat' :: Maybe Float
        long :: Maybe Float
long = String -> Maybe Float
forall a. Read a => String -> Maybe a
maybeRead (String -> Maybe Float)
-> (ByteString -> String) -> ByteString -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripPlus (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Maybe Float) -> ByteString -> Maybe Float
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
long' :: Maybe Float
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
long' Bool -> Bool -> Bool
|| Maybe Float -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Float
lat Maybe Float -> Maybe Float -> Maybe Float
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Float
long)) (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
"Invalid latitude/longitude: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
    Geo -> ContentParser Geo
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Geo -> ContentParser Geo) -> Geo -> ContentParser Geo
forall a b. (a -> b) -> a -> b
$ Float -> Float -> OtherParams -> Geo
Geo (Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Float
lat) (Maybe Float -> Float
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Float
long) ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
  where stripPlus :: String -> String
stripPlus (Char
'+':String
xs) = String
xs
        stripPlus String
xs = String
xs
parseGeo Content
x = String -> ContentParser Geo
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Geo) -> String -> ContentParser Geo
forall a b. (a -> b) -> a -> b
$ String
"parseGeo: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse classification. 3.8.1.3
parseClass :: Content -> ContentParser Class
parseClass :: Content -> ContentParser Class
parseClass (ContentLine SourcePos
_ CI Text
"CLASS" [(CI Text, [Text])]
o ByteString
bs) = do
    ByteString -> CI Text
iconv <- (DecodingFunctions -> ByteString -> CI Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (ByteString -> CI Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DecodingFunctions -> ByteString -> CI Text
dfBS2IText
    Class -> ContentParser Class
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Class -> ContentParser Class)
-> (ClassValue -> Class) -> ClassValue -> ContentParser Class
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClassValue -> OtherParams -> Class)
-> OtherParams -> ClassValue -> Class
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClassValue -> OtherParams -> Class
Class ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o) (ClassValue -> ContentParser Class)
-> ClassValue -> ContentParser Class
forall a b. (a -> b) -> a -> b
$
        case ByteString -> CI Text
iconv ByteString
bs of
             CI Text
"PUBLIC" -> ClassValue
Public
             CI Text
"PRIVATE" -> ClassValue
Private
             CI Text
"CONFIDENTIAL" -> ClassValue
Confidential
             CI Text
x -> CI Text -> ClassValue
ClassValueX CI Text
x
parseClass Content
x = String -> ContentParser Class
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Class) -> String -> ContentParser Class
forall a b. (a -> b) -> a -> b
$ String
"parseClass: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse TZName. 3.8.3.1
parseTZName :: Content -> ContentParser TZName
parseTZName :: Content -> ContentParser TZName
parseTZName (ContentLine SourcePos
_ CI Text
"TZNAME" [(CI Text, [Text])]
o ByteString
bs) = do
    Text
txt <- [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
valueOnlyOne ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) 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
bs
    Maybe Language
lang <- ([Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$ CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language) -> Maybe [Text] -> Maybe [Language]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    TZName -> ContentParser TZName
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TZName -> ContentParser TZName) -> TZName -> ContentParser TZName
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Language -> OtherParams -> TZName
TZName Text
txt Maybe Language
lang ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
parseTZName Content
x = String -> ContentParser TZName
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser TZName) -> String -> ContentParser TZName
forall a b. (a -> b) -> a -> b
$ String
"parseTZName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x


-- | Parse a VERSION property 3.7.4
parseVersion :: Content -> ContentParser ICalVersion
parseVersion :: Content -> ContentParser ICalVersion
parseVersion (ContentLine SourcePos
_ CI Text
"VERSION" [(CI Text, [Text])]
o ByteString
bs) = do
    ByteString -> Text
c <- (DecodingFunctions -> ByteString -> Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (ByteString -> Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DecodingFunctions -> ByteString -> Text
dfBS2Text
    let (String
maxver', String
minver'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') (String -> (String, String))
-> (Text -> String) -> Text -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> (String, String)) -> Text -> (String, String)
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
c ByteString
bs
        minver' :: String
minver' = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
minver''
        parseVer :: String -> Maybe Version
parseVer = (Version, String) -> Version
forall a b. (a, b) -> a
fst ((Version, String) -> Version)
-> (String -> Maybe (Version, String)) -> String -> Maybe Version
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [(Version, String)] -> Maybe (Version, String)
forall a. [a] -> Maybe a
listToMaybe ([(Version, String)] -> Maybe (Version, String))
-> (String -> [(Version, String)])
-> String
-> Maybe (Version, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, String) -> Bool)
-> [(Version, String)] -> [(Version, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"") (String -> Bool)
-> ((Version, String) -> String) -> (Version, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, String) -> String
forall a b. (a, b) -> b
snd)
                                       ([(Version, String)] -> [(Version, String)])
-> (String -> [(Version, String)]) -> String -> [(Version, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> String -> [(Version, String)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
Ver.parseVersion
        maxver :: Maybe Version
maxver = String -> Maybe Version
parseVer String
maxver'
        minver :: Maybe Version
minver = String -> Maybe Version
parseVer String
minver'
        [Version
maxJ, Version
minJ] = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version) -> [Maybe Version] -> [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Version
maxver, Maybe Version
minver]
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Version -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Version
maxver) (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
"parseVersion: error parsing version: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
maxver'
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
minver''
       then ICalVersion -> ContentParser ICalVersion
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICalVersion -> ContentParser ICalVersion)
-> ICalVersion -> ContentParser ICalVersion
forall a b. (a -> b) -> a -> b
$ Version -> OtherParams -> ICalVersion
MaxICalVersion Version
maxJ ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
       else do Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Version -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Version
minver) (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
"parseVersion: error parsing version: "
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
minver'
               ICalVersion -> ContentParser ICalVersion
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICalVersion -> ContentParser ICalVersion)
-> ICalVersion -> ContentParser ICalVersion
forall a b. (a -> b) -> a -> b
$ Version -> Version -> OtherParams -> ICalVersion
MinMaxICalVersion Version
maxJ Version
minJ ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
parseVersion Content
x = String -> ContentParser ICalVersion
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser ICalVersion)
-> String -> ContentParser ICalVersion
forall a b. (a -> b) -> a -> b
$ String
"parseVersion: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a TZID property. 3.8.3.1
parseTZID :: Content -> ContentParser TZID
parseTZID :: Content -> ContentParser TZID
parseTZID (ContentLine SourcePos
_ CI Text
"TZID" [(CI Text, [Text])]
o ByteString
bs) = do
    Text
tzidValue <- (DecodingFunctions -> Text)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((DecodingFunctions -> Text)
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> (DecodingFunctions -> Text)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a b. (a -> b) -> a -> b
$ ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text
    let tzidGlobal :: Bool
tzidGlobal = ((Char, Text) -> Char
forall a b. (a, b) -> a
fst ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Char, Text)
T.uncons Text
tzidValue) Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'/'
        tzidOther :: OtherParams
tzidOther = [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    TZID -> ContentParser TZID
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return TZID {Bool
Text
OtherParams
tzidValue :: Text
tzidGlobal :: Bool
tzidOther :: OtherParams
tzidValue :: Text
tzidGlobal :: Bool
tzidOther :: OtherParams
..}
parseTZID Content
x = String -> ContentParser TZID
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser TZID) -> String -> ContentParser TZID
forall a b. (a -> b) -> a -> b
$ String
"parseTZID: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse RRule. 3.8.5.3
parseRRule :: Maybe DTStart -> Content -> ContentParser RRule
parseRRule :: Maybe DTStart -> Content -> ContentParser RRule
parseRRule Maybe DTStart
Nothing Content
_ = String -> ContentParser RRule
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"parseRRule: missing DTSTART."
parseRRule (Just DTStart
dts) (ContentLine SourcePos
_ CI Text
"RRULE" [(CI Text, [Text])]
o ByteString
bs) =
    case Parsec ByteString DecodingFunctions (ContentParser Recur)
-> DecodingFunctions
-> String
-> ByteString
-> Either ParseError (ContentParser Recur)
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (DTStart
-> Parsec ByteString DecodingFunctions (ContentParser Recur)
parseRecur DTStart
dts) DecodingFunctions
forall a. Default a => a
def String
"RRULE" ByteString
bs of
         Left ParseError
e -> String -> ContentParser RRule
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RRule) -> String -> ContentParser RRule
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
         Right ContentParser Recur
x -> do Recur
y <- ContentParser Recur
x
                       RRule -> ContentParser RRule
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RRule -> ContentParser RRule)
-> (OtherParams -> RRule) -> OtherParams -> ContentParser RRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recur -> OtherParams -> RRule
RRule Recur
y (OtherParams -> ContentParser RRule)
-> OtherParams -> ContentParser RRule
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseRRule Maybe DTStart
_ Content
x = String -> ContentParser RRule
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RRule) -> String -> ContentParser RRule
forall a b. (a -> b) -> a -> b
$ String
"parseRRule: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse Created, 3.8.7.3
parseCreated :: Content -> ContentParser Created
parseCreated :: Content -> ContentParser Created
parseCreated (ContentLine SourcePos
_ CI Text
"CREATED" [(CI Text, [Text])]
o ByteString
bs) = do
    UTCTime
createdValue <- DateTime -> ContentParser UTCTime
mustBeUTC (DateTime -> ContentParser UTCTime)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
-> ContentParser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
parseDateTime Maybe Text
forall a. Maybe a
Nothing ByteString
bs
    let createdOther :: OtherParams
createdOther = [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    Created -> ContentParser Created
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Created {UTCTime
OtherParams
createdValue :: UTCTime
createdOther :: OtherParams
createdValue :: UTCTime
createdOther :: OtherParams
..}
parseCreated Content
x = String -> ContentParser Created
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser Created)
-> String -> ContentParser Created
forall a b. (a -> b) -> a -> b
$ String
"parseCreated: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse Last Modified, 3.8.7.3
parseLastModified :: Content -> ContentParser LastModified
parseLastModified :: Content -> ContentParser LastModified
parseLastModified (ContentLine SourcePos
_ CI Text
"LAST-MODIFIED" [(CI Text, [Text])]
o ByteString
bs) = do
    UTCTime
lastModifiedValue <- DateTime -> ContentParser UTCTime
mustBeUTC (DateTime -> ContentParser UTCTime)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
-> ContentParser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     DateTime
parseDateTime Maybe Text
forall a. Maybe a
Nothing ByteString
bs
    let lastModifiedOther :: OtherParams
lastModifiedOther = [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
    LastModified -> ContentParser LastModified
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return LastModified {UTCTime
OtherParams
lastModifiedValue :: UTCTime
lastModifiedOther :: OtherParams
lastModifiedValue :: UTCTime
lastModifiedOther :: OtherParams
..}
parseLastModified Content
x = String -> ContentParser LastModified
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser LastModified)
-> String -> ContentParser LastModified
forall a b. (a -> b) -> a -> b
$ String
"parseLastModified: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse an RDate
parseRDate :: Content -> ContentParser RDate
parseRDate :: Content -> ContentParser RDate
parseRDate c :: Content
c@(ContentLine SourcePos
_ CI Text
"RDATE" [(CI Text, [Text])]
o ByteString
bs) = do
    Text
typ <- [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> (Maybe [Text] -> [Text])
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text
"DATE-TIME"] (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"VALUE" [(CI Text, [Text])]
o
    case Text
typ of
         Text
"PERIOD" -> do
             Maybe Text
tzid <- ([Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"TZID" [(CI Text, [Text])]
o
             Set Period
p <- [Period] -> Set Period
forall a. Ord a => [a] -> Set a
S.fromList ([Period] -> Set Period)
-> ([ByteString]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [Period])
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set Period)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (ByteString
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Period)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Period]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe Text
-> ByteString
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Period
parsePeriod Maybe Text
tzid) ([ByteString]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set Period))
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set Period)
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
B.split Char
',' ByteString
bs
             RDate -> ContentParser RDate
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RDate -> ContentParser RDate)
-> ([(CI Text, [Text])] -> RDate)
-> [(CI Text, [Text])]
-> ContentParser RDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Period -> OtherParams -> RDate
RDatePeriods Set Period
p (OtherParams -> RDate)
-> ([(CI Text, [Text])] -> OtherParams)
-> [(CI Text, [Text])]
-> RDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CI Text, [Text])] -> OtherParams
toO ([(CI Text, [Text])] -> ContentParser RDate)
-> [(CI Text, [Text])] -> ContentParser RDate
forall a b. (a -> b) -> a -> b
$
                ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CI Text
"VALUE", CI Text
"TZID"]) (CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o
         Text
_ -> (Set DateTime -> OtherParams -> RDate)
-> (Set Date -> OtherParams -> RDate)
-> Content
-> ContentParser RDate
forall a.
(Set DateTime -> OtherParams -> a)
-> (Set Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDatesOrDateTimes Set DateTime -> OtherParams -> RDate
RDateDateTimes Set Date -> OtherParams -> RDate
RDateDates Content
c
parseRDate Content
x = String -> ContentParser RDate
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser RDate) -> String -> ContentParser RDate
forall a b. (a -> b) -> a -> b
$ String
"parseRDate: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse a UTC Offset property 3.3.14, 3.8.3.4, and 3.8.3.3
parseUTCOffset :: Content -> ContentParser UTCOffset
parseUTCOffset :: Content -> ContentParser UTCOffset
parseUTCOffset (ContentLine SourcePos
_ CI Text
n [(CI Text, [Text])]
o ByteString
bs)
        | 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
"TZOFFSETTO", CI Text
"TZOFFSETFROM"] = do
    let str :: String
str = ByteString -> String
B.unpack ByteString
bs
        (Char
s:String
rest) = String
str
        (Int
t1:Int
t2:Int
m1:Int
m2:[Int]
sec) = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt String
rest
        (Int
s1:Int
s2:[Int]
_) = [Int]
sec
        sign :: a -> a
sign a
x = if Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then a -> a
forall a. Num a => a -> a
negate a
x else a
x
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) String
rest Bool -> Bool -> Bool
|| Char
s Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'+',Char
'-']
                         Bool -> Bool -> Bool
|| [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
sec Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int
0,Int
2]) (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
"parseUTCOffset: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
    UTCOffset -> ContentParser UTCOffset
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCOffset -> ContentParser UTCOffset)
-> (OtherParams -> UTCOffset)
-> OtherParams
-> ContentParser UTCOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> OtherParams -> UTCOffset
UTCOffset (Int -> Int
forall a. Num a => a -> a
sign (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t2) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
m1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m2)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                                if Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
sec) then Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2 else Int
0)
                       (OtherParams -> ContentParser UTCOffset)
-> OtherParams -> ContentParser UTCOffset
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseUTCOffset Content
x = String -> ContentParser UTCOffset
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser UTCOffset)
-> String -> ContentParser UTCOffset
forall a b. (a -> b) -> a -> b
$ String
"parseUTCOffset: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- }}}