iCalendar 0.0.1 → 0.1

raw patch · 11 files changed

+3225/−401 lines, 11 filesdep +base64-bytestringdep +bytestringdep +case-insensitivedep ~parsecnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: base64-bytestring, bytestring, case-insensitive, containers, data-default, mime, mtl, network, old-locale, text, time

Dependency ranges changed: parsec

API changes (from Hackage documentation)

Files

• LICENSE +2/−2
• Text/ICalendar.hs +9/−0
• Text/ICalendar/Parser.hs +46/−359
• Text/ICalendar/Parser/Common.hs +403/−0
• Text/ICalendar/Parser/Components.hs +261/−0
• Text/ICalendar/Parser/Content.hs +113/−0
• Text/ICalendar/Parser/Parameters.hs +208/−0
• Text/ICalendar/Parser/Properties.hs +383/−0
• Text/ICalendar/Printer.hs +958/−0
• Text/ICalendar/Types.hs +806/−0
• iCalendar.cabal +36/−40

@@ -1,4 +1,4 @@-Copyright (c) 2008, Tupil+Copyright (c) 2012, Tingtun AS  All rights reserved. @@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Tupil nor the names of other+    * Neither the name of Tingtun AS nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

@@ -0,0 +1,9 @@+module Text.ICalendar+    ( module Text.ICalendar.Types+    , module Text.ICalendar.Parser+    , module Text.ICalendar.Printer+    ) where++import Text.ICalendar.Types+import Text.ICalendar.Parser+import Text.ICalendar.Printer

@@ -1,368 +1,55 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-{-|--Parser for the iCalendar format (version 2.0, RFC2445).-  -Features:--  * Unfolds folded lines (see RFC)- -  * Supports all IANA iCalendar tokens--/Warning!/  This is version 0.0, important things are missing-   -  * Property and parameter values are not parsed, but kept as in the file.--  * There are no restrictions on the properties components can have.-  -  * Line unfolding causes error messages to report the wrong line.- -This package is meant to grow to a full-fledged data definition, printer and-parser for the iCalendar format.  But that will probably take some time.  So,-if you've come here because you need this, please e-mail me (Eelco Lempsink).---}--module Text.ICalendar.Parser -    (-    -- * Tokens from RFC2445-      ComponentName(..)-    , PropertyName(..)-    , ParamName(..)-    , ParamValue(..)-    -- * Data definitions-    , Property-    , Value-    , ICalendar(..)-    , Component(..)-    , Param(..)-    -- * Parser-    , parser+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+module Text.ICalendar.Parser+    ( parseICal+    , parseICalFile+    , DecodingFunctions(..)     ) where ---------------------------------------------------------------- Imports---------------------------------------------------------------import Data.Char+import Prelude+import Control.Applicative import Control.Monad+import Control.Monad.Error+import Control.Monad.RWS ( runRWS )+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Monoid -import Control.Applicative-import Control.Monad (MonadPlus(..), ap)--- Hide Parsec's definitions of some Applicative functions.-import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))+import Text.Parsec.Prim hiding (many, (<|>))+import Text.Parsec.Pos+import Text.Parsec.ByteString.Lazy ()+import Text.Parsec.Text.Lazy () ---------------------------------------------------------------- Tokens, as defined in RFC2445.-------------------------------------------------------------+import Text.ICalendar.Types+import Text.ICalendar.Parser.Common+import Text.ICalendar.Parser.Content+import Text.ICalendar.Parser.Components --- | Calendar Component names (4.6)-data ComponentName =-              VEVENT     -- ^ Event     Component (4.6.1)-            | VTODO      -- ^ To-do     Component (4.6.2)-            | VJOURNAL   -- ^ Journal   Component (4.6.3)-            | VFREEBUSY  -- ^ Free/Busy Component (4.6.4)-            | VTIMEZONE  -- ^ Time Zone Component (4.6.5)-            | X_c String -- ^ Non-standard/Experimental Component-            -- Time Zone subcomponents-            | STANDARD   -- ^ Standard Time        Sub-component (4.6.5)-            | DAYLIGHT   -- ^ Daylight Saving Time Sub-component (4.6.5)-            -- Event and To-do subcomponent-            | VALARM     -- ^ Alarm                Sub-component (4.6.6)-            deriving (Eq, Show) --- | Property names for Calendar Properties (4.7) and Component Properties (4.8)-data PropertyName = -                -- Calendar properties (4.7)-                  CALSCALE          -- ^ Calendar Scale (4.7.1)-                | METHOD            -- ^ Method (4.7.2)-                | PRODID            -- ^ Product Identifier (4.7.3)-                | VERSION           -- ^ Version (4.7.4)-                -                -- Component properties (4.8.1)-                | ATTACH            -- ^ Attachment (4.8.1.1)-                | CATEGORIES        -- ^ Categories (4.8.1.2)-                | CLASS             -- ^ Classification (4.8.1.3)-                | COMMENT           -- ^ Comment (4.8.1.4)-                | DESCRIPTION       -- ^ Description (4.8.1.5)-                | GEO               -- ^ Geographic Position (4.8.1.6)-                | LOCATION          -- ^ Location (4.8.1.7)-                | PERCENT_COMPLETE  -- ^ Percent Complete (4.8.1.8)-                | PRIORITY          -- ^ Priority (4.8.1.9)-                | RESOURCES         -- ^ Resources (4.8.1.10)-                | STATUS            -- ^ Status (4.8.1.11)-                | SUMMARY           -- ^ Summary (4.8.1.12)-               -                -- Date and Time Component properties (4.8.2)-                | COMPLETED         -- ^ Date/Time Completed (4.8.2.1) -                | DTEND             -- ^ Date/Time End (4.8.2.2)         -                | DUE               -- ^ Date/Time Due (4.8.2.3)-                | DTSTART           -- ^ Date/Time Start (4.8.2.4) -                | DURATION          -- ^ Duration (4.8.2.5)   -                | FREEBUSY          -- ^ Free/Busy Time (4.8.2.6)    -                | TRANSP            -- ^ Time Transparency (4.8.2.7)  -               -                -- Time Zone Component properties (4.8.3)-                | TZID              -- ^ Time Zone Identifier (4.8.3.1) -                | TZNAME            -- ^ Time Zone Name (4.8.3.2)      -                | TZOFFSETFROM      -- ^ Time Zone Offset From (4.8.3.3)     -                | TZOFFSETTO        -- ^ Time Zone Offset To (4.8.3.4)  -                | TZURL             -- ^ Time Zone URL (4.8.3.5)     -                -                -- Relationship Component properties (4.8.4)-                | ATTENDEE          -- ^ Attendee (4.8.4.1) -                | CONTACT           -- ^ Contact (4.8.4.2)-                | ORGANIZER         -- ^ Organizer (4.8.4.3)  -                | RECURRENCE_ID     -- ^ Recurrence ID (4.8.4.4)    -                | RELATED_TO        -- ^ Related To (4.8.4.5)   -                | URL               -- ^ Uniform Resource Locator (4.8.4.6) -                | UID               -- ^ Unique Identfier (4.8.4.7)  -                -                -- Recurrence Component properties (4.8.5)-                | EXDATE            -- ^ Exception Date/Times (4.8.5.1) -                | EXRULE            -- ^ Exception Rule (4.8.5.2)  -                | RDATE             -- ^ Recurrence Date/Times (4.8.5.3) -                | RRULE             -- ^ Recurrence Rule (4.8.5.4) -                -                -- Alarm Component properties (4.8.6)-                | ACTION            -- ^ Action (4.8.6.1)    -                | REPEAT            -- ^ Repeat Count (4.8.6.2)  -                | TRIGGER           -- ^ Trigger (4.8.6.3)    -                -                -- Change Management Component properties (4.8.7)-                | CREATED           -- ^ Date/Time Created (4.8.7.1)   -                | DTSTAMP           -- ^ Date/Time Stamp (4.8.7.2)     -                | LAST_MODIFIED     -- ^ Last Modified (4.8.7.3)      -                | SEQUENCE          -- ^ Sequence Number (4.8.7.4)   -                -                -- Miscellaneous Component properties (4.8.8)-                | X_ String         -- ^ Non-standard Properties (4.8.8.1)-                | REQUEST_STATUS    -- ^ Request Status (4.8.8.2)-                deriving (Eq, Show)---- | Parameter names (4.2)-data ParamName = ALTREP          -- ^ Alternate Text Represenation (4.2.1)           -               | CN              -- ^ Common Name (4.2.2)   -               | CUTYPE          -- ^ Calendar User Type (4.2.3)       -               | DELEGATED_FROM  -- ^ Delegators (4.2.4)               -               | DELEGATED_TO    -- ^ Delegatees (4.2.5)             -               | DIR             -- ^ Directory Entry Reference (4.2.6)    -               | ENCODING        -- ^ Inline Encoding (4.2.7)         -               | FMTYPE          -- ^ Format Type (4.2.8)       -               | FBTYPE          -- ^ Free/Busy Time Type (4.2.9)       -               | LANGUAGE        -- ^ Language (4.2.10)         -               | MEMBER          -- ^ Group or List Membership (4.2.11)       -               | PARTSTAT        -- ^ Participation Status (4.2.12)         -               | RANGE           -- ^ Recurrence Identfier Range (4.2.13)      -               | RELATED         -- ^ Alarm Trigger Relationship (4.2.14)        -               | RELTYPE         -- ^ Relationship Type (4.2.15)        -               | ROLE            -- ^ Participation Role (4.2.16)     -               | RSVP            -- ^ RSVP Expectation (4.2.17)     -               | SENT_BY         -- ^ Sent By (4.2.18)        -               | TZIDp           -- ^ Time Zone Identifier (4.2.19)      -               | VALUE           -- ^ Value Data Types (4.2.20)      -               | X_p String      -- ^ Non-standard Parameter (4.2.21)           -               deriving (Eq, Show)                 --data ParamValue = Paramtext    String-                | QuotedString String-                deriving (Eq, Show)----------------------------------------------------------------- Parsed datastructers and helper functions---------------------------------------------------------------type Value      = String-type Property   = (PropertyName, [Param], Value)---- | iCalendar data-data ICalendar  = ICalendar { calendarProperties :: [Property]-                            , components         :: [Component]-                            } deriving (Eq, Show)--mkICalendar     = ICalendar [] []                          --addCalendarProperty prop calendar = calendar { calendarProperties = prop : calendarProperties calendar }-addComponent        comp calendar = calendar { components         = comp : components calendar }---- | Component data-data Component   = Component { cName         :: ComponentName-                             , properties    :: [Property]-                             , subcomponents :: [Component]-                             } deriving (Eq, Show)--mkComponent name = Component name [] []--addProperty     prop component = component { properties    = prop : properties component }-addSubcomponent comp component = component { subcomponents = comp : subcomponents component }---- | Parameter data-data Param = Param { pName   :: ParamName-                   , pValues :: [ParamValue]-                   } deriving (Eq, Show)----------------------------------------------------------------- Parser helpers----------------------------------------------------------------- | Case insensitive string matching.  Also wrapped in a 'try' so the matching--- will fail as a whole and not mid-string.-ciString = try . sequence . (map (\c -> char (toUpper c) <|> char (toLower c)))--crlf = string "\r\n"---- | Parses any character except controls and double quotation marks-pQsafeChar = oneOf $ wsp ++ map chr (0x21 : [0x23..0x7e]) ++ nonUsAscii---- | Parses any character except controls, double quotation marks, ";", ":", ","-pSafeChar = oneOf $ wsp ++ map chr (0x21 : [0x23..0x2b] ++ [0x2d..0x39] ++ [0x3c..0x7e]) ++ nonUsAscii---- | Parses any textual character-pValueChar = oneOf $ wsp ++ map chr [0x21..0x7e] ++ nonUsAscii---- | Non US-ASCII characters-nonUsAscii = map chr [0x80..0xF8]---- | Linear white space-wsp = " \t"----------------------------------------------------------------- Scanner, creating a tokenstream----------------------------------------------------------------- TODO folding the lines should keep the original positions--- | Parses a "String" to an "ICalendar".  Will unfold folded lines, so error messages might be off.-parser = do input <- getInput-            setInput (foldLines input)-            pICalendar---- | Remove crlf's followed by space or tab, this is called "line folding".-foldLines [] = []-foldLines ('\r':'\n':' ' :lines) = foldLines lines-foldLines ('\r':'\n':'\t':lines) = foldLines lines-foldLines (l:lines)              = l : foldLines lines--pICalendar =  pBegin <* pVCalendar -           *> pCalendarPropertiesAndComponents-          <*  eof--pVCalendar = ciString "VCALENDAR" <* crlf--pCalendarPropertiesAndComponents =-         addCalendarProperty <$> pProperty  <*> pCalendarPropertiesAndComponents-     <|> addComponent        <$> pComponent <*> pCalendarPropertiesAndComponents-     <|> mkICalendar         <$  pEnd       <*  pVCalendar--pComponent = do component <- pComponentBegin-                pPropertiesAndSubcomponents component--pComponentBegin = mkComponent <$ pBegin <*> pComponentName--pPropertiesAndSubcomponents component =-       addProperty     <$> pProperty  <*> pPropertiesAndSubcomponents component-  <|>  addSubcomponent <$> pComponent <*> pPropertiesAndSubcomponents component-  <|>  component       <$  pComponentEnd component--pProperty = (,,) <$> pPropertyName <*> many pParam <*> pValue--pParam = Param <$ char ';' <*> pParamName <*> sepBy pParamValue (char ',')---- NOTE: pQuotedString has to go first, because the value may be empty-pParamValue   = pQuotedString <|> pParamtext -pParamtext    = Paramtext    <$> many pSafeChar-pQuotedString = QuotedString <$  char '"' <*> many pQsafeChar <* char '"'--pValue = char ':' *> many pValueChar <* crlf---- TODO: This will disappear once every component has its own parser-pComponentEnd c = do pEnd-                     component <- pComponentName-                     if component == cName c-                           then return component-                           else unexpected $ "END:" ++ show (cName c)--pBegin  = ciString "BEGIN:"-pEnd    = ciString "END:"+-- | Parse a ByteString containing iCalendar data.+-- Returns either an error, or a tuple of the result and a list of warnings.+parseICal :: DecodingFunctions+          -> FilePath+          -> ByteString+          -> Either String ([VCalendar], [String])+parseICal s f bs = do+    a <- either (Left . show) Right $ runParser parseToContent s f bs+    when (null a) $ throwError "Missing content."+    let xs = map (runCP s . parseVCalendar) a+    (x, w) <- ((flip.).) flip foldM ([], []) xs $ \(x, ws) (g, (pos, _), w) ->+             case g of+                  Left e -> Left $ show pos ++ ": " ++ e+                  Right y -> Right (y:x, w <> ws)+    return (x, w) -pComponentName = ( VEVENT           <$ ciString "VEVENT"-               <|> VTODO            <$ ciString "VTODO"-               <|> VJOURNAL         <$ ciString "VJOURNAL"-               <|> VFREEBUSY        <$ ciString "VFREEBUSY"-               <|> VTIMEZONE        <$ ciString "VTIMEZONE"-               <|> X_c              <$ ciString "X-" <*> many1 (alphaNum <|> char '-')-               <|> STANDARD         <$ ciString "STANDARD"-               <|> DAYLIGHT         <$ ciString "DAYLIGHT"-               <|> VALARM           <$ ciString "VALARM"-               ) <* crlf-       -pPropertyName  =   CALSCALE         <$ ciString "CALSCALE"-               <|> METHOD           <$ ciString "METHOD"-               <|> PRODID           <$ ciString "PRODID"-               <|> VERSION          <$ ciString "VERSION"-               <|> ATTACH           <$ ciString "ATTACH"-               <|> CATEGORIES       <$ ciString "CATEGORIES"-               <|> CLASS            <$ ciString "CLASS"-               <|> COMMENT          <$ ciString "COMMENT"-               <|> DESCRIPTION      <$ ciString "DESCRIPTION"-               <|> GEO              <$ ciString "GEO"-               <|> LOCATION         <$ ciString "LOCATION"-               <|> PERCENT_COMPLETE <$ ciString "PERCENT-COMPLETE"-               <|> PRIORITY         <$ ciString "PRIORITY"-               <|> RESOURCES        <$ ciString "RESOURCES"-               <|> STATUS           <$ ciString "STATUS"-               <|> SUMMARY          <$ ciString "SUMMARY"-               <|> COMPLETED        <$ ciString "COMPLETED"-               <|> DTEND            <$ ciString "DTEND"-               <|> DUE              <$ ciString "DUE"-               <|> DTSTART          <$ ciString "DTSTART"-               <|> DURATION         <$ ciString "DURATION"-               <|> FREEBUSY         <$ ciString "FREEBUSY"-               <|> TRANSP           <$ ciString "TRANSP"-               <|> TZID             <$ ciString "TZID"-               <|> TZNAME           <$ ciString "TZNAME"-               <|> TZOFFSETFROM     <$ ciString "TZOFFSETFROM"-               <|> TZOFFSETTO       <$ ciString "TZOFFSETTO"-               <|> TZURL            <$ ciString "TZURL"-               <|> ATTENDEE         <$ ciString "ATTENDEE"-               <|> CONTACT          <$ ciString "CONTACT"-               <|> ORGANIZER        <$ ciString "ORGANIZER"-               <|> RECURRENCE_ID    <$ ciString "RECURRENCE-ID"-               <|> RELATED_TO       <$ ciString "RELATED-TO"-               <|> URL              <$ ciString "URL"-               <|> UID              <$ ciString "UID"-               <|> EXDATE           <$ ciString "EXDATE"-               <|> EXRULE           <$ ciString "EXRULE"-               <|> RDATE            <$ ciString "RDATE"-               <|> RRULE            <$ ciString "RRULE"-               <|> ACTION           <$ ciString "ACTION"-               <|> REPEAT           <$ ciString "REPEAT"-               <|> TRIGGER          <$ ciString "TRIGGER"-               <|> CREATED          <$ ciString "CREATED"-               <|> DTSTAMP          <$ ciString "DTSTAMP"-               <|> LAST_MODIFIED    <$ ciString "LAST-MODIFIED"-               <|> SEQUENCE         <$ ciString "SEQUENCE"-               <|> X_               <$ ciString "X-" <*> many1 (alphaNum <|> char '-')-               <|> REQUEST_STATUS   <$ ciString "REQUEST-STATUS"+-- | Parse an iCalendar file.+parseICalFile :: DecodingFunctions+              -> FilePath+              -> IO (Either String ([VCalendar], [String]))+parseICalFile s f = parseICal s f <$> B.readFile f -pParamName     = ( ALTREP           <$ ciString "ALTREP"-               <|> CN               <$ ciString "CN"-               <|> CUTYPE           <$ ciString "CUTYPE"-               <|> DELEGATED_FROM   <$ ciString "DELEGATED-FROM"-               <|> DELEGATED_TO     <$ ciString "DELEGATED-TO"-               <|> DIR              <$ ciString "DIR"-               <|> ENCODING         <$ ciString "ENCODING"-               <|> FMTYPE           <$ ciString "FMTYPE"-               <|> FBTYPE           <$ ciString "FBTYPE"-               <|> LANGUAGE         <$ ciString "LANGUAGE"-               <|> MEMBER           <$ ciString "MEMBER"-               <|> PARTSTAT         <$ ciString "PARTSTAT"-               <|> RANGE            <$ ciString "RANGE"-               <|> RELATED          <$ ciString "RELATED"-               <|> RELTYPE          <$ ciString "RELTYPE"-               <|> ROLE             <$ ciString "ROLE"-               <|> RSVP             <$ ciString "RSVP"-               <|> SENT_BY          <$ ciString "SENT-BY"-               <|> TZIDp            <$ ciString "TZID"-               <|> VALUE            <$ ciString "VALUE"-               <|> X_p              <$ ciString "X-" <*> many1 (alphaNum <|> char '-')-               ) <* char '='+runCP :: DecodingFunctions -> ContentParser a+      -> (Either String a, (SourcePos, [Content]), [String])+runCP s = ((flip .) . flip) runRWS s (undefined, undefined) . runErrorT

