module Text.VCard ( -- $doc VCard(..) , CommonName , IndividualNames(..) , VCardProperty(..) , AddrType(..) , TelType(..) , EmailType(..) , AgentData(..) , Data(..) , Class(..) ) where import Data.List (intercalate) import Data.Time (UTCTime, TimeZone, FormatTime, formatTime) import System.Locale (defaultTimeLocale) -- | Calling @show@ on @VCard@ will output a RFC 2426-compliant VCard that -- can, for example, be easily saved to a file and imported by any supporting -- program. data VCard = VCard CommonName IndividualNames [VCardProperty] -- | Common name of the represented person. E.g., -- -- > CommonName "Mr. Michael A. F. Schade" type CommonName = String -- | A breakdown of the vCard entity's name, corresponding, in sequence, to -- Family Name, Given Name, Additional Names, Honorific Prefixes, and Honorific -- Suffixes. E.g., -- -- > IndividualNames ["Schade"] ["Michael"] ["Anthony", "Fanetti"] [] ["Esq."] data IndividualNames = IndividualNames { familyName :: [String] , givenName :: [String] , additionalNames :: [String] , honorificPrefixes :: [String] , honorificSuffixes :: [String] } data VCardProperty = -- | A list of nicknames belonging to the VCard entity. E.g., -- -- > Nickname ["Mike", "Mikey"] Nickname [String] -- | A photo of the VCard entity. E.g., -- -- > Photo Nothing (URI "http://accentuate.us/smedia/images/michael.jpg") | Photo { phtType :: Maybe String -- ^ Registered IANA format , phtData :: Data } -- | Specifies the birth date of the VCard entity. E.g., -- -- > Birthday $ UTCTime (fromGregorian 1991 10 14) (secondsToDiffTime 0) | Birthday UTCTime -- | A physical address associated with the vCard entity. E.g., -- -- > Address [AddrParcel, AddrPostal] "PO Box 935" "" "" "Fenton" "MO" -- > "63026" "USA" | Address { addrType :: [AddrType] , poBox :: String , extAddress :: String , streetAddress :: String , locality :: String -- ^ City , region :: String -- ^ State or Province , postalCode :: String , countryName :: String } -- | Formatted text about the delivery address. This is typically similar -- to the information in Address. E.g., -- -- > Label [AddrParcel, AddrPostal] -- > ["Michael Schade", "PO Box 935", "Fenton, MO 63026"] | Label { lblType :: [AddrType] , label :: [String] -- ^ Will be newline separated } -- | A telephone number for the VCard entity, as well as a list of -- properties describing the telephone number. E.g., -- -- > Telephone [TelCell, TelPreferred] "+1-555-555-5555" | Telephone { telType :: [TelType] , number :: String } -- | An email address for the VCard entity, including a list of properties -- describing it. E.g., -- -- > Email [EmailInternet, EmailPreferred] "hackage@mschade.me" | Email { emailType :: [EmailType] , email :: String } -- | Specifies the mailing agent the vCard entity uses. E.g., -- -- > Mailer "MichaelMail 4.2" -- Not a real mailing agent, unfortunately :( | Mailer String -- | Represents the time zone of the vCard entity. E.g., -- -- > TZ (hoursToTimeZone (-6)) | TZ TimeZone -- | Relates to the global positioning of the vCard entity. The value is -- (latitude, longitude) and must be specified as decimal degrees, -- preferably to six decimal places. -- -- > Geo (37.386013, -122.082932) | Geo (Double, Double) -- | The VCard entity's job title or other position. E.g., -- -- > Title "Co-Founder" | Title String -- | Specifies the role associated with the title. E.g., -- -- > Role "Anything" -- For the co-founder, or -- > Role "Programmer" -- For someone the title "Research and Development" | Role String -- | An image of the vCard entity's logo. This would typically relate to -- their organization. E.g., -- -- > Logo Nothing (URI "http://spearheaddev.com/smedia/images/logo-trans.png") | Logo { lgoType :: Maybe String -- ^ Registered IANA format , lgoData :: Data } -- | Indicates the vCard of an assistant or area administrator who is -- typically separately addressable. E.g., -- -- > Agent (AgentURI "CID:JQPUBLIC.part3.960129T083020.xyzMail@host3.com") -- -- or -- -- > Agent (AgentVCard (VCard [ CommonName "James Q. Helpful" -- > , Email [EmailInternet] "j@spearheaddev.com" -- > ])) | Agent AgentData -- | The organization to which an entity belongs followed by organizational -- unit names. E.g., -- -- > Organization ["Spearhead Development, L.L.C.", "Executive"] | Organization [String] -- | General categories to describe the vCard entity. E.g., -- -- > Categories ["Internet", "Web Services", "Programmers"] | Categories [String] -- | A general note about the vCard entity. E.g., -- -- > Note "Email is the absolute best contact method." | Note String -- | Specifies the identifier of the product that created this vCard. E.g., -- -- > ProductId "-//ONLINE DIRECTORY//NONSGML Version 1//EN" -- -- Please note well that, by RFC 2426 guidelines, \"implementations SHOULD -- use a method such as that specified for Formal Public Identifiers in ISO -- 9070 to assure that the text value is unique,\" but this module does not -- support that. | ProductId String -- | Distinguishes the current revision from other renditions. E.g., -- -- > Revision $ UTCTime (fromGregorian 2011 04 16) (secondsToDiffTime 0) | Revision UTCTime -- | Provides a locale- or national-language-specific formatting of the -- formatted name based on the vCard entity's family or given name. E.g., -- -- > SortString "Schade" | SortString String -- | Specifies information in a digital sound format to annotate some -- aspect of the vCard. This is typically for the proper pronunciation of the -- vCard entity's name. E.g., -- -- > Sound "BASIC" -- > (URI "CID:JOHNQPUBLIC.part8.19960229T080000.xyzMail@host1.com") | Sound { sndType :: Maybe String -- ^ Registered IANA format , sndData :: Data } -- | A value to uniquely identify the vCard. Please note well that this -- should be one of the registered IANA formats, but as of this time, this -- module does not support listing the UID type. E.g., -- -- > UID "19950401-080045-40000F192713-0052" | UID String -- | A website associated with the vCard entity. E.g., -- -- > URL "http://spearheaddev.com/" | URL String -- | Describes the general intention of the vCard owner as to how -- accessible the included information should be. E.g., -- -- > Class ClassConfidential | Class Class -- | Specifies a public key or authentication certificate associated with -- the vCard entity. E.g., -- -- > Key "x509" (Binary "dGhpcyBjb3VsZCBiZSAKbXkgY2VydGlmaWNhdGUK") | Key { keyType :: Maybe String -- ^ Registered IANA format , keyData :: Data } -- | Represents the various types or properties of an address. data AddrType = AddrDomestic | AddrInternational | AddrPostal | AddrParcel | AddrHome | AddrWork | AddrPreferred -- | Represents the various types or properties of a telephone number. data TelType = TelHome | TelMessage | TelWork | TelVoice | TelFax | TelCell | TelVideo | TelPager | TelBBS | TelModem | TelCar | TelISDN | TelPCS | TelPreferred -- | Represents the various types or properties of an email address. data EmailType = EmailInternet | EmailX400 | EmailPreferred -- | Represents the data associated with a vCard's Agent. This could be a URI -- to such a vCard or the embedded contents of the vCard itself. data AgentData = AgentURI String | AgentVCard VCard -- | Represents the various types of data that can be included in a vCard. data Data = URI String | Binary String -- | Classifies the vCard's intended access level. data Class = ClassPublic | ClassPrivate | ClassConfidential instance Show VCard where show (VCard fn ns vps) = intercalate "\n" ["BEGIN:vCard", "VERSION:3.0", vps', "END:vCard"] where vps' = intercalate "\n" $ [ "FN:" ++ escape fn , show ns ] ++ map show vps instance Show IndividualNames where show (IndividualNames fn gn an hp hs) = ("N:" ++) . intercalate ";" . map (escape . sep) $ [fn, gn, an, hp, hs] where sep = intercalate "," instance Show VCardProperty where show (Nickname nn) = "NICKNAME:" ++ (intercalate "," . map escape) nn show (Photo t d) = "PHOTO" ++ showType t ++ show d show (Birthday bd) = "BDAY:" ++ fmtTime "%Y-%m-%d" bd show (Address ts po e s l r ps c) = "ADR;" ++ ts' ++ vps where ts' = showTypes . map show $ ts vps = (intercalate ";" . map escape) [po, e, s, l, r, ps, c] show (Label ts l) = "LABEL;" ++ ts' ++ (intercalate "\n" . map escape) l where ts' = showTypes . map show $ ts show (Telephone ts n) = "TEL;" ++ ts' ++ escape n where ts' = showTypes . map show $ ts show (Email ts e) = "EMAIL;" ++ ts' ++ escape e where ts' = showTypes . map show $ ts show (Mailer m) = "MAILER:" ++ escape m show (TZ time) = "TZ:" ++ tz' where (h,m) = splitAt 3 (show time) tz' = h ++ ":" ++ m show (Geo (lat,lon)) = "GEO:" ++ intercalate ";" [show lat, show lon] show (Title t) = "TITLE:" ++ escape t show (Role r) = "ROLE:" ++ escape r show (Logo t d) = "LOGO" ++ showType t ++ show d show (Agent a) = "AGENT:" ++ (escape . show) a show (Organization os) = "ORG:" ++ (intercalate ";" . map escape) os show (Categories cs) = "CATEGORIES:" ++ (intercalate "," . map escape) cs show (Note n) = "NOTE:" ++ escape n show (ProductId pid) = "PRODID:" ++ escape pid show (Revision r) = "REV:" ++ fmtTime "%Y-%m-%d" r show (SortString s) = "SORT-STRING:" ++ escape s show (Sound t s) = "SOUND" ++ showType t ++ show s show (UID u) = "UID:" ++ escape u show (URL u) = "URL:" ++ escape u show (Class c) = "CLASS:" ++ show c show (Key t k) = "KEY" ++ showType t ++ show k instance Show AddrType where show AddrDomestic = "DOM" show AddrInternational = "INTL" show AddrPostal = "POSTAL" show AddrParcel = "PARCEL" show AddrHome = "HOME" show AddrWork = "WORK" show AddrPreferred = "PREF" instance Show TelType where show TelHome = "HOME" show TelMessage = "MSG" show TelWork = "WORK" show TelVoice = "VOICE" show TelFax = "FAX" show TelCell = "CELL" show TelVideo = "VIDEO" show TelPager = "PAGER" show TelBBS = "BBS" show TelModem = "MODEM" show TelCar = "CAR" show TelISDN = "ISDN" show TelPCS = "PCS" show TelPreferred = "PREF" instance Show EmailType where show EmailInternet = "INTERNET" show EmailX400 = "X400" show EmailPreferred = "PREF" instance Show AgentData where show (AgentURI u) = "VALUE=uri:" ++ escape u show (AgentVCard v) = escape . show $ v instance Show Data where show (URI u) = "VALUE=uri:" ++ escape u show (Binary b) = "ENCODING=b:" ++ b instance Show Class where show ClassPublic = "PUBLIC" show ClassPrivate = "PRIVATE" show ClassConfidential = "CONFIDENTIAL" -- | Output RFC 2426-compliant TYPE argument when it is just a singleton showType :: Maybe String -> String showType Nothing = ";" showType (Just t) = ";TYPE=" ++ escape t ++ ";" -- | Output RFC 2426-compliant TYPE arguments read for a given vCard line. showTypes :: [String] -> String showTypes ts = "TYPE=" ++ intercalate "," ts ++ ":" -- | Convenience function to format time with default system locale information. fmtTime :: FormatTime t => String -> t -> String fmtTime = formatTime defaultTimeLocale -- | Escapes commas and semicolons per RFC 2426 guidelines. escape :: String -> String escape [] = [] escape (x:xs) | x == ',' = "\\," ++ xs' | x == ';' = "\\;" ++ xs' | otherwise = x:xs' where xs' = escape xs -- $doc -- -- This package implements the RFC 2426 vCard 3.0 spec -- (<http://www.ietf.org/rfc/rfc2426.txt>) -- -- Its usage is fairly simple and intuitive. For example, below is how one -- would produce a VCard for Frank Dawson, one of the RFC 2426 authors: -- -- > VCard "Frank Dawson" -- > (IndividualNames ["Dawson"] ["Frank"] [] [] []) -- > [ Organization ["Lotus Development Corporation"] -- > , Address [AddrWork, AddrPostal, AddrParcel] "" "" -- > "6544 Battleford Drive" -- > "Raleigh" "NC" "27613-3502" "U.S.A" -- > , Telephone [TelVoice, TelMessage, TelWork] "+1-919-676-9515" -- > , Telephone [TelFax, TelWork] "+1-919-676-9564" -- > , Email [EmailInternet, EmailPreferred] "Frank_Dawson@Lotus.com" -- > , Email [EmailInternet] "fdawson@earthlink.net" -- > , URL "http://home.earthlink.net/~fdawson" -- > ] -- -- Although this package is fairly well documented, even with general -- explanations about the various VCard properties, RFC 2426 should be -- consulted for the final say on the meaning or application of any of the -- VCard properties.