module VCard (
	VCard(..), emptyVCard, vcardRequest, parseVCard, vcardToElement
) where

import Prelude ()
import BasicPrelude
import Control.Error                   (headZ)
import qualified Data.XML.Types        as XML
import qualified Network.Protocol.XMPP as XMPP

import Util

data VCard = VCard {
	fn :: Maybe Text,
	nickname :: Maybe Text,
	url :: [Text]
} deriving (Show, Eq)

vcardToElement :: VCard -> XML.Element
vcardToElement vcard = XML.Element (s"{urn:ietf:params:xml:ns:vcard-4.0}vcard")
	[] $ map XML.NodeElement $
	maybeToList (mkItem "fn" "text" <$> fn vcard) ++
	maybeToList (mkItem "nickname" "text" <$> nickname vcard) ++
	(mkItem "url" "uri" <$> url vcard)

mkItem :: String -> String -> Text -> XML.Element
mkItem item typ content = XML.Element itemName []
	[XML.NodeElement $ mkElement typeName content]
	where
	itemName = fromString $ "{urn:ietf:params:xml:ns:vcard-4.0}" ++ item
	typeName = fromString $ "{urn:ietf:params:xml:ns:vcard-4.0}" ++ typ

emptyVCard :: VCard
emptyVCard = VCard Nothing Nothing []

vcardRequest :: XMPP.JID -> XMPP.IQ
vcardRequest jid = (XMPP.emptyIQ XMPP.IQGet) {
	XMPP.iqTo = Just $ bareJid jid,
	XMPP.iqPayload = Just $ XML.Element
		(s"{urn:ietf:params:xml:ns:vcard-4.0}vcard") [] []
}

parseVCard :: XMPP.IQ -> VCard
parseVCard XMPP.IQ { XMPP.iqType = XMPP.IQResult, XMPP.iqPayload = Just vcard }
	| XML.elementName vcard == s"{urn:ietf:params:xml:ns:vcard-4.0}vcard" =
		VCard {
			fn = mconcat . XML.elementText <$>
				headZ (vcardItems "fn" "text" vcard),
			nickname = mconcat . XML.elementText <$>
				headZ (vcardItems "nickname" "text" vcard),
			url = mconcat . XML.elementText <$>
				vcardItems "url" "uri" vcard
		}
parseVCard _ = emptyVCard

vcardItems :: String -> String -> XML.Element -> [XML.Element]
vcardItems item typ vcard =
	XML.isNamed typeName =<<
	XML.elementChildren =<<
	XML.isNamed itemName =<<
	XML.elementChildren vcard
	where
	itemName = fromString $ "{urn:ietf:params:xml:ns:vcard-4.0}" ++ item
	typeName = fromString $ "{urn:ietf:params:xml:ns:vcard-4.0}" ++ typ