summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrickBrisbin <>2015-03-03 16:04:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-03-03 16:04:00 (GMT)
commitec1e18e276e7bcad758ffcea93911044863aa545 (patch)
treebd296d9219507de0cf6e23532d2ebab1a43e0c7f
parent30672cfa4bc6c1afa4813eca3b0c85aca18a05aa (diff)
version 0.8.0HEAD0.8.0master
-rw-r--r--gravatar.cabal3
-rw-r--r--src/Network/Gravatar.hs115
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