@@ -0,0 +1,403 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Text.ICalendar.Parser.Common where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Arrow (second)+import Control.Monad.Error hiding (mapM)+import Control.Monad.RWS ( RWS, MonadWriter(tell) , MonadState(get, put), asks+                         , modify )+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy.Builder as Bu+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Char+import Data.Default+import Data.List (partition)+import Data.Maybe+import Data.Monoid+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.Encoding as TE+import Data.Time ( UTCTime(UTCTime), LocalTime(LocalTime), Day+                 , TimeOfDay())+import qualified Data.Time as Time+import Data.Traversable (mapM)+import qualified Network.URI as URI+import qualified System.Locale as L++import qualified Text.Parsec as P+import Text.Parsec.Prim hiding ((<|>))+import Text.Parsec.Combinator hiding (optional)++import Text.ICalendar.Types++data Content = ContentLine P.SourcePos (CI Text) [(CI Text, [Text])] ByteString+             | Component P.SourcePos (CI Text) [Content]+               deriving (Show, Eq, Ord)++type TextParser = P.Parsec ByteString DecodingFunctions++type ContentParser = ErrorT String -- Fatal errors.+                            (RWS DecodingFunctions+                                 [String] -- Warnings.+                                 (P.SourcePos, [Content]))++-- | Functions for decoding 'ByteString's into 'Text'.+data DecodingFunctions = DecodingFunctions+    { dfBS2Text :: ByteString -> Text+    , dfBS2IText :: ByteString -> CI Text+    }++-- | UTF8.+instance Default DecodingFunctions where+    def = DecodingFunctions TE.decodeUtf8 (CI.mk . TE.decodeUtf8)++-- | Parse text. 3.3.11+parseText' :: ByteString -> ContentParser ([Text], ByteString)+parseText' bs = do c <- asks dfBS2Text+                   case runParser ((,) <$> texts <*> getInput) () "text" bs of+                        Left e -> throwError $ "parseText': " ++ show e+                        Right (x, r) -> return ( map (c . Bu.toLazyByteString) x+                                               , r)+  where texts = sepBy text (P.char ',')+        text = do x <- P.satisfy isTSafe'+                  case x of+                       '\\' -> do y <- P.anyChar+                                  case y of+                                       '\\' -> nxt '\\'+                                       ';' -> nxt ';'+                                       ',' -> nxt ','+                                       z | z `elem` "nN" -> nxt '\n'+                                       _ -> fail $ "unexpected " ++ show x+                       y -> nxt y+        -- isTSafe + 0x22, 0x3A+        isTSafe' c = let n = ord c+                      in n == 9 || (n >= 0x20 && n <= 0x3A)+                                || (n >= 0x3C && n /= 0x7F)+        nxt c = (Bu.char8 c <>) <$> (text <|> return mempty)++-- | Chech that there's no remainding text after the parser is done.+noRestText :: ([Text], ByteString) -> ContentParser [Text]+noRestText (x, "") = return x+noRestText (_, x) = throwError $ "noRestText: remainding text: " ++ show x++-- | Parse text, not allowing any remainding text.+parseText :: ByteString -> ContentParser [Text]+parseText = noRestText <=< parseText'++-- | Parse a DateTime value. 3.3.5+parseDateTime :: Maybe Text -- ^ Time Zone ID+              -> ByteString -> ContentParser DateTime+parseDateTime mTZ bs = do+    str <- asks $ T.unpack . ($ bs) . dfBS2Text+    let dayRes = parseDateStr str+        Just (day, rest') = dayRes+        t = take 1 rest'+        timeRes = parseTimeStr $ drop 1 rest'+        Just (time, isUTC) = timeRes+    when (isNothing (dayRes >> timeRes) || t /= "T") .+        throwError $ "parseDateTime: " ++ str+    when (isUTC && isJust mTZ) $+        tell ["parseDateTime: TZID on UTC timezone: " ++ str]+    return $ case (mTZ, isUTC) of+                  (Nothing, False) -> FloatingDateTime (LocalTime day time)+                  (Just tz, False) -> ZonedDateTime (LocalTime day time) tz+                  (_, True) -> UTCDateTime (UTCTime day+                                                  $ Time.timeOfDayToTime time)++-- | Parse a string to a Day. 3.3.4+parseDateStr :: String -> Maybe (Day, String)+parseDateStr = lastToMaybe . Time.readsTime L.defaultTimeLocale "%Y%m%d"++-- | Parse a string to a TimeOfDay, and a bool if it's in UTC.+parseTimeStr :: String -> Maybe (TimeOfDay, Bool)+parseTimeStr s = do+    (t, r) <- lastToMaybe (Time.readsTime L.defaultTimeLocale "%H%M%S" s)+    case r of+         "Z" -> return (t, True)+         "" -> return (t, False)+         _ -> fail ""++-- | Parse a Date value. 3.3.4+parseDate :: ByteString -> ContentParser Date+parseDate bs = do+    str <- asks $ T.unpack . ($ bs) . dfBS2Text+    let dayRes = parseDateStr str+        Just (day, rest) = dayRes+    when (isNothing dayRes) .+        throwError $ "parseDate: " ++ str+    unless (null rest) $+        tell ["parseDate: extra content: " ++ rest]+    return $ Date day++-- {{{ Misc parsers++parseURI :: String -> ContentParser URI.URI+parseURI s = case URI.parseURI s of+                  Just x -> return x+                  Nothing -> throwError $  "Invalid URI: " ++ show s+++-- | Convert a 'DateTime' to 'UTCTime', giving an appropriate error.+mustBeUTC :: DateTime -> ContentParser UTCTime+mustBeUTC (UTCDateTime x) = return x+mustBeUTC _ = throwError "DateTime-value must be UTC"++-- | Parse something simple with only a Text-field for the content, and+-- 'OtherParams'.+parseSimple :: (Text -> OtherParams -> b) -> Content -> ContentParser b+parseSimple k (ContentLine _ _ o bs) = do c <- valueOnlyOne =<< parseText bs+                                          return $ k c (toO o)+parseSimple _ x = throwError $ "parseSimple: " ++ show x++-- | Parse something simple with only a CI Text-field for the content, and+-- 'OtherParams'.+parseSimpleI :: (CI Text -> OtherParams -> b) -> Content -> ContentParser b+parseSimpleI k (ContentLine _ _ o bs) = do c <- asks dfBS2IText+                                           return $ k (c bs) (toO o)+parseSimpleI _ x = throwError $ "parseSimpleI: " ++ show x++-- | Parse something simple with only a Int-field for the content, and+-- 'OtherParams'.+parseSimpleRead :: forall a b. Read a+                => (a -> OtherParams -> b) -> Content -> ContentParser b+parseSimpleRead k (ContentLine _ _ o bs) = do+    let r = maybeRead $ B.unpack bs :: Maybe a+    when (isNothing r) . throwError $ "parseSimpleRead: " ++ show bs+    return $ k (fromJust r) (toO o)+parseSimpleRead _ x = throwError $ "parseSimpleRead: " ++ show x++-- | Parse something b with alternative representations, language+-- specification, and 'OtherParams'.+parseAltRepLang' :: ([Text] -> ContentParser b)+                 -> (b -> Maybe URI.URI -> Maybe Language -> OtherParams -> a)+                 -> Content -> ContentParser a+parseAltRepLang' m f (ContentLine _ _ o bs) = do+    t <- m =<< parseText bs+    uri <- mapM (parseURI <=< paramOnlyOne) $ T.unpack .: lookup "ALTREP" o+    lang <- mapM paramOnlyOne $ Language . CI.mk .: lookup "LANGUAGE" o+    let o' = filter (\(x, _) -> x `notElem` ["ALTREP", "LANGUAGE"]) o+    return $ f t uri lang (toO o')+parseAltRepLang' _ _ x = throwError $ "parseAltRepLang': " ++ show x++-- | Parse something 'Text' with alternative representations, language+-- specification, and 'OtherParams'.+parseAltRepLang :: (Text -> Maybe URI.URI -> Maybe Language -> OtherParams -> a)+                -> Content -> ContentParser a+parseAltRepLang = parseAltRepLang' valueOnlyOne++-- | Parse something '[Text]' with alternative representations, language+-- specification, and 'OtherParams'.+parseAltRepLangN :: (Set Text -> Maybe URI.URI -> Maybe Language+                              -> OtherParams -> a)+                -> Content -> ContentParser a+parseAltRepLangN = parseAltRepLang' (return . S.fromList)++-- | Parse something simple with only a URI-field for the content, and+-- 'OtherParams'.+parseSimpleURI :: (URI.URI -> OtherParams -> a) -> Content -> ContentParser a+parseSimpleURI f (ContentLine _ _ o bs) = do+    uri <- parseURI =<< asks (T.unpack . ($ bs) . dfBS2Text)+    return . f uri $ toO o+parseSimpleURI _ x = throwError $ "parseSimpleURI: " ++ show x+++-- | Parse something which has either a 'Date' or a 'DateTime' value, and+-- 'OtherParams'. Uses DateTime if there is no value parameter.+parseSimpleDateOrDateTime :: (DateTime -> OtherParams -> a)+                          -> (Date     -> OtherParams -> a)+                          -> Content+                          -> ContentParser a+parseSimpleDateOrDateTime dt d (ContentLine _ _ o bs) = do+    (typ, tzid, o') <- typTzIdO o+    case typ of+         "DATE-TIME" -> do x <- parseDateTime tzid bs+                           return . dt x $ toO o'+         "DATE" -> do x <- parseDate bs+                      return . d x $ toO o'+         _ -> throwError $ "Invalid type: " ++ show typ+parseSimpleDateOrDateTime _ _ x =+    throwError $ "parseSimpleDateOrDateTime: " ++ show x++-- | Parse something which has a set of either a 'Date' or a 'DateTime' value,+-- and 'OtherParams'. Uses DateTime if there is no value parameter.+parseSimpleDatesOrDateTimes :: (Set DateTime -> OtherParams -> a)+                            -> (Set Date     -> OtherParams -> a)+                            -> Content+                            -> ContentParser a+parseSimpleDatesOrDateTimes dt d (ContentLine _ _ o bs) = do+    (typ, tzid, o') <- typTzIdO o+    case typ of+         "DATE-TIME" -> do x <- S.fromList .: mapM (parseDateTime tzid) $+                                                B.split ',' bs+                           return . dt x $ toO o'+         "DATE" -> do x <- S.fromList .: mapM parseDate $ B.split ',' bs+                      return . d x $ toO o'+         _ -> throwError $ "Invalid type: " ++ show typ+parseSimpleDatesOrDateTimes _ _ x =+    throwError $ "parseSimpleDatesOrDateTimes: " ++ show x++typTzIdO :: [(CI Text, [Text])]+         -> ContentParser (Text, Maybe Text, [(CI Text, [Text])])+typTzIdO o = do+    typ <- paramOnlyOne . fromMaybe ["DATE-TIME"] $ lookup "VALUE" o+    tzid <- mapM paramOnlyOne $ if typ == "DATE-TIME" then lookup "TZID" o+                                                      else Nothing+    let f x = x /= "VALUE" && (typ /= "DATE-TIME" || x /= "TZID")+        o' = filter (f . fst) o+    return (typ, tzid, o')++-- | Parse something which has only a DateTime value, and 'OtherParams'.+parseSimpleDateTime :: (DateTime -> OtherParams -> a)+                    -> Content+                    -> ContentParser a+parseSimpleDateTime dt (ContentLine _ _ o bs) = do+    tzid <- mapM paramOnlyOne $ lookup "TZID" o+    let o' = filter ((/="TZID") . fst) o+    flip dt (toO o') <$> parseDateTime tzid bs+parseSimpleDateTime _ x = throwError $ "parseSimpleDateTime: " ++ show x++parseSimpleUTC :: (UTCTime -> OtherParams -> a)+               -> Content+               -> ContentParser a+parseSimpleUTC dt (ContentLine _ _ o bs) =+    flip dt (toO o) <$> (mustBeUTC =<< parseDateTime Nothing bs)+parseSimpleUTC _ x = throwError $ "parseSimpleUTC: " ++ show x++-- | Convert a property dictionary to 'OtherParams'.+toO :: [(CI Text, [Text])] -> OtherParams+toO = OtherParams . S.fromList . map (uncurry OtherParam)++-- | Get the remaining properties.+otherProperties :: ContentParser (Set OtherProperty)+otherProperties = do opts <- snd <$> get+                     modify (second $ const [])+                     S.fromList <$> mapM lineToOtherProp opts+  where lineToOtherProp (ContentLine _ n opts bs) =+            return (OtherProperty n bs $ toO opts)+        lineToOtherProp c@Component {} =+            down c . throwError $ "Unconsumed component: " ++ show c++neg :: TextParser (Int -> Int)+neg = maybe id (\x -> if x == '-' then negate else id)+            <$> optional (P.oneOf "+-")++digits :: TextParser Int+digits = foldl1 ((+).(*10)) . map digitToInt <$> many1 P.digit++digitsN :: TextParser [Int]+digitsN = sepBy1 digits (P.char ',')++-- }}}++-- | Set the parser context.+down :: Content -> ContentParser a -> ContentParser a+down (Component p _ x) = down' (p, x)+down x@(ContentLine p _ _ _) = down' (p, [x])++-- | Set the parser context.+down' :: (P.SourcePos, [Content]) -> ContentParser a -> ContentParser a+down' x m = get >>= \old -> put x >> m <* put old++-- | Many optional components named ...+optCompN :: Ord a+         => CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)+optCompN s f = optN f . partition (`isComponentNamed` s) =<< snd <$> get++-- | One required line named ...+reqLine1 :: CI Text -> (Content -> ContentParser a) -> ContentParser a+reqLine1 s f = req1 s f . partition (`isLineNamed` s) =<< snd <$> get++-- | One optional line named ...+optLine1 :: Default b+         => CI Text -> (Content -> ContentParser b) -> ContentParser b+optLine1 s f = opt1 f . partition (`isLineNamed` s) =<< snd <$> get++-- | Many optional lines named ...+optLineN :: Ord b+         => CI Text -> (Content -> ContentParser b) -> ContentParser (Set b)+optLineN s f = optN f . partition (`isLineNamed` s) =<< snd <$> get++-- | Many lines named ..., at least one required.+reqLineN :: Ord b+         => CI Text -> (Content -> ContentParser b) -> ContentParser (Set b)+reqLineN s f = reqN s f . partition (`isLineNamed` s) =<< snd <$> get++-- | One required ...+req1 :: CI Text -> (Content -> ContentParser b) -> ([Content], [Content])+     -> ContentParser b+req1 _ f ([x], xs) = modify (second $ const xs) >> down x (f x)+req1 s _ ([], _) = throwError $ "Missing content: " ++ show s+req1 _ f (x:xs, xs') = do modify (second $ const xs')+                          tell (map (("Extra content: " ++) . show) xs)+                          down x $ f x++-- | One optional ...+opt1 :: Default b+     => (Content -> ContentParser b) -> ([Content], [Content])+     -> ContentParser b+opt1 f ([x], xs) = modify (second $ const xs) >> down x (f x)+opt1 _ ([], _) = return def+opt1 f (x:xs, xs') = do modify (second $ const xs')+                        tell (map (("Extra content: " ++) . show) xs)+                        down x $ f x++-- | Many optional ...+optN :: Ord b+     => (Content -> ContentParser b) -> ([Content], [Content])+     -> ContentParser (Set b)+optN f (xs, xs') = do modify (second $ const xs')+                      S.fromList <$> mapM (\x -> down x (f x)) xs++-- | Many ..., at least one required.+reqN :: Ord b+     => CI Text -- ^ What, needed for the error.+     -> (Content -> ContentParser b) -> ([Content], [Content])+     -> ContentParser (Set b)+reqN w f (xs, xs') = do modify (second $ const xs')+                        o <- S.fromList <$> mapM (\x -> down x (f x)) xs+                        when (S.size o < 1) .+                            throwError $ "At least one required: " ++ show w+                        return o++-- | Only allow one parameter value.+paramOnlyOne :: [a] -> ContentParser a+paramOnlyOne [x] = return x+paramOnlyOne _ = throwError "Only one parameter value allowed."++valueOnlyOne :: [a] -> ContentParser a+valueOnlyOne [x] = return x+valueOnlyOne [] = throwError "Must have one value, not zero."+valueOnlyOne _ = throwError "Only one value allowed."++-- | Line predicate.+isLineNamed :: Content -> CI Text -> Bool+isLineNamed (ContentLine _ n _ _) n' | n == n' = True+isLineNamed _ _ = False++-- | Component name predicate.+isComponentNamed :: Content -> CI Text -> Bool+isComponentNamed (Component _ n _) n' | n == n' = True+isComponentNamed _ _ = False++isComponent :: Content -> Bool+isComponent Component {} = True+isComponent _ = False++-- Util++maybeRead :: Read a => String -> Maybe a+maybeRead = fst .: lastToMaybe . reads++lastToMaybe :: [a] -> Maybe a+lastToMaybe x = if null x then Nothing else Just $ last x++(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(.:) = fmap fmap fmap++infixl 4 .:

@@ -0,0 +1,261 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Text.ICalendar.Parser.Components where++import Control.Applicative+import Control.Monad.Error hiding (mapM)+import Control.Monad.RWS ( MonadState(get), tell )+import qualified Data.CaseInsensitive as CI+import Data.List (partition)+import Data.Maybe+import Data.Set (Set)+import qualified Data.Set as S++import Text.ICalendar.Types+import Text.ICalendar.Parser.Common+import Text.ICalendar.Parser.Properties++-- | Parse a VCALENDAR component. 3.4+parseVCalendar :: Content -> ContentParser VCalendar+parseVCalendar c@(Component _ "VCALENDAR" _) = down c $ do+    vcProdId <- reqLine1 "PRODID" (parseSimple ProdId)+    vcVersion <- reqLine1 "VERSION" parseVersion+    vcScale <- optLine1 "CALSCALE" (parseSimpleI Scale)+    vcMethod <- optLine1 "METHOD" (parseSimpleI ((Just .) . Method))+    vcTimeZones <- optCompN "VTIMEZONE" parseVTimeZone+    vcEvents <- optCompN "VEVENT" (parseVEvent vcMethod)+    vcTodos <- optCompN "VTODO" parseVTodo+    vcJournals <- optCompN "VJOURNAL" parseVJournal+    vcFreeBusys <- optCompN "VFREEBUSY" parseVFreeBusy+    vcOtherComps <- otherComponents+    vcOther <- otherProperties+    return VCalendar {..}+parseVCalendar _ = throwError "parseVCalendar: Content given not a VCALENDAR\+                              \ component."++-- | Parse a VEVENT component. 3.6.1+parseVEvent :: Maybe Method -> Content -> ContentParser VEvent+parseVEvent mmethod (Component _ "VEVENT" _) = do+    veDTStamp <- reqLine1 "DTSTAMP" $ parseSimpleUTC DTStamp+    veUID <- reqLine1 "UID" $ parseSimple UID+    veDTStart <- optLine1 "DTSTART" $+                  Just .: parseSimpleDateOrDateTime DTStartDateTime DTStartDate+    when (isNothing mmethod && isNothing veDTStart) $+        throwError "A VEVENT in a VCALENDAR without a METHOD requires a \+                   \DTSTART property."+    veClass <- optLine1 "CLASS" parseClass+    veCreated <- optLine1 "CREATED" $ parseSimpleDateTime ((Just .) . Created)+    veDescription <- optLine1 "DESCRIPTION" .+                    parseAltRepLang $ (((Just .) .) .) . Description+    veGeo <- optLine1 "GEO" (Just .: parseGeo)+    veLastMod <- optLine1 "LAST-MODIFIED" (Just .: parseLastModified)+    veLocation <- optLine1 "LOCATION" .+        parseAltRepLang $ (((Just .) .) .) . Location+    veOrganizer <- optLine1 "ORGANIZER" (Just .: parseOrganizer)+    vePriority <- optLine1 "PRIORITY" (parseSimpleRead Priority)+    veSeq <- optLine1 "SEQUENCE" (parseSimpleRead Sequence)+    veStatus <- optLine1 "STATUS" (Just .: parseEventStatus)+    veSummary <- optLine1 "SUMMARY" .+                    parseAltRepLang $ (((Just .) .) .) . Summary+    veTransp <- optLine1 "TRANSP" parseTransp+    veUrl <- optLine1 "URL" (Just .: parseSimpleURI URL)+    veRecurId <- optLine1 "RECURRENCE-ID"+                    $ Just .: parseRecurId veDTStart+    veRRule <- optLineN "RRULE" $ parseRRule veDTStart+    when (S.size veRRule > 1) $ tell ["SHOULD NOT have multiple RRules."]+    veDTEndDuration <- parseXDurationOpt "DTEND" DTEndDateTime DTEndDate+                                         veDTStart+    veAttach <- optLineN "ATTACH" parseAttachment+    veAttendee <- optLineN "ATTENDEE" parseAttendee+    veCategories <- optLineN "CATEGORIES" parseCategories+    veComment <- optLineN "COMMENT" $ parseAltRepLang Comment+    veContact <- optLineN "CONTACT" $ parseAltRepLang Contact+    veExDate <- optLineN "EXDATE" parseExDate+    veRStatus <- optLineN "REQUEST-STATUS" parseRequestStatus+    veRelated <- optLineN "RELATED-TO" parseRelatedTo+    veResources <- optLineN "RESOURCES" $ parseAltRepLangN Resources+    veRDate <- optLineN "RDATE" parseRDate+    veAlarms <- optCompN "VALARM" parseVAlarm+    veOther <- otherProperties+    return VEvent {..}+parseVEvent _ x = throwError $ "parseVEvent: " ++ show x++-- | Parse a VTODO component.+parseVTodo :: Content -> ContentParser VTodo+parseVTodo (Component _ "VTODO" _) = do+    vtDTStamp <- reqLine1 "DTSTAMP" $ parseSimpleUTC DTStamp+    vtUID <- reqLine1 "UID" $ parseSimple UID+    vtClass <- optLine1 "CLASS" parseClass+    vtCompleted <- optLine1 "COMPLETED" . parseSimpleDateTime $+                (Just .) . Completed+    vtCreated <- optLine1 "CREATED" . parseSimpleDateTime $+                (Just .) . Created+    vtDTStart <- optLine1 "DTSTART" $+                Just .: parseSimpleDateOrDateTime DTStartDateTime DTStartDate+    vtDescription <- optLine1 "DESCRIPTION" .+                parseAltRepLang $ (((Just .) .) .) . Description+    vtGeo <- optLine1 "GEO" (Just .: parseGeo)+    vtLastMod <- optLine1 "LAST-MODIFIED" (Just .: parseLastModified)+    vtLocation <- optLine1 "LOCATION" .+                parseAltRepLang $ (((Just .) .) .) . Location+    vtOrganizer <- optLine1 "ORGANIZER" (Just .: parseOrganizer)+    vtPercent <- optLine1 "PERCENT-COMPLETE" $ Just .: parseSimpleRead+                                                             PercentComplete+    vtPriority <- optLine1 "PRIORITY" $ parseSimpleRead Priority+    vtRecurId <- optLine1 "RECURRENCE-ID" (Just .: parseRecurId vtDTStart)+    vtSeq <- optLine1 "SEQUENCE" $ parseSimpleRead Sequence+    vtStatus <- optLine1 "STATUS" (Just .: parseTodoStatus)+    vtSummary <- optLine1 "SUMMARY" .+                parseAltRepLang $ (((Just .) .) .) . Summary+    vtUrl <- optLine1 "URL" (Just .: parseSimpleURI URL)+    vtRRule <- optLineN "RRULE" $ parseRRule vtDTStart+    when (S.size vtRRule > 1) $ tell ["SHOULD NOT have multiple RRules."]+    vtDueDuration <- parseXDurationOpt "DUE" DueDateTime DueDate vtDTStart++    vtAttach <- optLineN "ATTACH" parseAttachment+    vtAttendee <- optLineN "ATTENDEE" parseAttendee+    vtCategories <- optLineN "CATEGORIES" parseCategories+    vtComment <- optLineN "COMMENT" $ parseAltRepLang Comment+    vtContact <- optLineN "CONTACT" $ parseAltRepLang Contact+    vtExDate <- optLineN "EXDATE" parseExDate+    vtRStatus <- optLineN "REQUEST-STATUS" parseRequestStatus+    vtRelated <- optLineN "RELATED-TO" parseRelatedTo+    vtResources <- optLineN "RESOURCES" $ parseAltRepLangN Resources+    vtRDate <- optLineN "RDATE" parseRDate+    vtAlarms <- optCompN "VALARM" parseVAlarm+    vtOther <- otherProperties+    return VTodo {..}+parseVTodo x = throwError $ "parseVTodo: " ++ show x++-- | Parse a VTIMEZONE component. 3.6.5+parseVTimeZone :: Content -> ContentParser VTimeZone+parseVTimeZone (Component _ "VTIMEZONE" _) = do+    vtzId <- reqLine1 "TZID" parseTZID+    vtzLastMod <- optLine1 "LAST-MODIFIED" (Just .: parseLastModified)+    vtzUrl <- optLine1 "TZURL" (Just .: parseSimpleURI TZUrl)+    vtzStandardC <- optCompN "STANDARD" parseTZProp+    vtzDaylightC <- optCompN "DAYLIGHT" parseTZProp+    when (S.size vtzStandardC + S.size vtzDaylightC < 1) .+        throwError $ "VTIMEZONE must include at least one of the STANDARD or \+                     \DAYLIGHT components."+    vtzOther <- otherProperties+    return VTimeZone {..}+parseVTimeZone x = throwError $ "parseVTimeZone: " ++ show x++-- | Parse a STANDARD or DAYLIGHT component, tzprop. 3.6.5+parseTZProp :: Content -> ContentParser TZProp+parseTZProp (Component _ n _) | n `elem` ["STANDARD", "DAYLIGHT"] = do+    tzpDTStart <- reqLine1 "DTSTART" $+                    parseSimpleDateOrDateTime DTStartDateTime DTStartDate+    tzpTZOffsetTo <- reqLine1 "TZOFFSETTO" parseUTCOffset+    tzpTZOffsetFrom <- reqLine1 "TZOFFSETFROM" parseUTCOffset+    tzpRRule <- optLineN "RRULE" (parseRRule $ Just tzpDTStart)+    when (S.size tzpRRule > 1) $ tell ["SHOULD NOT have multiple RRules."]+    tzpComment <- optLineN "COMMENT" (parseAltRepLang Comment)+    tzpRDate <- optLineN "RDATE" parseRDate+    tzpTZName <- optLineN "TZNAME" parseTZName+    tzpOther <- otherProperties+    return TZProp {..}+parseTZProp x = throwError $ "parseTZProp: " ++ show x++-- | Parse a VALARM component. 3.6.6+parseVAlarm :: Content -> ContentParser VAlarm+parseVAlarm (Component _ "VALARM" _) = do+    (ao, a') <- reqLine1 "ACTION" (\(ContentLine _ _ o bs) -> return (o, bs))+    a <- valueOnlyOne =<< parseText a'+    vaTrigger <- reqLine1 "TRIGGER" parseTrigger+    let vaActionOther = toO ao+    case CI.mk a of+         "AUDIO"   -> do+            (vaRepeat, vaDuration) <- repAndDur+            vaAudioAttach <- optLine1 "ATTACH" $ Just .: parseAttachment+            vaOther <- otherProperties+            return VAlarmAudio {..}+         "DISPLAY" -> do+             (vaRepeat, vaDuration) <- repAndDur+             vaDescription <- reqLine1 "DESCRIPTION" $+                 parseAltRepLang Description+             vaOther <- otherProperties+             return VAlarmDisplay {..}+         "EMAIL"   -> do+             (vaRepeat, vaDuration) <- repAndDur+             vaDescription <- reqLine1 "DESCRIPTION" $+                parseAltRepLang Description+             vaSummary <- reqLine1 "SUMMARY" $ parseAltRepLang Summary+             vaAttendee <- reqLineN "ATTENDEE" parseAttendee+             vaMailAttach <- optLineN "ATTACH" parseAttachment+             vaOther <- otherProperties+             return VAlarmEmail {..}+         vaAction  -> do vaOther <- otherProperties+                         return VAlarmX {..}+  where repAndDur = do+             rep <- optLine1 "REPEAT" $ parseSimpleRead Repeat+             dur <- optLine1 "DURATION" $ Just .: parseDurationProp Nothing+             -- Liberal interpretation:+             when (repeatValue rep > 0 && isNothing dur) .+                 throwError $ "parseVAlarm: when REPEAT > 0, DURATION must \+                              \ be specified."+             return (rep, dur)+parseVAlarm x = throwError $ "parseVAlarm: " ++ show x++parseVJournal :: Content -> ContentParser VJournal+parseVJournal (Component _ "VJOURNAL" _) = do+    vjDTStamp <- reqLine1 "DTSTAMP" $ parseSimpleUTC DTStamp+    vjUID <- reqLine1 "UID" $ parseSimple UID+    vjClass <- optLine1 "CLASS" parseClass+    vjCreated <- optLine1 "CREATED" . parseSimpleDateTime $+                (Just .) . Created+    vjDTStart <- optLine1 "DTSTART" $+                Just .: parseSimpleDateOrDateTime DTStartDateTime DTStartDate+    vjDescription <- optLineN "DESCRIPTION" $ parseAltRepLang Description+    vjLastMod <- optLine1 "LAST-MODIFIED" (Just .: parseLastModified)+    vjOrganizer <- optLine1 "ORGANIZER" (Just .: parseOrganizer)+    vjRecurId <- optLine1 "RECURRENCE-ID" (Just .: parseRecurId vjDTStart)+    vjSeq <- optLine1 "SEQUENCE" $ parseSimpleRead Sequence+    vjStatus <- optLine1 "STATUS" (Just .: parseJournalStatus)+    vjSummary <- optLine1 "SUMMARY" .+                parseAltRepLang $ (((Just .) .) .) . Summary+    vjUrl <- optLine1 "URL" (Just .: parseSimpleURI URL)+    vjRRule <- optLineN "RRULE" $ parseRRule vjDTStart+    when (S.size vjRRule > 1) $ tell ["SHOULD NOT have multiple RRules."]+    vjAttach <- optLineN "ATTACH" parseAttachment+    vjAttendee <- optLineN "ATTENDEE" parseAttendee+    vjCategories <- optLineN "CATEGORIES" parseCategories+    vjComment <- optLineN "COMMENT" $ parseAltRepLang Comment+    vjContact <- optLineN "CONTACT" $ parseAltRepLang Contact+    vjExDate <- optLineN "EXDATE" parseExDate+    vjRStatus <- optLineN "REQUEST-STATUS" parseRequestStatus+    vjRelated <- optLineN "RELATED-TO" parseRelatedTo+    vjRDate <- optLineN "RDATE" parseRDate+    vjOther <- otherProperties+    return VJournal {..}+parseVJournal x = throwError $ "parseVJournal: " ++ show x++parseVFreeBusy :: Content -> ContentParser VFreeBusy+parseVFreeBusy (Component _ "VFreeBusy" _) = do+    vfbDTStamp <- reqLine1 "DTSTAMP" $ parseSimpleUTC DTStamp+    vfbUID <- reqLine1 "UID" $ parseSimple UID+    vfbContact <- optLine1 "CONTACT" $ Just .: parseAltRepLang Contact+    vfbDTStart <- optLine1 "DTSTART" $+                  Just .: parseSimpleDateOrDateTime DTStartDateTime DTStartDate+    vfbDTEnd <- optLine1 "DTEND" $ Just .: parseSimpleDateOrDateTime+                                                DTEndDateTime DTEndDate+    vfbOrganizer <- optLine1 "ORGANIZER" $ Just .: parseOrganizer+    vfbAttendee <- optLineN "ATTENDEE" parseAttendee+    vfbComment <- optLineN "COMMENT" $ parseAltRepLang Comment+    vfbRStatus <- optLineN "REQUEST-STATUS" parseRequestStatus+    vfbUrl <- optLine1 "URL" (Just .: parseSimpleURI URL)+    vfbFreeBusy <- optLineN "FREEBUSY" parseFreeBusy+    vfbOther <- otherProperties+    return VFreeBusy {..}+parseVFreeBusy x = throwError $ "parseVFreeBusy: " ++ show x++otherComponents :: ContentParser (Set VOther)+otherComponents = optN parseVOther . partition isComponent =<< snd <$> get++parseVOther :: Content -> ContentParser VOther+parseVOther (Component _ voName _) = do+    voProps <- otherProperties+    return VOther {..}+parseVOther x = throwError $ "parseVOther: "++ show x+

@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.ICalendar.Parser.Content where++import Control.Applicative+import Control.Monad+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Builder as Bu+import Data.CaseInsensitive (CI)+import Data.Char+import Data.Monoid+import Data.Text.Lazy (Text)++import qualified Text.Parsec as P+import Text.Parsec.Prim hiding (many, (<|>))+import Text.Parsec.Combinator hiding (optional)+import Text.Parsec.ByteString.Lazy ()+import Text.Parsec.Text.Lazy ()++import Text.ICalendar.Parser.Common++parseToContent :: TextParser [Content]+parseToContent = do content <- sepEndBy1 contentline newline+                    f <- dfBS2IText <$> getState+                    return $ componentalize f content++newline :: TextParser ()+newline = (char '\r' >> void (optional $ char '\n')) <|> void (char '\n')+++componentalize :: (ByteString -> CI Text) -> [Content] -> [Content]+componentalize f (ContentLine p "BEGIN" [] n:xs) =+    let (com, rest) = break g xs+        g (ContentLine _ "END" [] en) | f en == n' = True+        g _ = False+        n' = f n+     in Component p n' (componentalize f com)+                : componentalize f (drop 1 rest)+componentalize f (x:xs) = x:componentalize f xs+componentalize _ _ = []+++-- | Specialized scan function which unfolds lines.+scan :: s -- ^ Initial state.+     -> (s -> Maybe Char -> Maybe (Maybe s))+     -- ^ Nothing: Fail.+     -- Just Nothing: Done, don't use last char.+     -- Just (Just state): Continue, collecting char unless EOF.+     -> TextParser ByteString+scan state f = go state mempty+  where go st buf = do+            _ <- many (try unfold)+            c <- lookAhead (Just <$> P.anyChar <|> Nothing <$ P.eof)+            case (c, f st c) of+                 (_, Nothing) -> mzero+                 (Just c', Just (Just st')) ->+                    P.anyChar *> go st' (buf <> Bu.char8 c')+                 (_, _) -> return $ Bu.toLazyByteString buf++        unfold = (P.char '\r' >> optional (P.char '\n') >> P.oneOf " \t")+             <|> (P.char '\n' >> P.oneOf " \t")++takeWhile1 :: (Char -> Bool) -> TextParser ByteString+takeWhile1 p = scan False f <?> "takeWhile1 ..."+  where f g (Just x) | p x       = Just (Just True)+                     | g         = Just Nothing+                     | otherwise = Nothing+        f g _        | g         = Just Nothing+                     | otherwise = Nothing++char :: Char -> TextParser ByteString+char c = scan True f <?> show c+  where f True x = if Just c == x then Just (Just False) else Nothing+        f False _ = Just Nothing+++isControl', isSafe, isValue, isQSafe, isName :: Char -> Bool+isControl' c = c /= '\t' && isControl c+isSafe c = not (isControl' c) && c `notElem` "\";:,"+isValue c = let n = fromEnum c in n == 32 || n == 9 || (n >= 0x21 && n /= 0x7F)+isQSafe c = isValue c && c /= '"'+isName c = isAsciiUpper c || isAsciiLower c || isDigit c || c == '-'++contentline :: TextParser Content+contentline = do pos <- getPosition+                 n <- name+                 ps <- many (char ';' >> param)+                 _ <- char ':'+                 val <- value <|> return mempty+                 return $ ContentLine pos n ps val+  where value :: TextParser ByteString+        value = takeWhile1 isValue <?> "value"++        param :: TextParser (CI Text, [Text])+        param = do n <- name+                   _ <- char '='+                   vs <- sepBy1 paramValue (char ',')+                   return (n, vs)++        name :: TextParser (CI Text)+        name = dfBS2IText <$> getState <*> takeWhile1 isName <?> "name"++        paramValue :: TextParser Text+        paramValue = paramtext <|> quotedString++        paramtext :: TextParser Text+        paramtext = dfBS2Text <$> getState <*> takeWhile1 isSafe <?> "paramtext"++        quotedString :: TextParser Text+        quotedString = (do+            _ <- char '"'+            s <- takeWhile1 isQSafe <|> return mempty+            _ <- char '"'+            dfBS2Text <$> getState <*> pure s) <?> "quoted string"

@@ -0,0 +1,208 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.ICalendar.Parser.Parameters where++import Control.Applicative+import Control.Monad.Error+import Control.Monad.RWS ( MonadWriter(tell) )+import Data.ByteString.Lazy.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.CaseInsensitive (CI)+import Data.Char+import Data.Default+import Data.Maybe+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T++import Codec.MIME.Parse (parseMIMEType)+import Codec.MIME.Type (mimeType, MIMEType)+import qualified Text.Parsec as P+import Text.Parsec.Prim hiding ((<|>))+import Text.Parsec.Perm+import Text.Parsec.Combinator hiding (optional)++import Text.ICalendar.Types+import Text.ICalendar.Parser.Common++parseAlarmTriggerRelationship :: CI Text+                              -> ContentParser AlarmTriggerRelationship+parseAlarmTriggerRelationship "START" = return Start+parseAlarmTriggerRelationship "END" = return End+parseAlarmTriggerRelationship x =+    throwError $ "parseAlarmTriggerRelationship: " ++ show x++-- | Parse relationship type. 3.2.15+parseRelationshipType :: CI Text -> RelationshipType+parseRelationshipType "PARENT"  = Parent+parseRelationshipType "CHILD"   = Child+parseRelationshipType "SIBLING" = Sibling+parseRelationshipType x = RelationshipTypeX x++-- | Parse bool. 3.3.2+parseBool :: CI Text -> ContentParser Bool+parseBool "TRUE" = return True+parseBool "FALSE" = return False+parseBool x = throwError $ "parseBool: " ++ show x++-- | Parse recurrence identifier range. 3.2.13+parseRange :: CI Text -> ContentParser Range+parseRange "THISANDFUTURE" = return ThisAndFuture+parseRange "THISANDPRIOR"  = do tell ["THISANDPRIOIR RANGE is deprecated."]+                                return ThisAndPrior+parseRange x = throwError $ "parseRange: " ++ show x++-- | Parse free/busy time type. 3.2.9.+parseFBType :: CI Text -> FBType+parseFBType "FREE"             = Free+parseFBType "BUSY"             = Busy+parseFBType "BUSY-UNAVAILABLE" = BusyUnavailable+parseFBType "BUSY-TENTATIVE"   = BusyTentative+parseFBType x                  = FBTypeX x++-- | Parse participation status. 3.2.12+parsePartStat :: CI Text -> PartStat+parsePartStat "NEEDS-ACTION" = PartStatNeedsAction+parsePartStat "ACCEPTED" = Accepted+parsePartStat "DECLINED" = Declined+parsePartStat "TENTATIVE" = Tentative+parsePartStat "DELEGATED" = Delegated+parsePartStat "COMPLETED" = PartStatCompleted+parsePartStat "IN-PROCESS" = InProcess+parsePartStat x = PartStatX x++-- | Parse role.+parseRole :: CI Text -> Role+parseRole "CHAIR" = Chair+parseRole "REQ-PARTICIPANT" = ReqParticipant+parseRole "OPT-PARTICIPANT" = OptParticipant+parseRole "NON-PARTICIPANT" = NonParticipant+parseRole x = RoleX x+++parseCUType :: CI Text -> CUType+parseCUType "INDIVIDUAL" = Individual+parseCUType "GROUP" = Group+parseCUType "RESOURCE" = Resource+parseCUType "ROOM" = Room+parseCUType "UNKNOWN" = Unknown+parseCUType x = CUTypeX x++parseMime :: Text -> ContentParser MIMEType+parseMime t = let m = mimeType .: parseMIMEType $ T.unpack t+               in maybe (throwError $ "parseMime: " ++ show t) return m++-- | Parse Duration. 3.3.6+parseDuration :: String -- ^ Parser context.+              -> ByteString -- ^ What to parse.+              -> ContentParser Duration+parseDuration what bs =+    case runParser dur def what bs of+         Left e -> throwError $ "Invalid duration: "+                              ++ unlines [show bs, show e]+         Right x -> return x+  where dur = do si <- sign+                 _ <- P.char 'P'+                 day <- optional . try $ digits <* P.char 'D'+                 time <- optional $ do+                    _ <- P.char 'T'+                    h <- optional . try $ digits <* P.char 'H'+                    m <- optional . try $ digits <* P.char 'M'+                    s <- optional . try $ digits <* P.char 'S'+                    return (h, m, s)+                 week <- optional . try $ digits <* P.char 'W'+                 P.eof+                 case (day, time, week) of+                      (Just d, x, Nothing) ->+                           let (h, m, s) = deMHms x+                            in return $ DurationDate si d h m s+                      (Nothing, x@(Just _), Nothing) ->+                           let (h, m, s) = deMHms x+                            in return $ DurationTime si h m s+                      (Nothing, Nothing, Just w) ->+                           return $ DurationWeek si w+                      (_, _, _) -> fail "Invalid."++        sign = fromMaybe Positive <$> optional (Positive <$ P.char '+'+                                            <|> Negative <$ P.char '-')++        deMHms (Just (h, m, s)) = (fromMaybe 0 h, fromMaybe 0 m, fromMaybe 0 s)+        deMHms Nothing = (0, 0, 0)++-- | Parse Recur-value. 3.3.10.+-- Partly implemented in parsec.+parseRecur :: DTStart -> TextParser (ContentParser Recur)+parseRecur dts =+    permute (mkRecur <$$> (freq <* term)+                     <|?> (Nothing, untilCount <* term)+                     <|?> (1, istring "INTERVAL=" *> digits <* term)+                     <|?> ([], istring "BYSECOND=" *> digitsN <* term)+                     <|?> ([], istring "BYMINUTE=" *> digitsN <* term)+                     <|?> ([], istring "BYHOUR=" *> digitsN <* term)+                     <|?> ([], istring "BYDAY=" *> sepBy wday (P.char ',')+                                                     <* term)+                     <|?> ([], istring "BYMONTHDAY=" *> onum <* term)+                     <|?> ([], istring "BYYEARDAY=" *> onum <* term)+                     <|?> ([], istring "BYWEEKNO=" *> onum <* term)+                     <|?> ([], istring "BYMONTH=" *> digitsN <* term)+                     <|?> ([], istring "BYSETPOS=" *> onum <* term)+                     <|?> (Monday, istring "WKST=" *> weekday <* term))+      <* P.eof++  where freq = istring "FREQ=" *> frequency+        frequency = Secondly <$ istring "SECONDLY"+                <|> Minutely <$ istring "MINUTELY"+                <|> Hourly   <$ istring "HOURLY"+                <|> Daily    <$ istring "DAILY"+                <|> Weekly   <$ istring "WEEKLY"+                <|> Monthly  <$ istring "MONTHLY"+                <|> Yearly   <$ istring "YEARLY"+        weekday = Sunday    <$ istring "SU"+              <|> Monday    <$ istring "MO"+              <|> Tuesday   <$ istring "TU"+              <|> Wednesday <$ istring "WE"+              <|> Thursday  <$ istring "TH"+              <|> Friday    <$ istring "FR"+              <|> Saturday  <$ istring "SA"+        wday = Right <$> weekday+           <|> (Left .) . (,) <$> (neg <*> digits) <*> weekday+        onum = sepBy1 (neg <*> digits) (P.char ',')+        untilCount = istring "UNTIL=" *> until'+                 <|> istring "COUNT=" *> (Just . Right <$> digits)+        until' = do txt <- manyTill P.anyChar (void (P.char ';') <|> P.eof)+                    return . Just . Left $+                        case dts of+                             DTStartDateTime _ _ ->+                                 Right <$> parseDateTime Nothing (B.pack txt)+                             DTStartDate _ _ ->+                                 Left <$> parseDate (B.pack txt)+        term = optional (P.char ';')+        istring :: String -> TextParser ()+        istring = void . try . mapM (\c -> P.char c <|> P.char (toLower c))++        mkRecur f uc i s m h d md yd wn mo sp wkst = do+            uc' <- case uc of+                        Just (Left x) -> Just . Left <$> x+                        Just (Right y) -> return . Just $ Right y+                        Nothing -> return Nothing+            return $ Recur f uc' i s m h d md yd wn mo sp wkst++++parseUTCPeriod :: ByteString -> ContentParser UTCPeriod+parseUTCPeriod bs = do+    let (dateTime', x) = B.drop 1 <$> B.break (=='/') bs+    when (B.null x) . throwError $ "Invalid UTCperiod: " ++ show bs+    dateTime <- mustBeUTC =<< parseDateTime Nothing dateTime'+    case B.head x of+         z | z `elem` "+-P" -> UTCPeriodDuration dateTime+                                    <$> parseDuration "period" x+         _ -> UTCPeriodDates dateTime <$> (mustBeUTC =<< parseDateTime Nothing x)++parsePeriod :: Maybe Text -> ByteString -> ContentParser Period+parsePeriod tzid bs = do+    let (dateTime', x) = B.drop 1 <$> B.break (=='/') bs+    when (B.null x) . throwError $ "Invalid period: " ++ show bs+    dateTime <- parseDateTime tzid dateTime'+    case B.head x of+         z | z `elem` "+-P" -> PeriodDuration dateTime+                                    <$> parseDuration "period" x+         _ -> PeriodDates dateTime <$> parseDateTime tzid x

@@ -0,0 +1,383 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-}+module Text.ICalendar.Parser.Properties where++import Prelude hiding (mapM)+import Control.Applicative+import Control.Monad.Error 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 Text.ParserCombinators.ReadP (readP_to_S)++import Text.Parsec.Prim hiding ((<|>))++import Text.ICalendar.Types+import Text.ICalendar.Parser.Common+import Text.ICalendar.Parser.Parameters++parseFreeBusy :: Content -> ContentParser FreeBusy+parseFreeBusy (ContentLine _ "FREEBUSY" o bs) = do+    typ <- maybe (return def) (parseFBType . CI.mk .: paramOnlyOne) $+                     lookup "FBTYPE" o+    periods <- S.fromList .: mapM parseUTCPeriod $ B.split ',' bs+    return $ FreeBusy typ periods (toO $ filter ((/="FBTYPE").fst) o)+parseFreeBusy x = throwError $ "parseFreeBusy: " ++ show x++parseXDurationOpt :: CI Text+                  -> (DateTime -> OtherParams -> a)+                  -> (Date     -> OtherParams -> a)+                  -> Maybe DTStart+                  -> ContentParser (Maybe (Either a DurationProp))+parseXDurationOpt w a b dts = do+    dte <- optLine1 w $ Just .: parseSimpleDateOrDateTime a b+    dur <- optLine1 "DURATION" $ Just .: parseDurationProp dts+    case (dte, dur) of+         (Nothing, Nothing) -> return Nothing+         (Just x, Nothing) -> return . Just $ Left x+         (Nothing, Just x) -> return . Just $ Right x+         _ -> throwError "Either DTEND or DURATION can be specified, but not \+                         \both."++-- | Parse trigger. 3.8.6.3+parseTrigger :: Content -> ContentParser Trigger+parseTrigger (ContentLine _ "TRIGGER" o bs) = do+    value <- paramOnlyOne . fromMaybe ["DURATION"] $ lookup "VALUE" o+    case value of+         "DURATION" -> do+            rel <- maybe (return def)+                         (parseAlarmTriggerRelationship . CI.mk+                               <=< paramOnlyOne) $ lookup "RELATED" o+            let o' = filter (\(x,_) -> x /= "VALUE" && x /= "RELATED") o+            val <- parseDuration "TRIGGER" bs+            return $ TriggerDuration val rel (toO o')+         "DATE-TIME" -> do val <- mustBeUTC =<< parseDateTime Nothing bs+                           let o' = filter (\(x, _) -> x /= "VALUE") o+                           return $ TriggerDateTime val (toO o')+         x -> throwError $ "parseTrigger: invalid value: " ++ show x+parseTrigger x = throwError $ "parseTrigger: " ++ show x+++-- | Parse related to. 3.8.4.5+parseRelatedTo :: Content -> ContentParser RelatedTo+parseRelatedTo (ContentLine _ "RELATED-TO" o bs) = do+    val <- valueOnlyOne =<< parseText bs+    typ <- maybe (return def) (parseRelationshipType . CI.mk .: paramOnlyOne) $+                lookup "RELTYPE" o+    return $ RelatedTo val typ (toO $ filter (\(x,_) -> x /= "RELTYPE") o)+parseRelatedTo x = throwError $ "parseRelatedTo: " ++ show x+++-- | Parse request status. 3.8.8.3+parseRequestStatus :: Content -> ContentParser RequestStatus+parseRequestStatus (ContentLine _ "REQUEST-STATUS" o bs) = do+    let (statcode', rest) = B.break (==';') bs+        statcode :: Maybe [Int]+        statcode = mapM (maybeRead . B.unpack) $ B.split '.' statcode'+    when (isNothing statcode) .+        throwError $ "parseRequestStatus: invalid code: " ++ show bs+    when (B.null rest) .+        throwError $ "parseRequestStatus: missing statdesc: " ++ show bs+    (statdesc, rest') <- (\(a,b) -> (,b) <$> valueOnlyOne a)+                                   <=< parseText' $ B.tail rest+    statext <- if B.null rest'+                  then return Nothing+                  else do when (B.head rest' /= ';') .+                              throwError $ "parseRequestStatus: bad desc: " +++                                               show bs+                          Just <$> (valueOnlyOne =<< parseText (B.tail rest'))+    lang <- mapM paramOnlyOne $ Language . CI.mk .: lookup "LANGUAGE" o+    let o' = filter (\(x, _) -> x `notElem` ["LANGUAGE"]) o+    return $ RequestStatus (fromJust statcode) statdesc lang statext (toO o')+parseRequestStatus x = throwError $ "parseRequestStatus: " ++ show x++-- | Parse exception date-times. 3.8.5.1+parseExDate :: Content -> ContentParser ExDate+parseExDate (ContentLine _ "EXDATE" o bs) = do+    (typ, tzid, o') <- typTzIdO o+    let bs' = B.split ',' bs+    case typ of+         "DATE-TIME" -> do xs <- mapM (parseDateTime tzid) bs'+                           return . ExDateTimes (S.fromList xs) $ toO o'+         "DATE" -> do xs <- mapM parseDate bs'+                      return . ExDates (S.fromList xs) $ toO o'+         _ -> throwError $ "Invalid type: " ++ show typ+parseExDate x = throwError $ "parseExDate: " ++ show x++-- | Parse categories. 3.8.1.2+parseCategories :: Content -> ContentParser Categories+parseCategories (ContentLine _ "CATEGORIES" o bs) = do+    vals <- parseText bs+    lang <- mapM paramOnlyOne $ Language . CI.mk .: lookup "LANGUAGE" o+    let o' = filter (\(x, _) -> x `notElem` ["LANGUAGE"]) o+    return $ Categories (S.fromList vals) lang (toO o')+parseCategories x = throwError $ "parseCategories: " ++ show x++-- | Parse attendee. 3.8.4.1+parseAttendee :: Content -> ContentParser Attendee+parseAttendee (ContentLine _ "ATTENDEE" o bs) = do+    attendeeValue <- parseURI =<< asks (T.unpack . ($ bs) . dfBS2Text)+    attendeeCUType <- g (parseCUType . CI.mk .: paramOnlyOne) $+                        lookup "CUTYPE" o+    attendeeMember <- g (S.fromList .: mapM (parseURI . T.unpack)) $+                        lookup "MEMBER" o+    attendeeRole <- g (parseRole . CI.mk .: paramOnlyOne) $ lookup "ROLE" o+    attendeePartStat <- g (parsePartStat . CI.mk .: paramOnlyOne) $+                        lookup "PARTSTAT" o+    attendeeRSVP <- maybe (return False) (parseBool . CI.mk <=< paramOnlyOne) $+                        lookup "RSVP" o+    attendeeDelTo <- g (S.fromList .: mapM (parseURI . T.unpack)) $+                        lookup "DELEGATED-TO" o+    attendeeDelFrom <- g (S.fromList .: mapM (parseURI . T.unpack)) $+                        lookup "DELEGATED-FROM" o+    attendeeSentBy <- mapM (parseURI . T.unpack <=< paramOnlyOne) $+                        lookup "SENT-BY" o+    attendeeCN <- mapM paramOnlyOne $ lookup "CN" o+    attendeeDir <- mapM (parseURI . T.unpack <=< paramOnlyOne) $+                        lookup "DIR" o+    attendeeLanguage <- mapM (Language . CI.mk .: paramOnlyOne) $+                        lookup "LANGUAGE" o+    let attendeeOther = toO $ filter f o+        f (x, _) = x `notElem` [ "CUTYPE", "MEMBER", "ROLE", "PARTSTAT", "RSVP"+                               , "DELEGATED-TO", "DELEGATED-FROM", "SENT-BY"+                               , "CN", "DIR"]+    return Attendee {..}+  where g :: (Monad m, Default b) => (a -> m b) -> Maybe a -> m b+        g = maybe $ return def+parseAttendee x = throwError $ "parseAttendee: " ++ show x+++-- | Parse attachment. 3.8.1.1+parseAttachment :: Content -> ContentParser Attachment+parseAttachment (ContentLine _ "ATTACH" o bs) = do+    fmt <- mapM (parseMime <=< paramOnlyOne) $ lookup "FMTTYPE" o+    val <- mapM paramOnlyOne $ lookup "VALUE" o+    case val of+         Just "BINARY" -> do+             enc <- mapM paramOnlyOne $ lookup "ENCODING" o+             case enc of+                  Just "BASE64" ->+                      case B64.decode bs of+                           Left e -> throwError $ "parseAttachment: invalid \+                                                  \base64: " ++ e+                           Right v -> return $ BinaryAttachment fmt v+                                                  (toO $ filter binF o)+                  _ -> throwError $ "parseAttachment: invalid encoding: " +++                                        show enc+         Nothing -> do uri <- parseURI =<< asks (T.unpack . ($ bs) . dfBS2Text)+                       return $ UriAttachment fmt uri (toO $ filter f o)+         _ -> throwError $ "parseAttachment: invalid value: " ++ show val+  where binF a@(x, _) = f a && x /= "VALUE" && x /= "ENCODING"+        f (x, _) = x /= "FMTTYPE"+parseAttachment x = throwError $ "parseAttachment: " ++ show x++parseDurationProp :: Maybe DTStart -> Content -> ContentParser DurationProp+parseDurationProp dts (ContentLine _ "DURATION" o bs) = do+    val <- parseDuration "DURATION" bs+    case (dts, val) of+         (Just DTStartDate {}, DurationDate {..})+            | durHour == 0 && durMinute == 0 && durSecond == 0 -> return ()+         (Just DTStartDate {}, DurationWeek {}) -> return ()+         (Just DTStartDate {}, _) ->+             throwError "DURATION must be in weeks or days when DTSTART \+                        \has VALUE DATE and not DATE-TIME."+         _ -> return ()+    return . DurationProp val $ toO o+parseDurationProp _ x = throwError $ "parseDurationProp: " ++ show x++parseRecurId :: Maybe DTStart -> Content -> ContentParser RecurrenceId+parseRecurId dts (ContentLine p "RECURRENCE-ID" o bs) = do+    range' <- maybe (return def) (parseRange . CI.mk <=< paramOnlyOne) $+                                   lookup "RANGE" o+    recurid <- parseSimpleDateOrDateTime+            (($ range') . RecurrenceIdDateTime)+            (($ range') . RecurrenceIdDate)+            (ContentLine p "RECURRENCE-ID" (filter ((/="RANGE").fst) o) bs)+    case (dts, recurid) of+         (Nothing, _) -> return recurid+         (Just DTStartDate {}, RecurrenceIdDate {}) ->+             return recurid+         (Just DTStartDateTime {dtStartDateTimeValue = v},+          RecurrenceIdDateTime {recurrenceIdDateTime = r}) ->+               case (v, r) of -- TODO: Check this. iff confuse me.+                    (UTCDateTime {}, FloatingDateTime {}) -> err dts recurid+                    (UTCDateTime {}, ZonedDateTime {})    -> err dts recurid+                    (FloatingDateTime {}, UTCDateTime {}) -> err dts recurid+                    (ZonedDateTime {}, UTCDateTime {})    -> err dts recurid+                    _ -> return recurid+         _ -> err dts recurid+  where err d r = throwError $ "parseRecurId: DTSTART local time mismatch: " +++                                show (d, r)+parseRecurId _ x = throwError $ "parseRecurId: " ++ show x++-- | Parse time transparency. 3.8.2.7+parseTransp :: Content -> ContentParser TimeTransparency+parseTransp (ContentLine _ "TRANSP" o x)+    | CI.mk x == "OPAQUE" = return . Opaque $ toO o+    | CI.mk x == "TRANSPARENT" = return . Transparent $ toO o+parseTransp x = throwError $ "parseTransp: " ++ show x++-- | Parse event status. 3.8.1.11+parseEventStatus :: Content -> ContentParser EventStatus+parseEventStatus (ContentLine _ "STATUS" o x)+    | CI.mk x == "TENTATIVE" = return . TentativeEvent $ toO o+    | CI.mk x == "CONFIRMED" = return . ConfirmedEvent $ toO o+    | CI.mk x == "CANCELLED" = return . CancelledEvent $ toO o+parseEventStatus x = throwError $ "parseEventStatus: " ++ show x++-- | Parse todo status. 3.8.1.11+parseTodoStatus :: Content -> ContentParser TodoStatus+parseTodoStatus (ContentLine _ "STATUS" o x)+    | CI.mk x == "NEEDS-ACTION" = return . TodoNeedsAction $ toO o+    | CI.mk x == "COMPLETED"    = return . CompletedTodo   $ toO o+    | CI.mk x == "IN-PROCESS"   = return . InProcessTodo   $ toO o+    | CI.mk x == "CANCELLED"    = return . CancelledTodo   $ toO o+parseTodoStatus x = throwError $ "parseTodoStatus: " ++ show x++-- | Parse journal status. 3.8.1.11+parseJournalStatus :: Content -> ContentParser JournalStatus+parseJournalStatus (ContentLine _ "STATUS" o x)+    | CI.mk x == "DRAFT"     = return . DraftJournal     $ toO o+    | CI.mk x == "FINAL"     = return . FinalJournal     $ toO o+    | CI.mk x == "CANCELLED" = return . CancelledJournal $ toO o+parseJournalStatus x = throwError $ "parseJournalStatus: " ++ show x++-- | Parse organizer. 3.8.4.3+parseOrganizer :: Content -> ContentParser Organizer+parseOrganizer (ContentLine _ "ORGANIZER" o bs) = do+    organizerValue <- parseURI =<< asks (T.unpack . ($ bs) . dfBS2Text)+    organizerCN <- mapM paramOnlyOne $ lookup "CN" o+    organizerDir <- mapM (parseURI . T.unpack <=< paramOnlyOne) $ lookup "DIR" o+    organizerSentBy <- mapM (parseURI . T.unpack <=< paramOnlyOne) $+        lookup "SENT-BY" o+    organizerLanguage <- mapM (Language . CI.mk .: paramOnlyOne) $+        lookup "LANGUAGE" o+    let f x = x `notElem` ["CN", "DIR", "SENT-BY", "LANGUAGE"]+        o' = filter (f . fst) o+    return Organizer { organizerOther = toO o', .. }+parseOrganizer x = throwError $ "parseOrganizer: " ++ show x++-- | Parse geographic position. 3.8.1.6+parseGeo :: Content -> ContentParser Geo+parseGeo (ContentLine _ "GEO" o bs) = do+    let (lat', long') = B.break (==';') bs+        lat = maybeRead . stripPlus $ B.unpack lat' :: Maybe Float+        long = maybeRead . stripPlus . B.unpack $ B.tail long' :: Maybe Float+    when (B.null long' || isNothing (lat >> long)) .+        throwError $ "Invalid latitude/longitude: " ++ show bs+    return $ Geo (fromJust lat) (fromJust long) (toO o)+  where stripPlus ('+':xs) = xs+        stripPlus xs = xs+parseGeo x = throwError $ "parseGeo: " ++ show x++-- | Parse classification. 3.8.1.3+parseClass :: Content -> ContentParser Class+parseClass (ContentLine _ "CLASS" o bs) = do+    iconv <- asks dfBS2IText+    return . flip Class (toO o) $+        case iconv bs of+             "PUBLIC" -> Public+             "PRIVATE" -> Private+             "CONFIDENTIAL" -> Confidential+             x -> ClassValueX x+parseClass x = throwError $ "parseClass: " ++ show x++-- | Parse TZName. 3.8.3.1+parseTZName :: Content -> ContentParser TZName+parseTZName (ContentLine _ "TZNAME" o bs) = do+    txt <- valueOnlyOne =<< parseText bs+    lang <- mapM paramOnlyOne $ Language . CI.mk .: lookup "LANGUAGE" o+    return $ TZName txt lang (toO o)+parseTZName x = throwError $ "parseTZName: " ++ show x+++-- | Parse a VERSION property 3.7.4+parseVersion :: Content -> ContentParser ICalVersion+parseVersion (ContentLine _ "VERSION" o bs) = do+    c <- asks dfBS2Text+    let (maxver', minver'') = break (==';') . T.unpack $ c bs+        minver' = drop 1 minver''+        parseVer = fst .: listToMaybe . filter ((=="") . snd)+                                       . readP_to_S Ver.parseVersion+        maxver = parseVer maxver'+        minver = parseVer minver'+        [maxJ, minJ] = fromJust <$> [maxver, minver]+    when (isNothing maxver) .+        throwError $ "parseVersion: error parsing version: " ++ show maxver'+    if null minver''+       then return $ MaxICalVersion maxJ (toO o)+       else do when (isNothing minver) .+                    throwError $ "parseVersion: error parsing version: "+                                   ++ show minver'+               return $ MinMaxICalVersion maxJ minJ (toO o)+parseVersion x = throwError $ "parseVersion: " ++ show x++-- | Parse a TZID property. 3.8.3.1+parseTZID :: Content -> ContentParser TZID+parseTZID (ContentLine _ "TZID" o bs) = do+    tzidValue <- asks $ ($ bs) . dfBS2Text+    let tzidGlobal = (fst <$> T.uncons tzidValue) == Just '/'+        tzidOther = toO o+    return TZID {..}+parseTZID x = throwError $ "parseTZID: " ++ show x++-- | Parse RRule. 3.8.5.3+parseRRule :: Maybe DTStart -> Content -> ContentParser RRule+parseRRule Nothing _ = throwError "parseRRule: missing DTSTART."+parseRRule (Just dts) (ContentLine _ "RRULE" o bs) =+    case runParser (parseRecur dts) def "RRULE" bs of+         Left e -> throwError $ show e+         Right x -> do y <- x+                       return . RRule y $ toO o+parseRRule _ x = throwError $ "parseRRule: " ++ show x++-- | Parse Last Modified, 3.8.7.3+parseLastModified :: Content -> ContentParser LastModified+parseLastModified (ContentLine _ "LAST-MODIFIED" o bs) = do+    lastModifiedValue <- mustBeUTC =<< parseDateTime Nothing bs+    let lastModifiedOther = toO o+    return LastModified {..}+parseLastModified x = throwError $ "parseLastModified: " ++ show x++-- | Parse an RDate+parseRDate :: Content -> ContentParser RDate+parseRDate c@(ContentLine _ "RDATE" o bs) = do+    typ <- paramOnlyOne . fromMaybe ["DATE-TIME"] $ lookup "VALUE" o+    case typ of+         "PERIOD" -> do+             tzid <- mapM paramOnlyOne $ lookup "TZID" o+             p <- S.fromList .: mapM (parsePeriod tzid) $ B.split ',' bs+             return . RDatePeriods p . toO $+                filter ((`notElem` ["VALUE", "TZID"]) . fst) o+         _ -> parseSimpleDatesOrDateTimes RDateDateTimes RDateDates c+parseRDate x = throwError $ "parseRDate: " ++ show x++-- | Parse a UTC Offset property 3.3.14, 3.8.3.4, and 3.8.3.3+parseUTCOffset :: Content -> ContentParser UTCOffset+parseUTCOffset (ContentLine _ n o bs)+        | n `elem` ["TZOFFSETTO", "TZOFFSETFROM"] = do+    let str = B.unpack bs+        (s:rest) = str+        (t1:t2:m1:m2:sec) = map digitToInt rest+        (s1:s2:_) = sec+        sign x = if s == '-' then negate x else x+    when (length str < 5 || any (not . isDigit) rest || s `notElem` "+-"+                         || length sec `notElem` [0,2]) .+        throwError $ "parseUTCOffset: " ++ str+    return . UTCOffset (sign $ ((t1 * 10 + t2) * 60 + (m1 * 10 + m2)) * 60 ++                                if not (null sec) then s1 * 10 + s2 else 0)+                       $ toO o+parseUTCOffset x = throwError $ "parseUTCOffset: " ++ show x++-- }}}

@@ -0,0 +1,958 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+module Text.ICalendar.Printer+    ( EncodingFunctions(..)+    , printICal+    ) where++import Prelude hiding (mapM_)+import Control.Applicative+import Control.Arrow ((&&&))+import Control.Monad hiding (mapM_, forM_)+import Control.Monad.RWS ( RWS, runRWS, MonadWriter(tell)+                         , MonadState(get, put), asks, modify)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy.Builder (Builder)+import qualified Data.ByteString.Lazy.Builder as Bu+import qualified Data.CaseInsensitive as CI+import Data.Char (ord, toUpper)+import Data.Default+import Data.Foldable (mapM_, forM_)+import Data.Monoid+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import Data.Time (FormatTime())+import qualified Data.Time as Time+import qualified Data.Version as Ver+import qualified Network.URI as URI+import qualified System.Locale as L+import Text.Printf (printf)++import Codec.MIME.Type (showMIMEType, MIMEType)+import qualified Data.ByteString.Base64.Lazy as B64++import Text.ICalendar.Types+++-- | Functions for encoding into bytestring builders.+data EncodingFunctions = EncodingFunctions+    { efChar2Bu  :: Char -> Builder+    , efChar2Len :: Char -> Int -- ^ How many octets the character is encoded.+    }++utf8Len :: Char -> Int+utf8Len c | o < 0x80  = 1+          | o < 0x800  = 2+          | o < 0x10000 = 3+          | o < 0x200000 = 4+          | o < 0x4000000 = 5+          | otherwise      = 6+  where o = ord c++newtype AltRep = AltRep URI.URI+newtype CN = CN Text+newtype Dir = Dir URI.URI+newtype Member = Member (Set URI.URI)+newtype DelTo = DelTo (Set URI.URI)+newtype DelFrom = DelFrom (Set URI.URI)+newtype RSVP = RSVP Bool+newtype SentBy = SentBy CalAddress++data Quoting = NeedQuotes | Optional | NoQuotes+               deriving (Eq, Ord, Show)++-- | UTF8.+instance Default EncodingFunctions where+    def = EncodingFunctions Bu.charUtf8+                            utf8Len++type ContentPrinter = RWS EncodingFunctions Builder Int++printICal :: EncodingFunctions -> VCalendar -> ByteString+printICal r v = (\(_, _, x) -> Bu.toLazyByteString x) $+                runRWS (printVCalendar v) r 0++-- {{{ Component printers++printVCalendar :: VCalendar -> ContentPrinter ()+printVCalendar VCalendar {..} = do+    line "BEGIN:VCALENDAR"+    ln $ do prop "VERSION" $ versionOther vcVersion -- Should be first for+            printValue vcVersion                    -- compatibility.+    ln $ do prop "PRODID" $ prodIdOther vcProdId+            text $ prodIdValue vcProdId+    ln $ do prop "CALSCALE" $ scaleOther vcScale+            text . CI.original $ scaleValue vcScale+    forM_ vcMethod $ \meth -> do+        prop "METHOD" $ methodOther meth+        ln . text . CI.original $ methodValue meth+    mapM_ printProperty vcOther+    mapM_ printVTimeZone vcTimeZones+    mapM_ printVEvent vcEvents+    mapM_ printVTodo vcTodos+    mapM_ printVJournal vcJournals+    mapM_ printVFreeBusy vcFreeBusys+    mapM_ printVOther vcOtherComps+    line "END:VCALENDAR"++printVTimeZone :: VTimeZone -> ContentPrinter ()+printVTimeZone VTimeZone {..} = do+    line "BEGIN:VTIMEZONE"+    ln $ do prop "TZID" $ tzidOther vtzId+            text $ tzidValue vtzId+    printProperty vtzLastMod+    forM_ vtzUrl $ \url -> do+        prop "TZURL" $ tzUrlOther url+        ln . printShow $ tzUrlValue url+    mapM_ (printTZProp "STANDARD") vtzStandardC+    mapM_ (printTZProp "DAYLIGHT") vtzDaylightC+    mapM_ printProperty vtzOther+    line "END:VTIMEZONE"++printTZProp :: ByteString -> TZProp -> ContentPrinter ()+printTZProp name TZProp {..} = do+    line $ "BEGIN:" <> name+    printProperty tzpDTStart+    ln $ do prop "TZOFFSETTO" $ utcOffsetOther tzpTZOffsetTo+            printUTCOffset $ utcOffsetValue tzpTZOffsetTo+    ln $ do prop "TZOFFSETFROM" $ utcOffsetOther tzpTZOffsetTo+            printUTCOffset $ utcOffsetValue tzpTZOffsetFrom+    printProperty tzpRRule+    printProperty tzpComment+    printProperty tzpRDate+    forM_ tzpTZName $ \TZName {..} -> ln $ do+        prop "TZNAME" $ toParam tzNameLanguage <> toParam tzNameOther+        text tzNameValue+    mapM_ printProperty tzpOther+    line $ "END:" <> name++printVEvent :: VEvent -> ContentPrinter ()+printVEvent VEvent {..} = do+    line "BEGIN:VEVENT"+    printProperty veDTStamp+    printProperty veUID+    printProperty veDTStart+    printProperty veClass+    printProperty veCreated+    printProperty veDescription+    printProperty veGeo+    printProperty veLastMod+    printProperty veLocation+    printProperty veOrganizer+    printProperty vePriority+    printProperty veSeq+    printProperty veStatus+    printProperty veSummary+    printProperty veTransp+    printProperty veUrl+    printProperty veRecurId+    printProperty veRRule+    printProperty veDTEndDuration+    printProperty veAttach+    printProperty veAttendee+    printProperty veCategories+    printProperty veComment+    printProperty veContact+    printProperty veExDate+    printProperty veRStatus+    printProperty veRelated+    printProperty veResources+    printProperty veRDate+    forM_ veAlarms printVAlarm+    printProperty veOther+    line "END:VEVENT"++printVTodo :: VTodo -> ContentPrinter ()+printVTodo VTodo {..} = do+    line "BEGIN:VTODO"+    printProperty vtDTStamp+    printProperty vtUID+    printProperty vtClass+    printProperty vtCompleted+    printProperty vtCreated+    printProperty vtDescription+    printProperty vtDTStart+    printProperty vtGeo+    printProperty vtLastMod+    printProperty vtLocation+    printProperty vtOrganizer+    printProperty vtPercent+    printProperty vtPriority+    printProperty vtSeq+    printProperty vtRecurId+    printProperty vtStatus+    printProperty vtSummary+    printProperty vtUrl+    printProperty vtRRule+    printProperty vtDueDuration+    printProperty vtAttach+    printProperty vtAttendee+    printProperty vtCategories+    printProperty vtComment+    printProperty vtContact+    printProperty vtExDate+    printProperty vtRStatus+    printProperty vtRelated+    printProperty vtResources+    printProperty vtRDate+    forM_ vtAlarms printVAlarm+    printProperty vtOther+    line "END:VTODO"++printVJournal :: VJournal -> ContentPrinter ()+printVJournal VJournal {..} = do+    line "BEGIN:VJOURNAL"+    printProperty vjDTStamp+    printProperty vjUID+    printProperty vjClass+    printProperty vjCreated+    printProperty vjDescription+    printProperty vjDTStart+    printProperty vjLastMod+    printProperty vjOrganizer+    printProperty vjSeq+    printProperty vjRecurId+    printProperty vjStatus+    printProperty vjSummary+    printProperty vjUrl+    printProperty vjRRule+    printProperty vjAttach+    printProperty vjAttendee+    printProperty vjCategories+    printProperty vjComment+    printProperty vjContact+    printProperty vjExDate+    printProperty vjRStatus+    printProperty vjRelated+    printProperty vjRDate+    printProperty vjOther+    line "END:VJOURNAL"++printVFreeBusy :: VFreeBusy -> ContentPrinter ()+printVFreeBusy VFreeBusy {..} = do+    line "BEGIN:VFREEBUSY"+    printProperty vfbDTStamp+    printProperty vfbUID+    printProperty vfbContact+    printProperty vfbDTStart+    printProperty vfbDTEnd+    printProperty vfbOrganizer+    printProperty vfbUrl+    printProperty vfbAttendee+    printProperty vfbComment+    printProperty vfbFreeBusy+    printProperty vfbRStatus+    printProperty vfbOther+    line "END:VFREEBUSY"++printVOther :: VOther -> ContentPrinter ()+printVOther VOther {..} = do+    ln . out $ "BEGIN:V" <> CI.original voName+    mapM_ printProperty voProps+    ln . out $ "END:V" <> CI.original voName++printVAlarm :: VAlarm -> ContentPrinter ()+printVAlarm va = do+    line "BEGIN:VALARM"+    prop "ACTION" $ vaActionOther va+    case va of+         VAlarmAudio {..} -> do+             ln $ bytestring "AUDIO"+             printProperty vaTrigger+             repAndDur+             printProperty vaAudioAttach+             printProperty vaOther+         VAlarmDisplay {..} -> do+             ln $ bytestring "DISPLAY"+             printProperty vaTrigger+             printProperty vaDescription+             repAndDur+             printProperty vaOther+         VAlarmEmail {..} -> do+             ln $ bytestring "EMAIL"+             printProperty vaTrigger+             printProperty vaDescription+             printProperty vaSummary+             printProperty vaAttendee+             repAndDur+             printProperty vaMailAttach+             printProperty vaOther+         VAlarmX {..} -> do+             ln . out $ CI.original vaAction+             printProperty vaTrigger+             printProperty vaOther+    line "END:VALARM"+  where repAndDur = unless (vaRepeat va == def) $ do+            printProperty $ vaRepeat va+            unless (repeatValue (vaRepeat va) == 0) $+                forM_ (vaDuration va) printProperty++-- }}}+-- {{{ Property printers.++class IsProperty a where+    printProperty :: a -> ContentPrinter ()++instance IsProperty a => IsProperty (Set a) where+    printProperty = mapM_ printProperty++instance IsProperty a => IsProperty (Maybe a) where+    printProperty (Just x) = printProperty x+    printProperty _ = return ()++instance (IsProperty a, IsProperty b) => IsProperty (Either a b) where+    printProperty (Left x) = printProperty x+    printProperty (Right x) = printProperty x++instance IsProperty FreeBusy where+    printProperty FreeBusy {..} = ln $ do+        prop "FREEBUSY" $ toParam freeBusyOther <> toParam freeBusyType+        printN printValue $ S.toList freeBusyPeriods++instance IsProperty PercentComplete where+    printProperty PercentComplete {..} = ln $ do+        prop "PERCENT-COMPLETE" percentCompleteOther+        printShow percentCompleteValue++instance IsProperty Completed where+    printProperty Completed {..} = ln $ do prop "COMPLETED" completedOther+                                           printValue completedValue++instance IsProperty DurationProp where+    printProperty DurationProp {..} = ln $ do prop "DURATION" durationOther+                                              printValue durationValue++instance IsProperty Repeat where+    printProperty Repeat {..} = ln $ do prop "REPEAT" repeatOther+                                        printShow repeatValue++instance IsProperty DTEnd where+    printProperty dtend = ln $ prop "DTEND" dtend >> printValue dtend++instance IsProperty Due where+    printProperty due = ln $ prop "DUE" due >> printValue due++instance IsProperty DTStamp where+    printProperty x = ln $ prop "DTSTAMP" x >> printValue x++instance IsProperty UID where+    printProperty UID {..} = ln $ prop "UID" uidOther >> text uidValue++instance IsProperty DTStart where+    printProperty x = ln $ prop "DTSTART" x >> printValue x++instance IsProperty Class where+    printProperty c@Class {..} | c == def = return ()+                               | otherwise = ln $ do prop "CLASS" classOther+                                                     printValue classValue++instance IsProperty Created where+    printProperty Created {..} = ln $ do +        prop "CREATED" $ toParam createdOther <> toParam createdValue+        printValue createdValue++instance IsProperty Description  where+    printProperty Description {..} = ln $ do+        prop "DESCRIPTION" $ toParam (AltRep <$> descriptionAltRep) <>+                             toParam descriptionLanguage <>+                             toParam descriptionOther+        text descriptionValue++instance IsProperty Geo where+    printProperty Geo {..} = ln $ do+        prop "GEO" geoOther+        out . T.pack $ printf "%.6f;%.6f" geoLat geoLong++instance IsProperty LastModified where+    printProperty LastModified {..} = ln $ do+        prop "LAST-MODIFIED" lastModifiedOther+        printUTCTime lastModifiedValue++instance IsProperty Location where+    printProperty Location {..} = ln $ do+        prop "LOCATION" $ toParam (AltRep <$> locationAltRep) <>+                          toParam locationLanguage <> toParam locationOther+        text locationValue++instance IsProperty Organizer where+    printProperty Organizer {..} = ln $ do+        prop "ORGANIZER" $ toParam (CN <$> organizerCN) <>+                           toParam (Dir <$> organizerDir) <>+                           toParam (SentBy <$> organizerSentBy) <>+                           toParam organizerLanguage <> toParam organizerOther+        printShow organizerValue++instance IsProperty Priority where+    printProperty x | x == def = return ()+                    | otherwise = ln $ do prop "PRIORITY" $ priorityOther x+                                          printShow $ priorityValue x++instance IsProperty Sequence where+    printProperty x | x == def = return ()+                    | otherwise = ln $ do prop "SEQUENCE" $ sequenceOther x+                                          printShow $ sequenceValue x+instance IsProperty EventStatus where+    printProperty s = ln $ do prop "STATUS" $ eventStatusOther s+                              printValue s++instance IsProperty TodoStatus where+    printProperty s = ln $ do prop "STATUS" $ todoStatusOther s+                              printValue s++instance IsProperty JournalStatus where+    printProperty s = ln $ do prop "STATUS" $ journalStatusOther s+                              printValue s++instance IsProperty Summary where+    printProperty Summary {..} = ln $ do+        prop "SUMMARY" $ toParam (AltRep <$> summaryAltRep) <>+                         toParam summaryLanguage <> toParam summaryOther+        text summaryValue++instance IsProperty TimeTransparency where+    printProperty x | x == def = return ()+                    | otherwise = ln $ do+                        prop "TRANSP" $ timeTransparencyOther x+                        printValue x++instance IsProperty URL where+    printProperty URL {..} = ln $ prop "URL" urlOther >> printShow urlValue++instance IsProperty RecurrenceId where+    printProperty r = ln $ prop "RECURRENCE-ID" r >> printValue r++instance IsProperty RRule where+    printProperty RRule {..} = ln $ do prop "RRULE" rRuleOther+                                       printValue rRuleValue++instance IsProperty Attachment where+    printProperty a = ln $ prop "ATTACH" a >> printValue a++instance IsProperty Attendee where+    printProperty att@Attendee {..} = ln $ do+        prop "ATTENDEE" att+        printValue attendeeValue++instance IsProperty Categories where+    printProperty Categories {..} = ln $ do+        prop "CATEGORIES" $ toParam categoriesOther <>+                            toParam categoriesLanguage+        texts $ S.toList categoriesValues++instance IsProperty Comment where+    printProperty Comment {..} = ln $ do+        prop "COMMENT" $ toParam (AltRep <$> commentAltRep) <>+                         toParam commentLanguage <>+                         toParam commentOther+        text commentValue++instance IsProperty Contact where+    printProperty Contact {..} = ln $ do+        prop "CONTACT" $ toParam (AltRep <$> contactAltRep) <>+                         toParam contactLanguage <>+                         toParam contactOther+        text contactValue++instance IsProperty ExDate where+    printProperty exd = ln $ do+        prop "EXDATE" exd+        case exd of+             ExDates {..} -> printN printValue $ S.toList exDates+             ExDateTimes {..} -> printN printValue $ S.toList exDateTimes++instance IsProperty RequestStatus where+    printProperty RequestStatus {..} = ln $ do+        prop "REQUEST-STATUS" $ toParam requestStatusLanguage <>+                                toParam requestStatusOther+        (\z -> case z of+                    (x:xs) -> do printShow x+                                 sequence_ [putc '.' >> printShow y | y <- xs]+                    [] -> return ()) requestStatusCode+        putc ';'+        text requestStatusDesc+        forM_ requestStatusExt $ \x -> putc ';' >> text x++instance IsProperty RelatedTo where+    printProperty RelatedTo {..} = ln $ do+        prop "RELATED-TO" $ toParam relatedToOther <> toParam relatedToType+        text relatedToValue++instance IsProperty Resources where+    printProperty Resources {..} = ln $ do+        prop "RESOURCES" $ toParam (AltRep <$> resourcesAltRep) <>+                           toParam resourcesLanguage <> toParam resourcesOther+        texts $ S.toList resourcesValue++instance IsProperty RDate where+    printProperty r = ln $ prop "RDATE" r >> printValue r++instance IsProperty OtherProperty where+    printProperty OtherProperty {..} = ln $ do+        out (CI.original otherName)+        mapM_ param $ toParam otherParams+        out ":"+        bytestring otherValue++instance IsProperty Trigger where+    printProperty tr@TriggerDuration {..} = ln $ do+        prop "TRIGGER" tr+        printValue triggerDuration+    printProperty tr@TriggerDateTime {..} = ln $ do+        prop "TRIGGER" tr+        printUTCTime triggerDateTime+++-- | Print a generic property.+prop :: ToParam a+     => ByteString+     -> a+     -> ContentPrinter ()+prop b x = do+    put (fromIntegral $ BS.length b) -- +    tell (Bu.lazyByteString b)+    mapM_ param $ toParam x+    out ":"++-- }}}+-- {{{ Parameter "printers".++class ToParam a where+    toParam :: a -> [(Text, [(Quoting, Text)])]++instance ToParam a => ToParam (Maybe a) where+    toParam Nothing = []+    toParam (Just x) = toParam x++instance ToParam a => ToParam (Set a) where+    toParam s = case S.maxView s of+                     Nothing -> []+                     Just (x, _) -> toParam x++instance ToParam ExDate where+    toParam ExDates {..} = [("VALUE", [(NoQuotes, "DATE")])] <>+                           toParam exDateOther+    toParam ExDateTimes {..} = toParam exDateOther <>+                               toParam (fst <$> S.maxView exDateTimes)++instance ToParam AltRep where+    toParam (AltRep x) = [("ALTREP", [(NeedQuotes, T.pack $ show x)])]++instance ToParam SentBy where+    toParam (SentBy x) = [("SENT-BY", [(NeedQuotes, T.pack $ show x)])]++instance ToParam Dir where+    toParam (Dir x) = [("DIR", [(NeedQuotes, T.pack $ show x)])]++instance ToParam DateTime where+    toParam ZonedDateTime {..} = [("TZID", [(Optional, dateTimeZone)])]+    toParam _ = []++instance ToParam DTEnd where+    toParam DTEndDateTime {..} = toParam dtEndOther <>+                                 toParam dtEndDateTimeValue+    toParam DTEndDate {..}     = [("VALUE", [(NoQuotes, "DATE")])] <>+                                 toParam dtEndOther++instance ToParam Due where+    toParam DueDateTime {..} = toParam dueOther <> toParam dueDateTimeValue+    toParam DueDate {..}     = [("VALUE", [(NoQuotes, "DATE")])] <>+                               toParam dueOther++instance ToParam CN where+    toParam (CN x) = [("CN", [(Optional, x)])]++instance ToParam DTStart where+    toParam DTStartDateTime {..} = toParam dtStartDateTimeValue <>+                                   toParam dtStartOther+    toParam DTStartDate {..} = [("VALUE", [(NoQuotes, "DATE")])] <>+                               toParam dtStartOther++instance ToParam RDate where+    toParam RDateDates {..} = [("VALUE", [(NoQuotes, "DATE")])] <>+                              toParam rDateOther+    toParam RDatePeriods {..} = [("VALUE", [(NoQuotes, "PERIOD")])] <>+                                toParam rDateOther <>+                                toParam (fst <$> S.maxView rDatePeriods)+    toParam RDateDateTimes {..} = toParam rDateDateTimes <> toParam rDateOther++instance ToParam Period where+    toParam (PeriodDates x _) = toParam x+    toParam (PeriodDuration x _) = toParam x++instance ToParam DTStamp where+    toParam DTStamp {..} = toParam dtStampOther++instance ToParam OtherParams where+    toParam (OtherParams l) = fromOP <$> S.toList l+      where fromOP (OtherParam x y) = (CI.original x, (Optional,) <$> y)++instance ToParam Language where+    toParam (Language x) = [("LANGUAGE", [(Optional, CI.original x)])]++instance ToParam TZName where+    toParam TZName {..} = toParam tzNameLanguage <> toParam tzNameOther++instance ToParam x => ToParam [x] where+    toParam = mconcat . map toParam++instance ToParam (Text, [(Quoting, Text)]) where+    toParam = (:[])++instance ToParam RecurrenceId where+    toParam RecurrenceIdDate {..} = [("VALUE", [(NoQuotes, "DATE")])] <>+                                    toParam recurrenceIdOther+    toParam RecurrenceIdDateTime {..} = toParam recurrenceIdDateTime <>+                                        toParam recurrenceIdOther++instance ToParam FBType where+    toParam x | x == def    = []+    toParam Free            = [("FBTYPE", [(NoQuotes, "FREE")])]+    toParam Busy            = [("FBTYPE", [(NoQuotes, "BUSY")])]+    toParam BusyUnavailable = [("FBTYPE", [(NoQuotes, "BUSY-UNAVAILABLE")])]+    toParam BusyTentative   = [("FBTYPE", [(NoQuotes, "BUSY-TENTATIVE")])]+    toParam (FBTypeX x)     = [("FBTYPE", [(Optional, CI.original x)])]++instance ToParam MIMEType where+    toParam m = [("FMTTYPE", [(NoQuotes, T.pack $ showMIMEType m)])]++instance ToParam Attachment where+    toParam UriAttachment {..} = toParam attachFmtType <>+                                 toParam attachOther+    toParam BinaryAttachment {..} = toParam attachFmtType <>+                                    toParam attachOther <>+                                    [ ("VALUE", [(NoQuotes, "BINARY")])+                                    , ("ENCODING", [(NoQuotes, "BASE64")])]++instance ToParam CUType where+    toParam x | x == def = []+    toParam Individual   = [("CUTYPE", [(NoQuotes, "INDIVIDUAL")])]+    toParam Group        = [("CUTYPE", [(NoQuotes, "GROUP")])]+    toParam Resource     = [("CUTYPE", [(NoQuotes, "RESOURCE")])]+    toParam Room         = [("CUTYPE", [(NoQuotes, "ROOM")])]+    toParam Unknown      = [("CUTYPE", [(NoQuotes, "UNKNOWN")])]+    toParam (CUTypeX x)  = [("CUTYPE", [(Optional, CI.original x)])]++instance ToParam Member where+    toParam (Member x) | S.null x = []+    toParam (Member x) = [( "MEMBER"+                          , (NeedQuotes,) . T.pack . show <$> S.toList x)]++instance ToParam Role where+    toParam x | x == def   = []+    toParam Chair          = [("ROLE", [(NoQuotes, "CHAIR")])]+    toParam ReqParticipant = [("ROLE", [(NoQuotes, "REQ-PARTICIPANT")])]+    toParam OptParticipant = [("ROLE", [(NoQuotes, "OPT-PARTICIPANT")])]+    toParam NonParticipant = [("ROLE", [(NoQuotes, "NON-PARTICIPANT")])]+    toParam (RoleX x)      = [("ROLE", [(Optional, CI.original x)])]++instance ToParam PartStat where+    toParam x | x == def        = []+    toParam PartStatNeedsAction = [("PARTSTAT", [(NoQuotes, "NEEDS-ACTION")])]+    toParam Accepted            = [("PARTSTAT", [(NoQuotes, "ACCEPTED")])]+    toParam Declined            = [("PARTSTAT", [(NoQuotes, "DECLINED")])]+    toParam Tentative           = [("PARTSTAT", [(NoQuotes, "TENTATIVE")])]+    toParam Delegated           = [("PARTSTAT", [(NoQuotes, "DELEGATED")])]+    toParam PartStatCompleted   = [("PARTSTAT", [(NoQuotes, "COMPLETED")])]+    toParam InProcess           = [("PARTSTAT", [(NoQuotes, "IN-PROCESS")])]+    toParam (PartStatX x)       = [("PARTSTAT", [(NoQuotes, CI.original x)])]++instance ToParam RelationshipType where+    toParam x | x == def          = []+    toParam Parent                = [("RELTYPE", [(NoQuotes, "PARENT")])]+    toParam Child                 = [("RELTYPE", [(NoQuotes, "CHILD")])]+    toParam Sibling               = [("RELTYPE", [(NoQuotes, "SIBLING")])]+    toParam (RelationshipTypeX x) = [("RELTYPE", [(Optional, CI.original x)])]++instance ToParam RSVP where+    toParam (RSVP False) = []+    toParam (RSVP True)  = [("RSVP", [(NoQuotes, "TRUE")])]++instance ToParam DelTo where+    toParam (DelTo x) | S.null x = []+                      | otherwise = [( "DELEGATED-TO"+                                     , (NeedQuotes,) . T.pack . show+                                                    <$> S.toList x)]++instance ToParam DelFrom where+    toParam (DelFrom x) | S.null x = []+                        | otherwise = [( "DELEGATED-FROM"+                                       , (NeedQuotes,) . T.pack . show+                                             <$> S.toList x)]++instance ToParam Attendee where+    toParam Attendee {..} = toParam attendeeCUType <>+                            toParam (Member attendeeMember) <>+                            toParam attendeeRole <>+                            toParam attendeePartStat <>+                            toParam (RSVP attendeeRSVP) <>+                            toParam (DelTo attendeeDelTo) <>+                            toParam (DelFrom attendeeDelFrom) <>+                            toParam (SentBy <$> attendeeSentBy) <>+                            toParam (CN <$> attendeeCN) <>+                            toParam (Dir <$> attendeeDir) <>+                            toParam attendeeLanguage <>+                            toParam attendeeOther++instance ToParam AlarmTriggerRelationship where+    toParam x | x == def = []+    toParam Start        = [("RELATED", [(NoQuotes, "START")])]+    toParam End          = [("RELATED", [(NoQuotes, "END")])]++instance ToParam Trigger where+    toParam TriggerDuration {..} = toParam triggerOther <>+                                   toParam triggerRelated+    toParam TriggerDateTime {..} = toParam triggerOther <>+                                   [("VALUE", [(NoQuotes, "DATE-TIME")])]++-- }}}+-- {{{ Value printers++printUTCOffset :: Int -> ContentPrinter ()+printUTCOffset n = do case signum n of+                           -1 -> putc '-'+                           _  -> putc '+'+                      out . T.pack $ printf "%02d" t+                      out . T.pack $ printf "%02d" m+                      when (s > 0) . out . T.pack $ printf "%02d" s+  where (m', s) = abs n `divMod` 60+        (t, m)  = m' `divMod` 60++printNWeekday :: Either (Int, Weekday) Weekday -> ContentPrinter ()+printNWeekday (Left (n, w)) = printShow n >> printValue w+printNWeekday (Right x) = printValue x++printShow :: Show a => a -> ContentPrinter ()+printShow = out . T.pack . show++printShowN :: Show a => [a] -> ContentPrinter ()+printShowN = printN printShow++printN :: (a -> ContentPrinter ()) -> [a] -> ContentPrinter ()+printN m (x:xs) = m x >> sequence_ [putc ',' >> m x' | x' <- xs]+printN _ _ = return ()++printShowUpper :: Show a => a -> ContentPrinter ()+printShowUpper = out . T.pack . map toUpper . show++printUTCTime :: Time.UTCTime -> ContentPrinter ()+printUTCTime = out . T.pack . formatTime "%C%y%m%dT%H%M%SZ"++class IsValue a where+    printValue :: a -> ContentPrinter ()++instance IsValue ICalVersion where+    printValue MaxICalVersion {..} = out . T.pack $ Ver.showVersion versionMax+    printValue MinMaxICalVersion {..} = do+        out . T.pack $ Ver.showVersion versionMin+        putc ';'+        out . T.pack $ Ver.showVersion versionMax++instance IsValue Recur where+    printValue Recur {..} = do+        out "FREQ="+        printShowUpper recurFreq+        forM_ recurUntilCount $ \x ->+            case x of+                 Left y -> out ";UNTIL=" >> printValue y+                 Right y -> out ";COUNT=" >> printShow y+        when (recurInterval /= 1) $+            out ";INTERVAL=" >> printShow recurInterval+        unless (null recurBySecond) $+            out ";BYSECOND=" >> printShowN recurBySecond+        unless (null recurByMinute) $+            out ";BYMINUTE=" >> printShowN recurByMinute+        unless (null recurByHour) $+            out ";BYHOUR=" >> printShowN recurByHour+        unless (null recurByDay) $+            out ";BYDAY=" >> printN printNWeekday recurByDay+        unless (null recurByMonthDay) $+            out ";BYMONTHDAY=" >> printShowN recurByMonthDay+        unless (null recurByYearDay) $+            out ";BYYEARDAY=" >> printShowN recurByYearDay+        unless (null recurByWeekNo) $+            out ";BYWEEKNO=" >> printShowN recurByWeekNo+        unless (null recurByMonth) $+            out ";BYMONTH=" >> printShowN recurByMonth+        unless (null recurBySetPos) $+            out ";BYSETPOS=" >> printShowN recurBySetPos+        unless (recurWkSt == Monday) $+            out ";WKST=" >> printValue recurWkSt++instance IsValue TimeTransparency where+    printValue Opaque {}      = out "OPAQUE"+    printValue Transparent {} = out "TRANSPARENT"++instance IsValue DTEnd where+    printValue DTEndDateTime {..} = printValue dtEndDateTimeValue+    printValue DTEndDate {..}     = printValue dtEndDateValue++instance IsValue Due where+    printValue DueDateTime {..} = printValue dueDateTimeValue+    printValue DueDate {..}     = printValue dueDateValue++instance IsValue EventStatus where+    printValue TentativeEvent {} = out "TENTATIVE"+    printValue ConfirmedEvent {} = out "CONFIRMED"+    printValue CancelledEvent {} = out "CANCELLED"++instance IsValue TodoStatus where+    printValue TodoNeedsAction {} = out "NEEDS-ACTION"+    printValue CompletedTodo {}   = out "COMPLETED"+    printValue InProcessTodo {}   = out "IN-PROCESS"+    printValue CancelledTodo {}   = out "CANCELLED"++instance IsValue JournalStatus where+    printValue DraftJournal {}     = out "DRAFT"+    printValue FinalJournal {}     = out "FINAL"+    printValue CancelledJournal {} = out "CANCELLED"++instance IsValue ClassValue where+    printValue (ClassValueX x) = out $ CI.original x+    printValue x = printShowUpper x++instance IsValue Weekday where+    printValue Sunday    = out "SU"+    printValue Monday    = out "MO"+    printValue Tuesday   = out "TU"+    printValue Wednesday = out "WE"+    printValue Thursday  = out "TH"+    printValue Friday    = out "FR"+    printValue Saturday  = out "SA"++instance IsValue Date where+    printValue Date {..} = out . T.pack $ formatTime "%C%y%m%d" dateValue++instance IsValue DateTime where+    printValue FloatingDateTime {..} =+        out . T.pack $ formatTime "%C%y%m%dT%H%M%S" dateTimeFloating+    printValue UTCDateTime {..} = printUTCTime dateTimeUTC+    printValue ZonedDateTime {..} =+        out . T.pack $ formatTime "%C%y%m%dT%H%M%S" dateTimeFloating++instance IsValue (Either Date DateTime) where+    printValue (Left x) = printValue x+    printValue (Right x) = printValue x++instance IsValue DTStamp where+    printValue DTStamp {..} = printUTCTime dtStampValue++instance IsValue DTStart where+    printValue DTStartDateTime {..} = printValue dtStartDateTimeValue+    printValue DTStartDate {..} = printValue dtStartDateValue++instance IsValue URI.URI where+    printValue = printShow++instance IsValue Duration where+    printValue DurationDate {..} = do+        when (durSign == Negative) $ putc '-'+        putc 'P'+        printShow durDay    >> putc 'D'+        putc 'T'+        printShow durHour   >> putc 'H'+        printShow durMinute >> putc 'M'+        printShow durSecond >> putc 'S'+    printValue DurationTime {..} = do+        when (durSign == Negative) $ putc '-'+        out "PT"+        printShow durHour   >> putc 'H'+        printShow durMinute >> putc 'M'+        printShow durSecond >> putc 'S'+    printValue DurationWeek {..} = do+        when (durSign == Negative) $ putc '-'+        out "P"+        printShow durWeek >> putc 'W'++instance IsValue RecurrenceId where+    printValue RecurrenceIdDate {..}     = printValue recurrenceIdDate+    printValue RecurrenceIdDateTime {..} = printValue recurrenceIdDateTime++instance IsValue Period where+    printValue (PeriodDates f t) = printValue f >> putc '/' >> printValue t+    printValue (PeriodDuration f d) = printValue f >> putc '/' >> printValue d++instance IsValue UTCPeriod where+    printValue (UTCPeriodDates f t) = printUTCTime f >> putc '/' >> printUTCTime t+    printValue (UTCPeriodDuration f d) = printUTCTime f >> putc '/' >> printValue d++instance IsValue RDate where+    printValue RDateDates {..}     = printN printValue $ S.toList rDateDates+    printValue RDateDateTimes {..} = printN printValue $ S.toList rDateDateTimes+    printValue RDatePeriods {..}   = printN printValue $ S.toList rDatePeriods++instance IsValue Attachment where+    printValue UriAttachment {..} = printShow attachUri+    printValue BinaryAttachment {..} = bytestring $ B64.encode attachContent++-- }}}+-- {{{ Lib++ln :: ContentPrinter () -> ContentPrinter ()+ln x = x >> newline++param :: (Text, [(Quoting, Text)]) -> ContentPrinter ()+param (n, xs) = putc ';' >> out n >> putc '=' >> paramVals xs++paramVals :: [(Quoting, Text)] -> ContentPrinter ()+paramVals (x:xs) = paramVal x >> sequence_ [putc ',' >> paramVal x' | x' <- xs]+paramVals _ = return ()++paramVal :: (Quoting, Text) -> ContentPrinter ()+paramVal (NeedQuotes, t) = putc '"' >> out t >> putc '"'+paramVal (NoQuotes, t) = out t+paramVal (_, t) = paramVal (NeedQuotes, t)++texts :: [Text] -> ContentPrinter ()+texts (x:xs) = text x >> sequence_ [putc ',' >> text x' | x' <- xs]+texts _ = return ()++text :: Text -> ContentPrinter ()+text t = case T.uncons t of+              Just (';', r)  -> out "\\;"  >> text r+              Just ('\n', r) -> out "\\n"  >> text r+              Just (',', r)  -> out "\\,"  >> text r+              Just ('\\', r) -> out "\\\\" >> text r+              Just (c, r)    -> putc c     >> text r+              Nothing        -> return ()++bytestring :: ByteString -> ContentPrinter ()+bytestring = BS.foldl' (\m c -> m >> putc8 c) (return ())++out :: Text -> ContentPrinter ()+out t = case T.uncons t of+             Just (c, r) -> putc c >> out r+             Nothing -> return ()++putc :: Char -> ContentPrinter ()+putc c = do x <- get+            (b, clen) <- asks (efChar2Bu &&& efChar2Len)+            let cl = clen c+            when (x + cl > 75) foldLine+            tell $ b c+            modify (+ cl)++putc8 :: Char -> ContentPrinter ()+putc8 c = do x <- get+             when (x >= 75) foldLine+             tell $ Bu.char8 c+             modify (+ 1)++foldLine :: ContentPrinter ()+foldLine = tell (Bu.byteString "\r\n ") >> put 1++newline :: ContentPrinter ()+newline = tell (Bu.byteString "\r\n") >> put 0++-- | Output a whole line. Must be less than 75 bytes.+line :: ByteString -> ContentPrinter ()+line b = tell (Bu.lazyByteString b) >> newline++formatTime :: FormatTime t => String -> t -> String+formatTime = Time.formatTime L.defaultTimeLocale++-- }}}

@@ -0,0 +1,806 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+-- | ICalendar types, based on RFC5545.+module Text.ICalendar.Types+    ( module Text.ICalendar.Types+    ) where++import Codec.MIME.Type (MIMEType)+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.CaseInsensitive (CI)+import Data.Default+import Data.Set (Set)+import Data.Text.Lazy (Text)+import Data.Time+import Data.Typeable (Typeable)+import Data.Version (Version(..))+import Network.URI (URI)++-- | Language.+newtype Language = Language (CI Text) -- TODO: RFC5646 types and parser.+                   deriving (Eq, Show, Ord, Typeable)++type CalAddress = URI++-- | One other parameter, either x-param or iana-param.+data OtherParam = OtherParam (CI Text) [Text]+                  deriving (Show, Eq, Ord, Typeable)++-- | Other parameters, either x-param or other iana-param.+data OtherParams = OtherParams (Set OtherParam)+                   deriving (Show, Eq, Ord, Typeable)++instance Default OtherParams where+    def = OtherParams def++-- | VCalendar component. 3.4.+data VCalendar = VCalendar+    { vcProdId     :: ProdId+    , vcVersion    :: ICalVersion+    , vcScale      :: Scale+    , vcMethod     :: Maybe Method+    , vcOther      :: Set OtherProperty+    , vcTimeZones  :: Set VTimeZone+    , vcEvents     :: Set VEvent+    , vcTodos      :: Set VTodo+    , vcJournals   :: Set VJournal+    , vcFreeBusys  :: Set VFreeBusy+    , vcOtherComps :: Set VOther+    } deriving (Show, Eq, Ord, Typeable)++instance Default VCalendar where+    def = VCalendar (ProdId "-//haskell.org/NONSGML iCalendar-0.1//EN" def)+                    (MaxICalVersion (Version [2,0] []) def)+                    def Nothing def def def def def def def++-- | Product Identifier. 3.7.3.+data ProdId = ProdId+    { prodIdValue :: Text+    , prodIdOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Version. 3.7.4.+data ICalVersion+    = MaxICalVersion+    { versionMax   :: Version+    , versionOther :: OtherParams+    }+    | MinMaxICalVersion+    { versionMax   :: Version+    , versionMin   :: Version+    , versionOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Calendar Scale. 3.7.1.+data Scale = Scale+    { scaleValue :: CI Text+    , scaleOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++instance Default Scale where+    def = Scale "GREGORIAN" def++-- | Method. 3.7.2.+data Method = Method+    { methodValue :: CI Text -- TODO: iTIP, RFC5546+    , methodOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Event Component. 3.6.1.+data VEvent = VEvent+    { veDTStamp       :: DTStamp+    , veUID           :: UID+    , veClass         :: Class -- ^ 'def' = 'Public'+    , veDTStart       :: Maybe DTStart+    , veCreated       :: Maybe Created+    , veDescription   :: Maybe Description+    , veGeo           :: Maybe Geo+    , veLastMod       :: Maybe LastModified+    , veLocation      :: Maybe Location+    , veOrganizer     :: Maybe Organizer+    , vePriority      :: Priority -- ^ 'def' = 0+    , veSeq           :: Sequence -- ^ 'def' = 0+    , veStatus        :: Maybe EventStatus+    , veSummary       :: Maybe Summary+    , veTransp        :: TimeTransparency -- ^ 'def' = 'Opaque'+    , veUrl           :: Maybe URL+    , veRecurId       :: Maybe RecurrenceId+    , veRRule         :: Set RRule+    , veDTEndDuration :: Maybe (Either DTEnd DurationProp)+    , veAttach        :: Set Attachment+    , veAttendee      :: Set Attendee+    , veCategories    :: Set Categories+    , veComment       :: Set Comment+    , veContact       :: Set Contact+    , veExDate        :: Set ExDate+    , veRStatus       :: Set RequestStatus+    , veRelated       :: Set RelatedTo+    , veResources     :: Set Resources+    , veRDate         :: Set RDate+    , veAlarms        :: Set VAlarm+    , veOther         :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | To-Do Component. 3.6.2+data VTodo = VTodo+    { vtDTStamp       :: DTStamp+    , vtUID           :: UID+    , vtClass         :: Class -- ^ 'def' = 'Public'+    , vtCompleted     :: Maybe Completed+    , vtCreated       :: Maybe Created+    , vtDescription   :: Maybe Description+    , vtDTStart       :: Maybe DTStart+    , vtGeo           :: Maybe Geo+    , vtLastMod       :: Maybe LastModified+    , vtLocation      :: Maybe Location+    , vtOrganizer     :: Maybe Organizer+    , vtPercent       :: Maybe PercentComplete+    , vtPriority      :: Priority -- ^ 'def' = 0+    , vtRecurId       :: Maybe RecurrenceId+    , vtSeq           :: Sequence -- ^ 'def' = 0+    , vtStatus        :: Maybe TodoStatus+    , vtSummary       :: Maybe Summary+    , vtUrl           :: Maybe URL+    , vtRRule         :: Set RRule+    , vtDueDuration   :: Maybe (Either Due DurationProp)+    , vtAttach        :: Set Attachment+    , vtAttendee      :: Set Attendee+    , vtCategories    :: Set Categories+    , vtComment       :: Set Comment+    , vtContact       :: Set Contact+    , vtExDate        :: Set ExDate+    , vtRStatus       :: Set RequestStatus+    , vtRelated       :: Set RelatedTo+    , vtResources     :: Set Resources+    , vtRDate         :: Set RDate+    , vtAlarms        :: Set VAlarm+    , vtOther         :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Journal Component. 3.6.3+data VJournal = VJournal+    { vjDTStamp       :: DTStamp+    , vjUID           :: UID+    , vjClass         :: Class -- ^ 'def' = 'Public'+    , vjCreated       :: Maybe Created+    , vjDTStart       :: Maybe DTStart+    , vjLastMod       :: Maybe LastModified+    , vjOrganizer     :: Maybe Organizer+    , vjRecurId       :: Maybe RecurrenceId+    , vjSeq           :: Sequence -- ^ 'def' = 0+    , vjStatus        :: Maybe JournalStatus+    , vjSummary       :: Maybe Summary+    , vjUrl           :: Maybe URL+    , vjRRule         :: Set RRule+    , vjAttach        :: Set Attachment+    , vjAttendee      :: Set Attendee+    , vjCategories    :: Set Categories+    , vjComment       :: Set Comment+    , vjContact       :: Set Contact+    , vjDescription   :: Set Description+    , vjExDate        :: Set ExDate+    , vjRelated       :: Set RelatedTo+    , vjRDate         :: Set RDate+    , vjRStatus       :: Set RequestStatus+    , vjOther         :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Free/Busy Component. 3.6.4+data VFreeBusy = VFreeBusy+    { vfbDTStamp       :: DTStamp+    , vfbUID           :: UID+    , vfbContact       :: Maybe Contact+    , vfbDTStart       :: Maybe DTStart+    , vfbDTEnd         :: Maybe DTEnd+    , vfbOrganizer     :: Maybe Organizer+    , vfbUrl           :: Maybe URL+    , vfbAttendee      :: Set Attendee+    , vfbComment       :: Set Comment+    , vfbFreeBusy      :: Set FreeBusy+    , vfbRStatus       :: Set RequestStatus+    , vfbOther         :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Time Zone Component. 3.6.5.+data VTimeZone = VTimeZone+    { vtzId            :: TZID+    , vtzLastMod       :: Maybe LastModified+    , vtzUrl           :: Maybe TZUrl+    , vtzStandardC     :: Set TZProp+    , vtzDaylightC     :: Set TZProp+    , vtzOther         :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Time zone property, also 3.6.5.+data TZProp = TZProp+    { tzpDTStart      :: DTStart+    , tzpTZOffsetTo   :: UTCOffset+    , tzpTZOffsetFrom :: UTCOffset+    , tzpRRule        :: Set RRule -- SHOULD NOT have multiple RRules.+    , tzpComment      :: Set Comment+    , tzpRDate        :: Set RDate+    , tzpTZName       :: Set TZName+    , tzpOther        :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | VAlarm component. 3.6.6.+data VAlarm+    = VAlarmAudio+    { vaTrigger     :: Trigger+    , vaRepeat      :: Repeat -- ^ 'def' = 0+    , vaDuration    :: Maybe DurationProp+    , vaAudioAttach :: Maybe Attachment+    , vaOther       :: Set OtherProperty+    , vaActionOther :: OtherParams+    }+    | VAlarmDisplay+    { vaDescription :: Description+    , vaTrigger     :: Trigger+    , vaRepeat      :: Repeat+    , vaDuration    :: Maybe DurationProp+    , vaOther       :: Set OtherProperty+    , vaActionOther :: OtherParams+    }+    | VAlarmEmail+    { vaDescription :: Description+    , vaTrigger     :: Trigger+    , vaSummary     :: Summary+    , vaAttendee    :: Set Attendee+    , vaRepeat      :: Repeat+    , vaDuration    :: Maybe DurationProp+    , vaMailAttach  :: Set Attachment+    , vaOther       :: Set OtherProperty+    , vaActionOther :: OtherParams+    }+    | VAlarmX+    { vaAction      :: CI Text+    , vaTrigger     :: Trigger+    , vaActionOther :: OtherParams+    , vaOther       :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Any other component not recognized.+data VOther = VOther+    { voName :: CI Text+    , voProps :: Set OtherProperty+    } deriving (Show, Eq, Ord, Typeable)++-- | Attachment. 3.8.1.1.+data Attachment+    = UriAttachment+    { attachFmtType :: Maybe MIMEType+    , attachUri     :: URI+    , attachOther   :: OtherParams+    }+    | BinaryAttachment+    { attachFmtType :: Maybe MIMEType+    , attachContent :: ByteString+    , attachOther   :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Categories. 3.8.1.2.+data Categories = Categories+    { categoriesValues   :: Set Text+    , categoriesLanguage :: Maybe Language+    , categoriesOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Classification. 3.8.1.3.+data Class = Class+    { classValue :: ClassValue+    , classOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++instance Default Class where+    def = Class def def++-- | Classification value. 3.8.1.3.+-- Unrecognized ClassValueX MUST be treated as Private.+data ClassValue+    = Public+    | Private+    | Confidential+    | ClassValueX (CI Text)+      deriving (Show, Eq, Ord, Typeable)++instance Default ClassValue where+    def = Public++-- | Date-Time Completed. 3.8.2.1.+data Completed = Completed+    { completedValue :: DateTime+    , completedOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Comment. 3.8.1.4.+data Comment = Comment+    { commentValue    :: Text+    , commentAltRep   :: Maybe URI+    , commentLanguage :: Maybe Language+    , commentOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Description. 3.8.1.5.+data Description = Description+    { descriptionValue    :: Text+    , descriptionAltRep   :: Maybe URI+    , descriptionLanguage :: Maybe Language+    , descriptionOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Geographic Position. 3.8.1.6.+data Geo = Geo+    { geoLat   :: Float+    , geoLong  :: Float+    , geoOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Location. 3.8.1.7.+data Location = Location+    { locationValue    :: Text+    , locationAltRep   :: Maybe URI+    , locationLanguage :: Maybe Language+    , locationOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Percent complete. 3.8.1.8.+data PercentComplete = PercentComplete+    { percentCompleteValue :: Int+    , percentCompleteOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Priority. 3.8.1.9.+data Priority = Priority+    { priorityValue :: Int+    , priorityOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++instance Default Priority where+    def = Priority 0 def++-- | Resources. 3.8.1.10.+data Resources = Resources+    { resourcesValue    :: Set Text+    , resourcesAltRep   :: Maybe URI+    , resourcesLanguage :: Maybe Language+    , resourcesOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Status, but only for Events. 3.8.1.11.+data EventStatus+    = TentativeEvent { eventStatusOther :: OtherParams }+    | ConfirmedEvent { eventStatusOther :: OtherParams }+    | CancelledEvent { eventStatusOther :: OtherParams }+      deriving (Show, Eq, Ord, Typeable)++-- | Status, but only for TODOs. 3.8.1.11.+data TodoStatus+    = TodoNeedsAction { todoStatusOther :: OtherParams }+    | CompletedTodo   { todoStatusOther :: OtherParams }+    | InProcessTodo   { todoStatusOther :: OtherParams }+    | CancelledTodo   { todoStatusOther :: OtherParams }+      deriving (Show, Eq, Ord, Typeable)++-- | Status, but only for Journals. 3.8.1.11.+data JournalStatus+    = DraftJournal     { journalStatusOther :: OtherParams }+    | FinalJournal     { journalStatusOther :: OtherParams }+    | CancelledJournal { journalStatusOther :: OtherParams }+      deriving (Show, Eq, Ord, Typeable)++-- | Summary. 3.8.1.12.+data Summary = Summary+    { summaryValue    :: Text+    , summaryAltRep   :: Maybe URI+    , summaryLanguage :: Maybe Language+    , summaryOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Date. 3.3.4+data Date = Date+    { dateValue :: Day+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time value. 3.3.5.+data DateTime+    = FloatingDateTime+    { dateTimeFloating :: LocalTime+    }+    | UTCDateTime+    { dateTimeUTC      :: UTCTime+    }+    | ZonedDateTime+    { dateTimeFloating :: LocalTime+    , dateTimeZone     :: Text+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time End. 3.8.2.2.+data DTEnd+    = DTEndDateTime+    { dtEndDateTimeValue :: DateTime+    , dtEndOther         :: OtherParams+    }+    | DTEndDate+    { dtEndDateValue     :: Date+    , dtEndOther         :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time Due. 3.8.2.3.+data Due+    = DueDateTime+    { dueDateTimeValue :: DateTime+    , dueOther         :: OtherParams+    }+    | DueDate+    { dueDateValue     :: Date+    , dueOther         :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time Start. 3.8.2.4.+data DTStart+    = DTStartDateTime+    { dtStartDateTimeValue :: DateTime+    , dtStartOther         :: OtherParams+    }+    | DTStartDate+    { dtStartDateValue     :: Date+    , dtStartOther         :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Duration value. 3.3.6.+data Duration -- TODO(?): Convert to DiffTime?+    = DurationDate+    { durSign   :: Sign -- ^ 'def' = 'Positive'+    , durDay    :: Int+    , durHour   :: Int+    , durMinute :: Int+    , durSecond :: Int+    }+    | DurationTime+    { durSign   :: Sign+    , durHour   :: Int+    , durMinute :: Int+    , durSecond :: Int+    }+    | DurationWeek+    { durSign   :: Sign+    , durWeek   :: Int+    } deriving (Show, Eq, Ord, Typeable)++-- | Sign.+data Sign = Positive | Negative+            deriving (Show, Eq, Ord, Typeable)++instance Default Sign where+    def = Positive++-- | Duration property. 3.8.2.5.+data DurationProp = DurationProp+    { durationValue :: Duration+    , durationOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++data FreeBusy = FreeBusy+    { freeBusyType    :: FBType+    , freeBusyPeriods :: Set UTCPeriod+    , freeBusyOther   :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Period of time. 3.3.9.+data Period+    = PeriodDates    DateTime DateTime+    | PeriodDuration DateTime Duration+      deriving (Show, Eq, Ord, Typeable)++-- | Period of time which must be UTC, as in FreeBusy. 3.3.9.+data UTCPeriod+    = UTCPeriodDates    UTCTime UTCTime+    | UTCPeriodDuration UTCTime Duration+      deriving (Show, Eq, Ord, Typeable)++-- | Free/Busy Time Type. 3.2.9.+-- Unrecognized FBTypeX MUST be treated as Busy.+data FBType+    = Free+    | Busy+    | BusyUnavailable+    | BusyTentative+    | FBTypeX (CI Text)+      deriving (Show, Eq, Ord, Typeable)++instance Default FBType where+    def = Busy++-- | Time Transparency. 3.8.2.7.+data TimeTransparency+    = Opaque      { timeTransparencyOther :: OtherParams }+    | Transparent { timeTransparencyOther :: OtherParams }+      deriving (Show, Eq, Ord, Typeable)++instance Default TimeTransparency where+    def = Opaque def++-- | Time Zone Identifier. 3.8.3.1.+data TZID = TZID+    { tzidValue  :: Text+    , tzidGlobal :: Bool+    , tzidOther  :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Time Zone Name. 3.8.3.2.+data TZName = TZName+    { tzNameValue    :: Text+    , tzNameLanguage :: Maybe Language+    , tzNameOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | UTC Offset. 3.3.14, 3.8.3.4, and 3.8.3.3. (unified-ish)+data UTCOffset = UTCOffset+    { utcOffsetValue :: Int -- ^ Number of seconds away from UTC+    , utcOffsetOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Time Zone URL. 3.8.3.5.+data TZUrl = TZUrl+    { tzUrlValue :: URI+    , tzUrlOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Attendee. 3.8.4.1.+data Attendee = Attendee+    { attendeeValue    :: CalAddress+    , attendeeCUType   :: CUType -- ^ 'def' = 'Individual'+    , attendeeMember   :: Set CalAddress+    , attendeeRole     :: Role -- ^ 'def' = 'ReqParticipant'+    , attendeePartStat :: PartStat -- ^ 'def' = 'PartStatNeedsAction'+    , attendeeRSVP     :: Bool+    , attendeeDelTo    :: Set CalAddress+    , attendeeDelFrom  :: Set CalAddress+    , attendeeSentBy   :: Maybe CalAddress+    , attendeeCN       :: Maybe Text+    , attendeeDir      :: Maybe URI+    , attendeeLanguage :: Maybe Language+    , attendeeOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Calendar User Type. 3.2.3.+-- Unrecognized CUTypeX MUST be treated as Unknown.+data CUType+    = Individual+    | Group+    | Resource+    | Room+    | Unknown+    | CUTypeX (CI Text)+      deriving (Show, Eq, Ord, Typeable)++instance Default CUType where+    def = Individual++-- | Role. 3.2.16.+data Role = Chair+          | ReqParticipant+          | OptParticipant+          | NonParticipant+          | RoleX (CI Text)+            deriving (Show, Eq, Ord, Typeable)++instance Default Role where+    def = ReqParticipant++-- | Participation Status. 3.2.12.+data PartStat -- Splitting requires splitting attendee too...+    = PartStatNeedsAction+    | Accepted+    | Declined+    | Tentative+    | Delegated+    | PartStatCompleted+    | InProcess+    | PartStatX (CI Text)+      deriving (Show, Eq, Ord, Typeable)++instance Default PartStat where+    def = PartStatNeedsAction++-- | Contact. 3.8.4.2.+data Contact = Contact+    { contactValue    :: Text+    , contactAltRep   :: Maybe URI+    , contactLanguage :: Maybe Language+    , contactOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Organizer. 3.8.4.3.+-- TODO: CAL-ADDRESS-related properties.+data Organizer = Organizer+    { organizerValue    :: CalAddress+    , organizerCN       :: Maybe Text+    , organizerDir      :: Maybe URI+    , organizerSentBy   :: Maybe CalAddress+    , organizerLanguage :: Maybe Language+    , organizerOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Recurrence ID. 3.8.4.4.+data RecurrenceId+    = RecurrenceIdDate+    { recurrenceIdDate  :: Date+    , recurrenceIdRange :: Range -- ^ 'def' = 'ThisAndFuture'+    , recurrenceIdOther :: OtherParams+    }+    | RecurrenceIdDateTime+    { recurrenceIdDateTime :: DateTime+    , recurrenceIdRange    :: Range -- ^ 'def' = 'ThisAndFuture'+    , recurrenceIdOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Recurrence Identifier Range. 3.2.13+data Range = ThisAndFuture | ThisAndPrior+             deriving (Show, Eq, Ord, Typeable)++instance Default Range where+    def = ThisAndFuture++-- | Related To. 3.8.4.5.+data RelatedTo = RelatedTo+    { relatedToValue :: Text+    , relatedToType  :: RelationshipType+    , relatedToOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Relationship Type. 3.2.15.+-- Unrecognized RelationshipTypeX values MUST be treated as Parent.+data RelationshipType = Parent | Child | Sibling | RelationshipTypeX (CI Text)+                        deriving (Show, Eq, Ord, Typeable)++instance Default RelationshipType where+    def = Parent++-- | Uniform Resource Locator. 3.8.4.6.+data URL = URL+    { urlValue :: URI+    , urlOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Unique Identifier. 3.8.4.7.+data UID = UID+    { uidValue :: Text+    , uidOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Exception Date-Times. 3.8.5.1.+data ExDate+    = ExDates+    { exDates     :: Set Date+    , exDateOther :: OtherParams+    }+    | ExDateTimes+    { exDateTimes :: Set DateTime+    , exDateOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Recurrence Date-Times. 3.8.5.2.+data RDate+    = RDateDates+    { rDateDates :: Set Date+    , rDateOther :: OtherParams+    }+    | RDateDateTimes+    { rDateDateTimes :: Set DateTime+    , rDateOther     :: OtherParams+    }+    | RDatePeriods+    { rDatePeriods :: Set Period+    , rDateOther   :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Frequency in recurrences. 3.3.10.+data Frequency+    = Secondly+    | Minutely+    | Hourly+    | Daily+    | Weekly+    | Monthly+    | Yearly+      deriving (Show, Eq, Ord, Typeable)++-- | Weekday, in recurrences. 3.3.10.+data Weekday = Sunday | Monday | Tuesday | Wednesday | Thursday+                      | Friday | Saturday+               deriving (Show, Eq, Ord, Bounded, Enum, Typeable)++-- | Recur value. 3.3.10.+data Recur = Recur+    { recurFreq       :: Frequency+    , recurUntilCount :: Maybe (Either (Either Date DateTime) Int)+    , recurInterval   :: Int+    , recurBySecond   :: [Int]+    , recurByMinute   :: [Int]+    , recurByHour     :: [Int]+    , recurByDay      :: [Either (Int, Weekday) Weekday]+    , recurByMonthDay :: [Int]+    , recurByYearDay  :: [Int]+    , recurByWeekNo   :: [Int]+    , recurByMonth    :: [Int]+    , recurBySetPos   :: [Int]+    , recurWkSt       :: Weekday+    } deriving (Show, Eq, Ord, Typeable)++-- | Recurrence Rule. 3.8.5.3.+data RRule = RRule+    { rRuleValue :: Recur+    , rRuleOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Repeat count. 3.8.6.2.+data Repeat = Repeat+    { repeatValue :: Integer+    , repeatOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++instance Default Repeat where+    def = Repeat 0 def++-- | Alarm Trigger Relationship. 3.2.14.+data AlarmTriggerRelationship = Start | End+                                deriving (Show, Eq, Ord, Typeable)++instance Default AlarmTriggerRelationship where+    def = Start++-- | Trigger. 3.8.6.3.+data Trigger+    = TriggerDuration+    { triggerDuration :: Duration+    , triggerRelated  :: AlarmTriggerRelationship -- ^ 'def' = 'Start'+    , triggerOther    :: OtherParams+    }+    | TriggerDateTime+    { triggerDateTime :: UTCTime+    , triggerOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time Created. 3.8.7.1.+data Created = Created+    { createdValue :: DateTime+    , createdOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Date-Time Stamp. 3.8.7.2.+data DTStamp = DTStamp+    { dtStampValue :: UTCTime+    , dtStampOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Last Modified. 3.8.7.3.+data LastModified = LastModified+    { lastModifiedValue :: UTCTime+    , lastModifiedOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Sequence number. 3.8.7.4.+data Sequence = Sequence+    { sequenceValue :: Integer+    , sequenceOther :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++instance Default Sequence where+    def = Sequence 0 def++-- | Request Status. 3.8.8.3.+data RequestStatus = RequestStatus+    { requestStatusCode     :: [Int]+    , requestStatusDesc     :: Text+    , requestStatusLanguage :: Maybe Language+    , requestStatusExt      :: Maybe Text+    , requestStatusOther    :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)++-- | Any other property.+data OtherProperty = OtherProperty+    { otherName   :: CI Text+    , otherValue  :: ByteString+    , otherParams :: OtherParams+    } deriving (Show, Eq, Ord, Typeable)

@@ -1,42 +1,38 @@-Name:            iCalendar-Version:         0.0.1-Synopsis:        Parser for iCalendar format (RFC2445)--Description: Parser for the iCalendar format (version 2.0, RFC2445).-             .  -             Features:-             .-               * Unfolds folded lines (see RFC)-             . -               * Supports all IANA iCalendar tokens-             .-             /Warning!/  This is version 0.0, important things are missing-             .   -               * Property and parameter values are not parsed, but kept as in the file.-             . -               * There are no restrictions on the properties components can have.-             .  -               * Line unfolding causes error messages to report the wrong line.-             . -             This package is meant to grow to a full-fledged data definition, printer and-             parser for the iCalendar format.  But that will probably take some time.  So,-             if you've come here because you need this, please e-mail me (Eelco Lempsink).--Category:        Text-License:         BSD3-License-file:    LICENSE-Copyright:       (c) Tupil-Author:          Eelco Lempsink <eml+hackage@tupil.com>-Maintainer:      Clint Adams <clint@debian.org>-Build-Type:      Simple-Cabal-Version:   >=1.10--Library-  build-depends:   base >= 4 && < 5-                 , parsec >=3 && <4-  exposed-modules: Text.ICalendar.Parser-  default-language: Haskell98+name:                iCalendar+version:             0.1+synopsis:            iCalendar data types, parser, and printer.+description:         Data definitions, parsing and printing of the iCalendar+                     format (RFC5545).+homepage:            http://github.com/tingtun/iCalendar+bug-reports:         http://github.com/tingtun/iCalendar/issues+license:             BSD3+license-file:        LICENSE+author:              Christian Rødli Amble+maintainer:          cra+code@cra.no+copyright:           (c) Tingtun+stability:           experimental+category:            Text+build-type:          Simple+tested-with:         GHC==7.6.1+cabal-version:       >=1.8  source-repository head-  type:     git-  location: git://git.debian.org/users/clint/iCalendar-Haskell.git+  type:              git+  location:          git://github.com/tingtun/iCalendar.git++library+  exposed-modules:     Text.ICalendar.Types+                     , Text.ICalendar.Parser+                     , Text.ICalendar.Printer+                     , Text.ICalendar+  other-modules:       Text.ICalendar.Parser.Common+                     , Text.ICalendar.Parser.Components+                     , Text.ICalendar.Parser.Content+                     , Text.ICalendar.Parser.Parameters+                     , Text.ICalendar.Parser.Properties+  build-depends:       base ==4.*, time ==1.4.*, data-default >=0.3+                     , case-insensitive ==0.4.*, network ==2.4.*+                     , bytestring >=0.10 && < 0.11, parsec ==3.1.*+                     , text, containers >= 0.4 && < 0.6, mime ==0.3.*+                     , mtl ==2.1.*, old-locale, base64-bytestring ==1.0.*+  ghc-options:       -Wall