{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
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.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import Data.Semigroup as Sem
import Data.Text.Lazy (Text, pack)
import Data.Time
import Data.Typeable (Typeable)
import Data.Version (Version (..), showVersion)
import Network.URI (URI)
import Paths_iCalendar (version)
newtype Language = Language (CI Text)
deriving (Eq, Show, Ord, Typeable)
type CalAddress = URI
data OtherParam = OtherParam (CI Text) [Text]
deriving (Show, Eq, Ord, Typeable)
data OtherParams = OtherParams (Set OtherParam)
deriving (Show, Eq, Ord, Typeable)
instance Default OtherParams where
def = OtherParams def
data VCalendar = VCalendar
{ vcProdId :: ProdId
, vcVersion :: ICalVersion
, vcScale :: Scale
, vcMethod :: Maybe Method
, vcOther :: Set OtherProperty
, vcTimeZones :: Map Text VTimeZone
, vcEvents :: Map (Text, Maybe (Either Date DateTime)) VEvent
, vcTodos :: Map (Text, Maybe (Either Date DateTime)) VTodo
, vcJournals :: Map (Text, Maybe (Either Date DateTime)) VJournal
, vcFreeBusys :: Map Text VFreeBusy
, vcOtherComps :: Set VOther
} deriving (Show, Eq, Ord, Typeable)
instance Default VCalendar where
def = VCalendar (ProdId ("-//haskell.org/NONSGML iCalendar-" <>
pack (showVersion version) <> "//EN") def)
(MaxICalVersion (Version [2,0] []) def)
def Nothing def def def def def def def
instance Sem.Semigroup VCalendar where
a <> b = VCalendar { vcProdId = vcProdId a
, vcVersion = vcVersion a
, vcScale = vcScale a
, vcMethod = vcMethod a
, vcOther = vcOther a <> vcOther b
, vcTimeZones = merge tz (vcTimeZones a)
(vcTimeZones b)
, vcEvents = merge ev (vcEvents a) (vcEvents b)
, vcTodos = merge td (vcTodos a) (vcTodos b)
, vcJournals = merge jo (vcJournals a)
(vcJournals b)
, vcFreeBusys = merge fb (vcFreeBusys a)
(vcFreeBusys b)
, vcOtherComps = vcOtherComps a <> vcOtherComps b
}
where merge f = M.mergeWithKey (((Just .) .) . const f) id id
tz c d = if vtzLastMod c >= vtzLastMod d then c else d
ev c d = if (veSeq c, veDTStamp c) >= (veSeq d, veDTStamp d)
then c else d
td c d = if (vtSeq c, vtDTStamp c) >= (vtSeq d, vtDTStamp d)
then c else d
jo c d = if (vjSeq c, vjDTStamp c) >= (vjSeq d, vjDTStamp d)
then c else d
fb c d = if vfbDTStamp c >= vfbDTStamp d then c else d
instance Monoid VCalendar where
mempty = def
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
data ProdId = ProdId
{ prodIdValue :: Text
, prodIdOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data ICalVersion
= MaxICalVersion
{ versionMax :: Version
, versionOther :: OtherParams
}
| MinMaxICalVersion
{ versionMax :: Version
, versionMin :: Version
, versionOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Scale = Scale
{ scaleValue :: CI Text
, scaleOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
instance Default Scale where
def = Scale "GREGORIAN" def
data Method = Method
{ methodValue :: CI Text
, methodOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data VEvent = VEvent
{ veDTStamp :: DTStamp
, veUID :: UID
, veClass :: Class
, veDTStart :: Maybe DTStart
, veCreated :: Maybe Created
, veDescription :: Maybe Description
, veGeo :: Maybe Geo
, veLastMod :: Maybe LastModified
, veLocation :: Maybe Location
, veOrganizer :: Maybe Organizer
, vePriority :: Priority
, veSeq :: Sequence
, veStatus :: Maybe EventStatus
, veSummary :: Maybe Summary
, veTransp :: TimeTransparency
, veUrl :: Maybe URL
, veRecurId :: Maybe RecurrenceId
, veRRule :: Set RRule
, veDTEndDuration :: Maybe (Either DTEnd DurationProp)
, veAttach :: Set Attachment
, veAttendee :: Set Attendee
, veCategories :: Set Categories
, veComment :: Set Comment
, veContact :: Set Contact
, veExDate :: Set ExDate
, veRStatus :: Set RequestStatus
, veRelated :: Set RelatedTo
, veResources :: Set Resources
, veRDate :: Set RDate
, veAlarms :: Set VAlarm
, veOther :: Set OtherProperty
} deriving (Show, Eq, Ord, Typeable)
data VTodo = VTodo
{ vtDTStamp :: DTStamp
, vtUID :: UID
, vtClass :: Class
, vtCompleted :: Maybe Completed
, vtCreated :: Maybe Created
, vtDescription :: Maybe Description
, vtDTStart :: Maybe DTStart
, vtGeo :: Maybe Geo
, vtLastMod :: Maybe LastModified
, vtLocation :: Maybe Location
, vtOrganizer :: Maybe Organizer
, vtPercent :: Maybe PercentComplete
, vtPriority :: Priority
, vtRecurId :: Maybe RecurrenceId
, vtSeq :: Sequence
, vtStatus :: Maybe TodoStatus
, vtSummary :: Maybe Summary
, vtUrl :: Maybe URL
, vtRRule :: Set RRule
, vtDueDuration :: Maybe (Either Due DurationProp)
, vtAttach :: Set Attachment
, vtAttendee :: Set Attendee
, vtCategories :: Set Categories
, vtComment :: Set Comment
, vtContact :: Set Contact
, vtExDate :: Set ExDate
, vtRStatus :: Set RequestStatus
, vtRelated :: Set RelatedTo
, vtResources :: Set Resources
, vtRDate :: Set RDate
, vtAlarms :: Set VAlarm
, vtOther :: Set OtherProperty
} deriving (Show, Eq, Ord, Typeable)
data VJournal = VJournal
{ vjDTStamp :: DTStamp
, vjUID :: UID
, vjClass :: Class
, vjCreated :: Maybe Created
, vjDTStart :: Maybe DTStart
, vjLastMod :: Maybe LastModified
, vjOrganizer :: Maybe Organizer
, vjRecurId :: Maybe RecurrenceId
, vjSeq :: Sequence
, vjStatus :: Maybe JournalStatus
, vjSummary :: Maybe Summary
, vjUrl :: Maybe URL
, vjRRule :: Set RRule
, vjAttach :: Set Attachment
, vjAttendee :: Set Attendee
, vjCategories :: Set Categories
, vjComment :: Set Comment
, vjContact :: Set Contact
, vjDescription :: Set Description
, vjExDate :: Set ExDate
, vjRelated :: Set RelatedTo
, vjRDate :: Set RDate
, vjRStatus :: Set RequestStatus
, vjOther :: Set OtherProperty
} deriving (Show, Eq, Ord, Typeable)
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)
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)
data TZProp = TZProp
{ tzpDTStart :: DTStart
, tzpTZOffsetTo :: UTCOffset
, tzpTZOffsetFrom :: UTCOffset
, tzpRRule :: Set RRule
, tzpComment :: Set Comment
, tzpRDate :: Set RDate
, tzpTZName :: Set TZName
, tzpOther :: Set OtherProperty
} deriving (Show, Eq, Ord, Typeable)
data VAlarm
= VAlarmAudio
{ vaTrigger :: Trigger
, vaRepeat :: Repeat
, 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)
data VOther = VOther
{ voName :: CI Text
, voProps :: Set OtherProperty
} deriving (Show, Eq, Ord, Typeable)
data Attachment
= UriAttachment
{ attachFmtType :: Maybe MIMEType
, attachUri :: URI
, attachOther :: OtherParams
}
| BinaryAttachment
{ attachFmtType :: Maybe MIMEType
, attachContent :: ByteString
, attachOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Categories = Categories
{ categoriesValues :: Set Text
, categoriesLanguage :: Maybe Language
, categoriesOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Class = Class
{ classValue :: ClassValue
, classOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
instance Default Class where
def = Class def def
data ClassValue
= Public
| Private
| Confidential
| ClassValueX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default ClassValue where
def = Public
data Completed = Completed
{ completedValue :: DateTime
, completedOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Comment = Comment
{ commentValue :: Text
, commentAltRep :: Maybe URI
, commentLanguage :: Maybe Language
, commentOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Description = Description
{ descriptionValue :: Text
, descriptionAltRep :: Maybe URI
, descriptionLanguage :: Maybe Language
, descriptionOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Geo = Geo
{ geoLat :: Float
, geoLong :: Float
, geoOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Location = Location
{ locationValue :: Text
, locationAltRep :: Maybe URI
, locationLanguage :: Maybe Language
, locationOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data PercentComplete = PercentComplete
{ percentCompleteValue :: Int
, percentCompleteOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Priority = Priority
{ priorityValue :: Int
, priorityOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
instance Default Priority where
def = Priority 0 def
data Resources = Resources
{ resourcesValue :: Set Text
, resourcesAltRep :: Maybe URI
, resourcesLanguage :: Maybe Language
, resourcesOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data EventStatus
= TentativeEvent { eventStatusOther :: OtherParams }
| ConfirmedEvent { eventStatusOther :: OtherParams }
| CancelledEvent { eventStatusOther :: OtherParams }
deriving (Show, Eq, Ord, Typeable)
data TodoStatus
= TodoNeedsAction { todoStatusOther :: OtherParams }
| CompletedTodo { todoStatusOther :: OtherParams }
| InProcessTodo { todoStatusOther :: OtherParams }
| CancelledTodo { todoStatusOther :: OtherParams }
deriving (Show, Eq, Ord, Typeable)
data JournalStatus
= DraftJournal { journalStatusOther :: OtherParams }
| FinalJournal { journalStatusOther :: OtherParams }
| CancelledJournal { journalStatusOther :: OtherParams }
deriving (Show, Eq, Ord, Typeable)
data Summary = Summary
{ summaryValue :: Text
, summaryAltRep :: Maybe URI
, summaryLanguage :: Maybe Language
, summaryOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Date = Date
{ dateValue :: Day
} deriving (Show, Eq, Ord, Typeable)
data DateTime
= FloatingDateTime
{ dateTimeFloating :: LocalTime
}
| UTCDateTime
{ dateTimeUTC :: UTCTime
}
| ZonedDateTime
{ dateTimeFloating :: LocalTime
, dateTimeZone :: Text
} deriving (Show, Eq, Ord, Typeable)
data DTEnd
= DTEndDateTime
{ dtEndDateTimeValue :: DateTime
, dtEndOther :: OtherParams
}
| DTEndDate
{ dtEndDateValue :: Date
, dtEndOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Due
= DueDateTime
{ dueDateTimeValue :: DateTime
, dueOther :: OtherParams
}
| DueDate
{ dueDateValue :: Date
, dueOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data DTStart
= DTStartDateTime
{ dtStartDateTimeValue :: DateTime
, dtStartOther :: OtherParams
}
| DTStartDate
{ dtStartDateValue :: Date
, dtStartOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Duration
= DurationDate
{ durSign :: Sign
, 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)
data Sign = Positive | Negative
deriving (Show, Eq, Ord, Typeable)
instance Default Sign where
def = Positive
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)
data Period
= PeriodDates DateTime DateTime
| PeriodDuration DateTime Duration
deriving (Show, Eq, Ord, Typeable)
data UTCPeriod
= UTCPeriodDates UTCTime UTCTime
| UTCPeriodDuration UTCTime Duration
deriving (Show, Eq, Ord, Typeable)
data FBType
= Free
| Busy
| BusyUnavailable
| BusyTentative
| FBTypeX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default FBType where
def = Busy
data TimeTransparency
= Opaque { timeTransparencyOther :: OtherParams }
| Transparent { timeTransparencyOther :: OtherParams }
deriving (Show, Eq, Ord, Typeable)
instance Default TimeTransparency where
def = Opaque def
data TZID = TZID
{ tzidValue :: Text
, tzidGlobal :: Bool
, tzidOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data TZName = TZName
{ tzNameValue :: Text
, tzNameLanguage :: Maybe Language
, tzNameOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data UTCOffset = UTCOffset
{ utcOffsetValue :: Int
, utcOffsetOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data TZUrl = TZUrl
{ tzUrlValue :: URI
, tzUrlOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Attendee = Attendee
{ attendeeValue :: CalAddress
, attendeeCUType :: CUType
, attendeeMember :: Set CalAddress
, attendeeRole :: Role
, attendeePartStat :: PartStat
, attendeeRSVP :: Bool
, attendeeDelTo :: Set CalAddress
, attendeeDelFrom :: Set CalAddress
, attendeeSentBy :: Maybe CalAddress
, attendeeCN :: Maybe Text
, attendeeDir :: Maybe URI
, attendeeLanguage :: Maybe Language
, attendeeOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data CUType
= Individual
| Group
| Resource
| Room
| Unknown
| CUTypeX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default CUType where
def = Individual
data Role = Chair
| ReqParticipant
| OptParticipant
| NonParticipant
| RoleX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default Role where
def = ReqParticipant
data PartStat
= PartStatNeedsAction
| Accepted
| Declined
| Tentative
| Delegated
| PartStatCompleted
| InProcess
| PartStatX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default PartStat where
def = PartStatNeedsAction
data Contact = Contact
{ contactValue :: Text
, contactAltRep :: Maybe URI
, contactLanguage :: Maybe Language
, contactOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Organizer = Organizer
{ organizerValue :: CalAddress
, organizerCN :: Maybe Text
, organizerDir :: Maybe URI
, organizerSentBy :: Maybe CalAddress
, organizerLanguage :: Maybe Language
, organizerOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data RecurrenceId
= RecurrenceIdDate
{ recurrenceIdDate :: Date
, recurrenceIdRange :: Maybe Range
, recurrenceIdOther :: OtherParams
}
| RecurrenceIdDateTime
{ recurrenceIdDateTime :: DateTime
, recurrenceIdRange :: Maybe Range
, recurrenceIdOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Range = ThisAndFuture | ThisAndPrior
deriving (Show, Eq, Ord, Typeable)
data RelatedTo = RelatedTo
{ relatedToValue :: Text
, relatedToType :: RelationshipType
, relatedToOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data RelationshipType = Parent | Child | Sibling | RelationshipTypeX (CI Text)
deriving (Show, Eq, Ord, Typeable)
instance Default RelationshipType where
def = Parent
data URL = URL
{ urlValue :: URI
, urlOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data UID = UID
{ uidValue :: Text
, uidOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data ExDate
= ExDates
{ exDates :: Set Date
, exDateOther :: OtherParams
}
| ExDateTimes
{ exDateTimes :: Set DateTime
, exDateOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
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)
data Frequency
= Secondly
| Minutely
| Hourly
| Daily
| Weekly
| Monthly
| Yearly
deriving (Show, Eq, Ord, Typeable)
data Weekday = Sunday | Monday | Tuesday | Wednesday | Thursday
| Friday | Saturday
deriving (Show, Eq, Ord, Bounded, Enum, Typeable)
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)
data RRule = RRule
{ rRuleValue :: Recur
, rRuleOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Repeat = Repeat
{ repeatValue :: Integer
, repeatOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
instance Default Repeat where
def = Repeat 0 def
data AlarmTriggerRelationship = Start | End
deriving (Show, Eq, Ord, Typeable)
instance Default AlarmTriggerRelationship where
def = Start
data Trigger
= TriggerDuration
{ triggerDuration :: Duration
, triggerRelated :: AlarmTriggerRelationship
, triggerOther :: OtherParams
}
| TriggerDateTime
{ triggerDateTime :: UTCTime
, triggerOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Created = Created
{ createdValue :: UTCTime
, createdOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data DTStamp = DTStamp
{ dtStampValue :: UTCTime
, dtStampOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data LastModified = LastModified
{ lastModifiedValue :: UTCTime
, lastModifiedOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data Sequence = Sequence
{ sequenceValue :: Integer
, sequenceOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
instance Default Sequence where
def = Sequence 0 def
data RequestStatus = RequestStatus
{ requestStatusCode :: [Int]
, requestStatusDesc :: Text
, requestStatusLanguage :: Maybe Language
, requestStatusExt :: Maybe Text
, requestStatusOther :: OtherParams
} deriving (Show, Eq, Ord, Typeable)
data OtherProperty = OtherProperty
{ otherName :: CI Text
, otherValue :: ByteString
, otherParams :: OtherParams
} deriving (Show, Eq, Ord, Typeable)