From 9f852ca6bf4c6666c92becf8bd78f89ba9fddcf9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 7 Nov 2012 15:47:30 -0400
Subject: better git-annex tag handling

Allow the tag to contain a value. Better extraction of the attribute value.
---
 Assistant/XMPP.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

(limited to 'Assistant')

diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs
index 37cf00374..48357bd61 100644
--- a/Assistant/XMPP.hs
+++ b/Assistant/XMPP.hs
@@ -38,23 +38,23 @@ class GitAnnexTaggable a where
 	hasGitAnnexTag = isJust . extractGitAnnexTag
 
 instance GitAnnexTaggable Message where
-	insertGitAnnexTag m e = m { messagePayloads = e : messagePayloads m }
+	insertGitAnnexTag m elt = m { messagePayloads = elt : messagePayloads m }
 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . messagePayloads
 
 instance GitAnnexTaggable Presence where
 	-- always mark extended away
-	insertGitAnnexTag p e = p { presencePayloads = extendedAway : e : presencePayloads p }
+	insertGitAnnexTag p elt = p { presencePayloads = extendedAway : elt : presencePayloads p }
 	extractGitAnnexTag = headMaybe . filter isGitAnnexTag . presencePayloads
 
-{- Gets the attr and value from a git-annex tag. -}
+{- Gets the attr and its value value from a git-annex tag.
+ -
+ - Each git-annex tag has a single attribute. -}
 getGitAnnexAttrValue :: GitAnnexTaggable a => a -> Maybe (Name, Text)
 getGitAnnexAttrValue a = case extractGitAnnexTag a of
-	Just (Element _ [(attr, content)] []) -> Just $
-		(attr, T.concat $ map unpack content)
+	Just (tag@(Element _ [(attr, _)] _)) -> (,)
+		<$> pure attr
+		<*> attributeText attr tag
 	_ -> Nothing
-  where
-	unpack (ContentText t) = t
-	unpack (ContentEntity t) = t
 
 {- A presence with a git-annex tag in it. -}
 gitAnnexPresence :: Element -> Presence
-- 
cgit v1.2.3