summaryrefslogtreecommitdiff
path: root/Network/Gravatar.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Network/Gravatar.hs')
-rw-r--r--Network/Gravatar.hs44
1 files changed, 38 insertions, 6 deletions
diff --git a/Network/Gravatar.hs b/Network/Gravatar.hs
index bf65271..12fe9f1 100644
--- a/Network/Gravatar.hs
+++ b/Network/Gravatar.hs
@@ -10,29 +10,61 @@
--
--------------------------------------------------------------------
--
--- Return the url of a gravatar
+-- Return the URL of a gravatar image - an image associated with an
+-- email address.
--
module Network.Gravatar (
- gravatar
- , Rating(..)
+ gravatar, gravatarWith
+ ,Rating(..)
+ ,Size,size
) where
import Data.Digest.OpenSSL.MD5
import Data.List
import Data.Char
+import Network.URI
import qualified Data.ByteString.Char8 as S
+------------------------------------------------------------------------
+-- Implementing the gravatar protocol
+
-- | Classification ratings for gravatars
data Rating = G | PG | R | X
deriving (Eq,Ord,Bounded,Enum,Show,Read)
+-- | An image size in pixels from 1 to 80.
+newtype Size = Size Int
+
+-- | A smart constructor for the Size type, ensuring it is between 1 and 80
+size :: Int -> Maybe Size
+size n | n >= 1 && n <= 80 = Just (Size n)
+ | otherwise = Nothing
+
+------------------------------------------------------------------------
+
baseURL = "http://www.gravatar.com/avatar.php?"
gravatar_id = "gravatar_id"
--- | Return the url of a gravatar for an email address (a globally recognized avatar).
+-- | Return the url of a gravatar for an
+-- email address (a globally recognized avatar).
+--
gravatar :: String -> String
-gravatar who = concat [baseURL ,gravatar_id ,"=" ,(md5sum (S.pack (clean who)))]
+gravatar who = gravatarWith who Nothing Nothing Nothing
+
+-- | Construct the url of a gravatar with optional classification
+-- ratings, an optional size, and optional default image.
+--
+gravatarWith :: String
+ -> Maybe Rating
+ -> Maybe Size
+ -> Maybe String
+ -> String
+gravatarWith who rating' sz' dflt'
+ = concat [baseURL ,gravatar_id ,"=" ,(md5sum (S.pack (clean who))),rating,sz,dflt ]
where
- clean = let f = reverse . dropWhile isSpace in f . f
+ clean = let f = reverse . dropWhile isSpace in f . f
+ rating = maybe "" (\r -> "&rating="++show r) rating'
+ sz = maybe "" (\(Size n) -> "&size="++show n) sz'
+ dflt = maybe "" (\r -> "&default="++escapeURIString isUnreserved r) dflt'