diff options
| -rw-r--r-- | gravatar.cabal | 3 | ||||
| -rw-r--r-- | src/Network/Gravatar.hs | 115 |
2 files changed, 65 insertions, 53 deletions
diff --git a/gravatar.cabal b/gravatar.cabal index 154d870..e043ff7 100644 --- a/gravatar.cabal +++ b/gravatar.cabal @@ -1,5 +1,5 @@ name: gravatar -version: 0.7.1 +version: 0.8.0 author: Pat Brisbin <pbrisbin@gmail.com> maintainer: Pat Brisbin <pbrisbin@gmail.com> license: MIT @@ -30,6 +30,7 @@ test-suite spec build-depends: base , hspec , gravatar + , text source-repository head type: git diff --git a/src/Network/Gravatar.hs b/src/Network/Gravatar.hs index 3fd5f88..b7c5111 100644 --- a/src/Network/Gravatar.hs +++ b/src/Network/Gravatar.hs @@ -8,16 +8,16 @@ module Network.Gravatar , ForceDefault(..) , Rating(..) , Scheme (..) - , Default(..) + , Default(def) , defaultConfig ) where +import Data.Default (Default(..)) import Data.Digest.Pure.MD5 (md5) -import Data.Default (Default(..)) -import Data.List (intercalate) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Network.HTTP.Base (urlEncode) +import Data.List (intercalate) +import Data.Maybe (catMaybes) +import Data.Text (Text) +import Network.HTTP.Base (urlEncode) import qualified Data.ByteString.Lazy.Char8 as C8 import qualified Data.Text as T @@ -35,44 +35,50 @@ instance GravatarParam Size where newtype ForceDefault = ForceDefault Bool instance GravatarParam ForceDefault where - toParam (ForceDefault b) = if b then Just ("f", "y") else Nothing + toParam (ForceDefault True) = Just ("f", "y") + toParam (ForceDefault False) = Nothing -- | Image to show when an avatar is not available -data DefaultImg = Custom String -- ^ supply your own url - | NotFound -- ^ do not load an image return a 404 - | MM -- ^ mystery man - | Identicon -- ^ geometric pattern based on the hash - | MonsterId -- ^ a generated monster - | Wavatar -- ^ generated faces - | Retro -- ^ generated, 8-bit arcade style pixelated face +data DefaultImg + = Custom String -- ^ supply your own url + | NotFound -- ^ do not load an image return a 404 + | MM -- ^ mystery man + | Identicon -- ^ geometric pattern based on the hash + | MonsterId -- ^ a generated monster + | Wavatar -- ^ generated faces + | Retro -- ^ generated, 8-bit arcade style pixelated face instance GravatarParam DefaultImg where toParam (Custom s) = Just ("d", urlEncode s) - toParam NotFound = Just ("d", "404" ) - toParam MM = Just ("d", "mm" ) - toParam Identicon = Just ("d", "identicon") - toParam MonsterId = Just ("d", "monsterid") - toParam Wavatar = Just ("d", "wavatar" ) - toParam Retro = Just ("d", "retro" ) + toParam NotFound = Just ("d", "404") + toParam MM = Just ("d", "mm") + toParam Identicon = Just ("d", "identicon") + toParam MonsterId = Just ("d", "monsterid") + toParam Wavatar = Just ("d", "wavatar") + toParam Retro = Just ("d", "retro") -- | Limit the returned images by rating data Rating = G | PG | R | X instance GravatarParam Rating where - toParam G = Just ("r", "g" ) + toParam G = Just ("r", "g") toParam PG = Just ("r", "pg") - toParam R = Just ("r", "r" ) - toParam X = Just ("r", "x" ) + toParam R = Just ("r", "r") + toParam X = Just ("r", "x") data GravatarOptions = GravatarOptions - { gSize :: Maybe Size - , gDefault :: Maybe DefaultImg - , gForceDefault :: ForceDefault - , gRating :: Maybe Rating - , gScheme :: Scheme + { gSize :: Maybe Size -- ^ default @Nothing@ + , gDefault :: Maybe DefaultImg -- ^ default @Nothing@ + , gForceDefault :: ForceDefault -- ^ default @False@ + , gRating :: Maybe Rating -- ^ default @Nothing@ + , gScheme :: Scheme -- ^ default @Https@ } -data Scheme = Http | Https | None +-- | Scheme to use for image URLs +data Scheme + = Http -- ^ @http://@ + | Https -- ^ @https://@ + | None -- ^ @//@ instance Show Scheme where show Http = "http://" @@ -85,34 +91,39 @@ instance Default GravatarOptions where -- | Available for backwards compatability, using @def@ is advised defaultConfig :: GravatarOptions defaultConfig = GravatarOptions - { gSize = Nothing - , gDefault = Nothing + { gSize = Nothing + , gDefault = Nothing , gForceDefault = ForceDefault False - , gRating = Nothing - , gScheme = Https + , gRating = Nothing + , gScheme = Https } -- | Return the avatar for the given email using the provided options gravatar :: GravatarOptions -> Text -> String -gravatar opts e = (show . gScheme $ opts) ++ "www.gravatar.com/avatar/" - ++ hashEmail e `addParams` opts +gravatar opts e = concat + [ show $ gScheme opts + , "www.gravatar.com/avatar/" + , hashEmail e + , queryString opts + ] -- | <http://en.gravatar.com/site/implement/hash/> hashEmail :: Text -> String -hashEmail = md5sum . T.toLower . T.strip - - where - md5sum :: Text -> String - md5sum = show . md5 . C8.pack . T.unpack - -addParams :: String -> GravatarOptions -> String -addParams url opts = helper url . map (\(k,v) -> k ++ "=" ++ v) - $ catMaybes [ toParam =<< gSize opts - , toParam =<< gDefault opts - , toParam $ gForceDefault opts - , toParam =<< gRating opts - ] - where - helper :: String -> [String] -> String - helper u [] = u - helper u l = (++) u . (:) '?' $ intercalate "&" l +hashEmail = show . md5 . C8.pack . T.unpack . T.toLower . T.strip + +queryString :: GravatarOptions -> String +queryString opts = case queryParts of + [] -> "" + ps -> "?" ++ intercalate "&" (map queryPart ps) + + where + queryParts :: [(String, String)] + queryParts = catMaybes + [ toParam =<< gSize opts + , toParam =<< gDefault opts + , toParam $ gForceDefault opts + , toParam =<< gRating opts + ] + + queryPart :: (String, String) -> String + queryPart (k, v) = k ++ "=" ++ v |