flickr (empty) → 0.2

raw patch · 42 files changed

+4364/−0 lines, 42 filesdep +HTTPdep +basedep +filepathsetup-changed

Dependencies added: HTTP, base, filepath, mime, network, random, utf8-string, xhtml, xml

Files

• Codec/Percent.hs +57/−0
• Codec/URLEncoder.hs +33/−0
• Flickr/API.hs +13/−0
• Flickr/Activity.hs +36/−0
• Flickr/Auth.hs +45/−0
• Flickr/Blogs.hs +41/−0
• Flickr/Contacts.hs +34/−0
• Flickr/Favorites.hs +52/−0
• Flickr/Groups.hs +37/−0
• Flickr/Groups/Pools.hs +63/−0
• Flickr/Interestingness.hs +28/−0
• Flickr/People.hs +78/−0
• Flickr/Photos.hs +430/−0
• Flickr/Photos/Comments.hs +55/−0
• Flickr/Photos/Geo.hs +69/−0
• Flickr/Photos/Licenses.hs +33/−0
• Flickr/Photos/Notes.hs +53/−0
• Flickr/Photos/Transform.hs +27/−0
• Flickr/Photos/Upload.hs +93/−0
• Flickr/Photosets.hs +127/−0
• Flickr/Photosets/Comments.hs +52/−0
• Flickr/Places.hs +80/−0
• Flickr/Prefs.hs +50/−0
• Flickr/Tags.hs +79/−0
• Flickr/Types.hs +563/−0
• Flickr/Types/Import.hs +806/−0
• Flickr/URLs.hs +114/−0
• Flickr/Utils.hs +96/−0
• LICENSE +27/−0
• README +49/−0
• Setup.hs +8/−0
• Util/Authenticate.hs +42/−0
• Util/Fetch.hs +104/−0
• Util/Keys.hs +57/−0
• Util/MD5.hs +266/−0
• Util/MIME.hs +117/−0
• Util/Post.hs +151/−0
• examples/Gallery.hs +87/−0
• examples/SearchPhotos.hs +24/−0
• examples/ShowPublicPhotos.hs +49/−0
• examples/Uploader.hs +49/−0
• flickr.cabal +90/−0

@@ -0,0 +1,57 @@+{- |+ +  Module      :  Codec.Percent+  Copyright   :  (c) 2008++  Maintainer  : sof@forkIO.com++  License     : See the file LICENSE++  Status      : Coded++  Codec for de/encoding URI strings via percent encodings+ (cf. RFC 3986.)+-}+module Codec.Percent where++import Data.Char ( chr, isAlphaNum )+import Numeric   ( readHex, showHex )++getEncodedString :: String -> String+getEncodedString "" = ""+getEncodedString (x:xs) = +  case getEncodedChar x of+    Nothing -> x : getEncodedString xs+    Just ss -> ss ++ getEncodedString xs++getDecodedString :: String -> String+getDecodedString "" = ""+getDecodedString ls@(x:xs) = +  case getDecodedChar ls of+    Nothing -> x : getDecodedString xs+    Just (ch,xs1) -> ch : getDecodedString xs1++getEncodedChar :: Char -> Maybe String+getEncodedChar x+ | isAlphaNum x || +   x `elem` "-_.~" = Nothing+ | xi < 0xff       = Just ('%':showHex (xi `div` 16) (showHex (xi `mod` 16) ""))+ | otherwise       = -- ToDo: import utf8 lib+   error "getEncodedChar: can only handle 8-bit chars right now."+ where+  xi :: Int+  xi = fromEnum x++getDecodedChar :: String -> Maybe (Char, String)+getDecodedChar str =+ case str of+   ""          -> Nothing+   (x:xs) +    | x /= '%'  -> Nothing+    | otherwise -> do+       case xs of+         (b1:b2:bs) -> +	    case readHex [b1,b2] of+	      ((v,_):_) -> Just (Data.Char.chr v, bs)+	      _ -> Nothing+	 _ -> Nothing

@@ -0,0 +1,33 @@+{-+ Codec for de/encoding form data shipped in URL query strings+ or in POST request bodies. (application/x-www-form-urlencoded)+ (cf. RFC 3986.)+-}+module Codec.URLEncoder +       ( encodeString+       , decodeString+       ) where++import qualified Codec.Binary.UTF8.String as UTF8 ( encodeString )+import Codec.Percent ( getEncodedChar, getDecodedChar )++encodeString :: String -> String+encodeString str = go (UTF8.encodeString str)+ where+  go "" = ""+  go (' ':xs) = '+':go xs+  go ('\r':'\n':xs) = '%':'0':'D':'%':'0':'A':go xs+  go ('\r':xs) = go ('\r':'\n':xs)+  go ('\n':xs) = go ('\r':'\n':xs)+  go (x:xs) = +    case getEncodedChar x of+      Nothing -> x : go xs+      Just ss -> ss ++ go xs+      +decodeString :: String -> String+decodeString "" = ""+decodeString ('+':xs) = ' ':decodeString xs+decodeString ls@(x:xs) = +  case getDecodedChar ls of+    Nothing -> x : decodeString xs+    Just (ch,xs1) -> ch : decodeString xs1

@@ -0,0 +1,13 @@+module Flickr.API 
+     (
+       module Flickr.Monad,
+       module Flickr.Types,
+       module Flickr.Utils,
+       module Flickr.Auth
+
+       ) where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Utils
+import Flickr.Auth

@@ -0,0 +1,36 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Activity+-- Description : flickr.activity - photo comments and activity.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.activity, methods for accessing comments and activity for a user.+--------------------------------------------------------------------+module Flickr.Activity where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++import Data.Maybe ( maybeToList )++-- | Returns a list of recent activity on photos commented on by the calling user.+userComments :: FM [Item]+userComments = withReadPerm $ +  flickTranslate toItems $ flickCall "flickr.activity.userComments" []++-- | Returns a list of recent activity on photos belonging to the calling user.+userPhotos :: Maybe Integer -- time frame+	   -> FM [Item]+userPhotos mb = withReadPerm $+  flickTranslate toItems $ +    flickCall "flickr.activity.userPhotos" +              (maybeToList (fmap (\x -> ("timeframe",show x)) mb))++	   +

@@ -0,0 +1,45 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Auth+-- Description : flickr.auth - authentication, flickr-style.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+-- Binding to flickr.auth's (signed) API+--------------------------------------------------------------------+module Flickr.Auth where++import Flickr.Types+import Flickr.Types.Import+import Flickr.Monad++-- | Returns a frob to be used during authentication. +-- This method call must be signed.+getFrob :: FM AuthFrob+getFrob = signedMethod $ do+  flickTranslate toAuthFrob $+    flickCall "flickr.auth.getFrob" []++-- | Returns the credentials attached to an authentication token. +-- This call must be signed as specified in the authentication API spec.+checkToken :: AuthTokenValue -> FM AuthToken+checkToken tok = signedMethod $ do+  flickTranslate toAuthToken $+    flickCall "flickr.auth.checkToken" [("auth_token", tok)]++getFullToken :: AuthMiniToken -> FM AuthToken+getFullToken mtok = signedMethod $ do+  flickTranslate toAuthToken $+    flickCall "flickr.auth.getFullToken" [("mini_token", mtok)]++-- | Returns the auth token for the given frob, if one has been +-- attached. This method call must be signed.+getToken :: AuthFrob -> FM AuthToken+getToken frob = signedMethod $ do+  flickTranslate toAuthToken $+   flickCall "flickr.auth.getToken" [("frob", aFrob frob)]+

@@ -0,0 +1,41 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Blogs+-- Description : flickr.blogs - post to photo blog.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+-- flickr.blogs API, accessing a user's blogs + post photos to them.+--------------------------------------------------------------------+module Flickr.Blogs where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Get a list of configured blogs for the calling user.+getList :: FM [Blog]+getList = withReadPerm $+  flickTranslate toBlogs $ +    flickCall "flickr.blogs.getList" []++-- | Post a photo to the given blog.+postPhoto :: BlogID+          -> PhotoID -- ^ photo id+	  -> String  -- ^ title+	  -> String  -- ^ description+	  -> Maybe String -- ^ password+          -> FM ()+postPhoto bid pid tit desc pwd = withWritePerm $ postMethod $ +   flickCall_ "flickr.blogs.postPhoto"+              (mbArg "blog_password" pwd+	         [ ("blog_id", bid)+		 , ("photo_id", pid)+		 , ("title", tit)+		 , ("description", desc)+		 ]) +

@@ -0,0 +1,34 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Contacts+-- Description : flickr.contacts - fetch user's contact list.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.contacts API, fetching a user's contact list.+--------------------------------------------------------------------+module Flickr.Contacts where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++import Data.Maybe (maybeToList)++-- | Get a list of contacts for the calling user.+getList :: Maybe Filter -> FM [Contact]+getList f = withReadPerm $+  flickTranslate toContactList $+    flickCall "flickr.contacts.getList"+              (maybeToList (fmap (\ x -> ("filter",show x)) f))+	+-- | Get the contact list for a user.+getPublicList :: UserID -> FM [Contact]+getPublicList u = +  flickTranslate toContactList $+    flickCall "flickr.contacts.getPublicList"+              [ ("user_id", u) ]

@@ -0,0 +1,52 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Favorites+-- Description : flickr.favorites - manage favorite photos.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.favorites API, managing a user's favorite photos.+--------------------------------------------------------------------+module Flickr.Favorites where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Adds a photo to a user's favorites list.+add :: PhotoID -> FM ()+add pid = withWritePerm $ postMethod $+  flickCall_ "flickr.favorites.add"+             [ ("photo_id", pid) ]++-- | Removes a photo from a user's favorites list.+remove :: PhotoID -> FM ()+remove pid = withWritePerm $ postMethod $+  flickCall_ "flickr.favorites.remove"+             [ ("photo_id", pid) ]++-- | Returns a list of the user's favorite photos. +-- Only photos which the calling user has permission to see are returned.+getList :: Maybe UserID+        -> [PhotoInfo]+	-> FM (PhotoContext, [Photo])+getList uid ps = withReadPerm $+  flickTranslate toPhotoList $+   flickrCall "flickr.favorites.getList"+              (mbArg "user_id" uid $+	        lsArg "extras" (map show ps) [])+	+-- | Returns a list of favorite public photos for the given user.+getPublicList :: UserID+              -> [PhotoInfo]+              -> FM (PhotoContext, [Photo])+getPublicList uid ps = +  flickTranslate toPhotoList $+    flickrCall "flickr.favorites.getPublicList"+             (lsArg "extras" (map show ps) [("user_id", uid)])++	

@@ -0,0 +1,37 @@+--------------------------------------------------------------------+-- |+-- Module    : Flickr.Groups+-- Description : flickr.groups - search and browse groups/categories.+-- Copyright : (c) Sigbjorn Finne, 2008+-- License   : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: portable+--+-- flickr.groups API, traversing photo categories and groups.+--------------------------------------------------------------------+module Flickr.Groups where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++browse :: Maybe CategoryID -> FM Category+browse cid = withReadPerm $+ flickTranslate toCategory $+  flickrCall "flickr.groups.browse"+             (mbArg "cat_id" cid [])++getInfo :: GroupID -> Maybe String -> FM Group+getInfo gid lang = +  flickTranslate toGroup $+   flickrCall "flickr.groups.getInfo"+              (mbArg "lang" lang [("group_id", gid)])++search :: String+       -> FM [Group]+search txt = +  flickTranslate toGroupList $+   flickrCall "flickr.groups.search"+              [("text", txt)]

@@ -0,0 +1,63 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Groups.Pools
+-- Description : flickr.groups.pools - manage photo group pooling.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+--
+-- flickr.groups.pools API, manage photo group pooling.
+--------------------------------------------------------------------
+module Flickr.Groups.Pools where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+import Control.Monad ( liftM )
+
+-- | Add a photo to a group's pool.
+add :: PhotoID -> GroupID -> FM ()
+add pid gid = withWritePerm $ postMethod $ do
+   flickCall_ "flickr.groups.pools.add"
+              [ ("photo_id", pid)
+	      , ("group_id", gid)
+	      ]
+
+-- | Returns next and previous photos for a photo in a group pool.
+getContext :: PhotoID -> GroupID -> FM (Photo,Photo)
+getContext pid gid = 
+ flickTranslate toPhotoPair $
+  flickrCall "flickr.groups.pools.getContext"
+              [ ("photo_id", pid)
+	      , ("group_id", gid)
+	      ]
+             
+-- | Returns a list of groups to which you can add photos.
+getGroups :: FM [Group]
+getGroups = 
+ flickTranslate toGroupList $
+  flickrCall "flickr.groups.pools.getGroups"
+             []
+
+-- | Returns a list of pool photos for a given group, 
+-- based on the permissions of the group and the user logged in (if any).
+getPhotos :: GroupID -> [Tag] -> Maybe UserID -> [PhotoInfo] -> FM [Photo]
+getPhotos gid ts uid ps = liftM snd $
+  flickTranslate toPhotoList $
+   flickrCall "flickr.groups.Pools.getPhotos"
+              (lsArg "tags" ts $
+	        mbArg "user_id" uid $
+		 lsArg "extras" (map show ps)
+  	               [ ("group_id", gid) ])
+
+-- | Remove a photo from a group pool.
+remove :: PhotoID -> GroupID -> FM ()
+remove pid gid = withWritePerm $ postMethod $ 
+   flickCall_ "flickr.groups.pools.remove"
+              [ ("photo_id", pid)
+	      , ("group_id", gid)
+	      ]

@@ -0,0 +1,28 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Interestingness
+-- Description : fetch ranked photos by Flickr interest level.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
+-- Stability : provisional
+-- Portability: portable
+--
+-- Fetch ranked photos by Flickr interest level.
+--------------------------------------------------------------------
+module Flickr.Interestingness where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+import Control.Monad
+
+-- | Returns the list of interesting photos for the most recent day or a user-specified date.
+getList :: Maybe DateString -> [PhotoInfo] -> FM [Photo]
+getList d ps = liftM snd $
+ flickTranslate toPhotoList $
+  flickrCall "flickr.interestingness.getList"
+             (mbArg "date" d $
+	       lsArg "extras" (map show ps) [])

@@ -0,0 +1,78 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.People
+-- Description : flickr.people - access a user's attributes etc.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+--
+-- flickr.people API, accessing a user's attributes etc.
+-- <http://www.flickr.com/services/api/>
+--------------------------------------------------------------------
+module Flickr.People where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+import Flickr.Utils
+import Text.XML.Light.Proc   ( findChild )
+import Control.Monad
+
+-- | Return a user's NSID, given their email address
+findByEmail :: {-EMail-}String -> FM User
+findByEmail e = 
+ flickTranslate toUser $
+   flickrCall "flickr.people.findByEmail"
+              [ ("find_email", e) ]
+
+-- | Return a user's NSID, given their username.
+findByUsername :: UserName -> FM User
+findByUsername u = 
+ flickTranslate toUser $
+   flickrCall "flickr.people.findByUsername"
+              [ ("username", u) ]
+
+-- | Get information about a user.
+getInfo :: UserID -> Bool -> FM User
+getInfo uid authCall = (if authCall then withReadPerm else id) $ do
+  flickTranslate toUser $
+    flickCall "flickr.people.getInfo" 
+              [ ("user_id", uid) ]
+
+-- | Returns the list of public groups a user is a member of.
+getPublicGroups :: UserID -> FM [Group]
+getPublicGroups uid = 
+  flickTranslate toGroupList $
+    flickrCall "flickr.people.getPublicGroups"
+               [ ("user_id", uid) ]
+
+-- | Get a list of public photos for the given user.
+getPublicPhotos :: UserID -> Maybe Safety -> [PhotoInfo] -> FM [Photo]
+getPublicPhotos uid s ps = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.people.getPublicPhotos"
+               (mbArg "safe_search" (fmap (show.succ.fromEnum) s) $
+	         lsArg "extras" (map show ps) 
+		   [ ("user_id", uid) ])
+
+-- | Returns information for the calling user related to photo uploads.
+getUploadStatus :: FM (User, Bandwidth, FileSize, PhotosetQuota)
+getUploadStatus = 
+  flickTranslate toRes $
+    flickrCall "flickr.people.getUploadStatus" []
+ where
+  toRes s = parseDoc eltRes s
+  
+  eltRes e = do
+    u <- eltUser e
+    b <- findChild (nsName "bandwidth") e >>= eltBandwidth 
+    f <- findChild (nsName "filesize") e >>= eltFileSize
+    s <- findChild (nsName "sets") e >>= eltPhotosetQuota
+    return (u,b,f,s)
+    
+    
+    

@@ -0,0 +1,430 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Photos
+-- Description : flickr.photos - manage and access user photos.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+--
+-- flickr.photos API, searching, managing and access a user's photos.
+-- <http://www.flickr.com/services/api/>
+--------------------------------------------------------------------
+module Flickr.Photos where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+import Data.Maybe
+import Data.List
+import Flickr.Utils
+import Text.XML.Light.Proc   ( findChildren )
+import Control.Monad
+
+-- | Add tags to a photo.
+addTags :: PhotoID -> [Tag] -> FM ()
+addTags pid tgs = withWritePerm $ postMethod $ 
+  flickCall_ "flickr.photos.addTags"
+             (lsArg "tags" tgs 
+	            [ ("photo_id", pid) ])
+
+-- | Delete a photo from flickr.
+delete :: PhotoID -> FM ()
+delete pid = withDeletePerm $ postMethod $ 
+  flickCall_ "flickr.photos.delete"
+             [ ("photo_id", pid) ]
+
+-- | Returns all visible sets and pools the photo belongs to.
+getAllContexts :: PhotoID -> FM ([Photoset],[PhotoPool])
+getAllContexts pid = 
+  flickTranslate toResList $
+    flickrCall "flickr.photos.getAllContexts"
+               [ ("photo_id", pid) ]
+ where  
+  toResList s = parseDoc eltRes s
+  
+  eltRes e = do
+    let ss = mapMaybe eltPhotoset  $ findChildren (nsName "set") e
+    let ps = mapMaybe eltPhotoPool $ findChildren (nsName "pool") e
+    return (ss, ps)
+
+-- | Fetch a list of recent photos from the calling users' contacts.
+getContactsPhotos :: Maybe Int -> Maybe Bool -> Maybe Bool -> Maybe Bool -> [PhotoInfo] -> FM [Photo]
+getContactsPhotos mbCount just_friends single_photo include_self extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getContactsPhotos"
+               (mbArg "count" (fmap show mbCount) $
+	         mbArg "just_friends" (fmap showBool just_friends) $
+		  mbArg "single_photo" (fmap showBool single_photo) $
+ 		   mbArg "include_self" (fmap showBool include_self) $
+		    lsArg "extras" (map show extras) [])
+
+-- | Fetch a list of recent public photos from a users' contacts.
+getContactsPublicPhotos :: Maybe Int -> Maybe Bool -> Maybe Bool -> Maybe Bool -> [PhotoInfo] -> FM [Photo]
+getContactsPublicPhotos mbCount just_friends single_photo include_self extras  = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getContactsPublicPhotos"
+               (mbArg "count" (fmap show mbCount) $
+	         mbArg "just_friends" (fmap showBool just_friends) $
+		  mbArg "single_photo" (fmap showBool single_photo) $
+ 		   mbArg "include_self" (fmap showBool include_self) $
+		    lsArg "extras" (map show extras) [])
+
+-- | Fetch a list of recent photos from the calling users' contacts.
+getContext :: PhotoID -> FM (Photo,Photo)
+getContext pid = 
+  flickTranslate toPhotoPair $
+    flickrCall "flickr.photos.getContext"
+               [ ("photo_id", pid) ]
+
+-- | Gets a list of photo counts for the given date ranges for the calling user.
+getCounts :: [DateString] -> [DateString] -> FM [PhotoCount]
+getCounts unix_ts sql_ts = 
+  flickTranslate toPhotoCountList $
+    flickrCall "flickr.photos.getCounts"
+               (lsArg "dates"  unix_ts $
+	         lsArg "taken_dates" sql_ts [])
+
+-- | Retrieves a list of EXIF/TIFF/GPS tags for a given photo. The calling user 
+-- must have permission to view the photo.
+getExif :: PhotoID -> Maybe String -> FM [EXIF]
+getExif pid secret = 
+  flickTranslate toEXIFList $
+    flickrCall "flickr.photos.getExif"
+               (mbArg "secret"  secret 
+	         [ ("photo_id", pid) ])
+
+-- | Returns the list of people who have favorited a given photo.
+getFavorites :: PhotoID -> FM [(User,Date)]
+getFavorites pid = 
+  flickTranslate toResList $
+    flickrCall "flickr.photos.getFavorites"
+	         [ ("photo_id", pid) ]
+ where  
+  toResList s = parseDoc eltRes s
+  
+  eltRes e = do
+    let es = findChildren (nsName "person") e
+    mapM ( \ p -> do
+        fd <- pAttr "favedate" p
+	u  <- eltUser p
+	return (u,fd)) es
+
+-- | Get information about a photo. The calling user must have permission to view the photo.
+getInfo :: PhotoID -> Maybe String -> FM PhotoDetails
+getInfo pid secret = 
+  flickTranslate toPhotoDetails $
+    flickrCall "flickr.photos.getInfo"
+               (mbArg "secret"  secret 
+	         [ ("photo_id", pid) ])
+
+-- | Returns a list of your photos that are not part of any sets.
+getNotInSet :: Maybe DateInterval
+            -> Maybe DateInterval
+	    -> Maybe Privacy
+	    -> Maybe MediaType
+	    -> [PhotoInfo]
+	    -> FM [Photo]
+getNotInSet mbUpload mbTaken priv med extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getNotInSet"
+               (mbArg "min_upload_date"  mbUpload1 $
+	         mbArg "max_upload_date" mbUpload2 $
+		  mbArg "min_taken_date" mbTaken1  $
+ 		   mbArg "max_taken_date" mbTaken2 $
+		    mbArg "privacy_filter" (fmap (show.fromEnum) priv) $
+		     mbArg "media" (fmap show med) $
+		      lsArg "extras" (map show extras) [])
+ where
+  mbUpload1 = fmap fst mbUpload
+  mbUpload2 = mbUpload >>= \ x -> snd x
+
+  mbTaken1 = fmap fst mbTaken
+  mbTaken2 = mbTaken >>= \ x -> snd x
+  
+
+
+-- | Get permissions for a photo.
+getPerms :: PhotoID -> FM Permissions
+getPerms pid = withReadPerm $
+  flickTranslate toPermissions $
+    flickrCall "flickr.photos.getPerms"
+	       [ ("photo_id", pid) ]
+
+-- | Returns a list of the latest public photos uploaded to flickr.
+getRecent :: [PhotoInfo] -> FM [Photo]
+getRecent extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getRecent"
+	       (lsArg "extras" (map show extras) [])
+
+-- | Returns the available sizes for a photo. The calling user must have permission to view the photo.
+getSizes :: PhotoID -> FM [SizeDetails]
+getSizes pid = 
+  flickTranslate toSizeList $
+    flickrCall "flickr.photos.getSizes"
+	       [ ("photo_id", pid) ]
+
+-- | Returns a list of your photos with no tags.
+getUntagged :: Maybe DateInterval
+            -> Maybe DateInterval
+	    -> Maybe Privacy
+	    -> Maybe MediaType
+	    -> [PhotoInfo]
+	    -> FM [Photo]
+getUntagged mbUpload mbTaken priv med extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getUntagged"
+               (mbArg "min_upload_date"  mbUpload1 $
+	         mbArg "max_upload_date" mbUpload2 $
+		  mbArg "min_taken_date" mbTaken1  $
+ 		   mbArg "max_taken_date" mbTaken2 $
+		    mbArg "privacy_filter" (fmap (show.fromEnum) priv) $
+		     mbArg "media" (fmap show med) $
+		      lsArg "extras" (map show extras) [])
+ where
+  mbUpload1 = fmap fst mbUpload
+  mbUpload2 = mbUpload >>= \ x -> snd x
+
+  mbTaken1 = fmap fst mbTaken
+  mbTaken2 = mbTaken >>= \ x -> snd x
+  
+-- | Returns a list of your geo-tagged photos.
+getWithGeoData :: Maybe DateInterval
+	       -> Maybe DateInterval
+	       -> Maybe Privacy
+	       -> Maybe SortKey
+	       -> Maybe MediaType
+	       -> [PhotoInfo]
+	       -> FM [Photo]
+getWithGeoData mbUpload mbTaken priv sortKey med extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getWithGeoData"
+               (mbArg "min_upload_date"  mbUpload1 $
+	         mbArg "max_upload_date" mbUpload2 $
+		  mbArg "min_taken_date" mbTaken1  $
+ 		   mbArg "max_taken_date" mbTaken2 $
+		    mbArg "privacy_filter" (fmap (show.fromEnum) priv) $
+		     mbArg "sort" (fmap show sortKey) $
+ 		      mbArg "media" (fmap show med) $
+		       lsArg "extras" (map show extras) [])
+ where
+  mbUpload1 = fmap fst mbUpload
+  mbUpload2 = mbUpload >>= \ x -> snd x
+
+  mbTaken1 = fmap fst mbTaken
+  mbTaken2 = mbTaken >>= \ x -> snd x
+
+-- | Returns a list of your photos which haven't been geo-tagged.
+getWithoutGeoData :: Maybe DateInterval
+	          -> Maybe DateInterval
+	          -> Maybe Privacy
+	          -> Maybe SortKey
+	          -> Maybe MediaType
+	          -> [PhotoInfo]
+	          -> FM [Photo]
+getWithoutGeoData mbUpload mbTaken priv sortKey med extras = liftM snd $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.getWithoutGeoData"
+               (mbArg "min_upload_date"  mbUpload1 $
+	         mbArg "max_upload_date" mbUpload2 $
+		  mbArg "min_taken_date" mbTaken1  $
+ 		   mbArg "max_taken_date" mbTaken2 $
+		    mbArg "privacy_filter" (fmap (show.fromEnum) priv) $
+		     mbArg "sort" (fmap show sortKey) $
+ 		      mbArg "media" (fmap show med) $
+		       lsArg "extras" (map show extras) [])
+ where
+  mbUpload1 = fmap fst mbUpload
+  mbUpload2 = mbUpload >>= \ x -> snd x
+
+  mbTaken1 = fmap fst mbTaken
+  mbTaken2 = mbTaken >>= \ x -> snd x
+
+
+-- | Return a list of your photos that have been recently created or which have 
+-- been recently modified. Recently modified may mean that the photo's metadata (title, 
+-- description, tags) may have been changed or a comment has been 
+-- added (or just modified somehow :-)
+recentlyUpdated :: DateString -> [PhotoInfo] -> FM (PhotoContext, [Photo])
+recentlyUpdated minDate extras = withReadPerm $
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.recentlyUpdated"
+               (lsArg "extras" (map show extras) 
+	         [ ("min_date", minDate) ])
+
+-- | Remove a tag from a photo.
+removeTag :: Tag -> FM ()
+removeTag tag = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.removeTag"
+	       [ ("tag_id", tag) ]
+
+-- | Return a list of photos matching some criteria. Only photos 
+-- visible to the calling user will be returned. To return private 
+-- or semi-private photos, the caller must be authenticated 
+-- with 'read' permissions, and have permission to view the 
+-- photos. Unauthenticated calls will only return public photos.
+search :: Maybe UserID
+       -> SearchConstraints
+       -> [PhotoInfo]
+       -> FM (PhotoContext, [Photo])
+search uid sc extras = 
+  flickTranslate toPhotoList $
+    flickrCall "flickr.photos.search"
+               (mbArg "user_id" uid $
+	         lsArg "tags" (s_tags sc) $
+		 mbArg "tag_mode" (fmap (\ x -> if x then "all" else "any") (s_tag_mode sc)) $
+		   mbArg "text" (s_text sc) $
+		    mbArg "min_upload_date" mbUpload1 $
+		    mbArg "max_upload_date" mbUpload2 $
+		    mbArg "min_taken_date" mbTaken1 $
+		    mbArg "max_taken_date" mbTaken2 $
+		    mbArg "license" (fmap (intercalate ",") (s_license sc)) $
+		    mbArg "sort" (fmap show $ s_sort sc) $
+		    mbArg "privacy_filter" (fmap (show.fromEnum) $ s_privacy sc) $
+		    mbArg "bbox" (fmap show $ s_bbox sc) $
+		    mbArg "accuracy" (fmap show (s_accuracy sc)) $
+		    mbArg "safe_search" (fmap (show.succ.fromEnum) (s_safe_search sc)) $
+		    mbArg "content_type" (fmap (show.succ.fromEnum) (s_content_type sc)) $
+		    lsArg "machine_tags" (s_machine_tags sc) $
+		    mbArg "machine_tag_mode" (fmap (\ x -> if x then "all" else "any") (s_machine_tag_mode sc)) $
+		    mbArg "group_id" (s_group_id sc) $
+		    mbArg "contacts" (fmap (\ x -> if x then "all" else "ff") (s_contacts sc)) $
+		    mbArg "woe_id" (fmap show (s_woe_id sc)) $
+		    mbArg "place_id" (s_place_id sc) $
+		    mbArg "media"  (fmap show (s_media sc)) $
+		    mbArg "has_geo" (fmap showBool (s_has_geo sc)) $
+		    mbArg "lat" (s_lat sc) $
+		    mbArg "lon" (s_lon sc) $
+		    mbArg "radius" (s_radius sc) $
+		    mbArg "radius_units" (s_radius_units sc) $
+		    lsArg "extras" (map show extras) [])
+ where
+  mbUpload1 = fmap fst (s_upload sc)
+  mbUpload2 = (s_upload sc) >>= \ x -> snd x
+
+  mbTaken1 = fmap fst (s_taken sc)
+  mbTaken2 = (s_taken sc) >>= \ x -> snd x
+
+data SearchConstraints
+ = SearchConstraints
+     { s_tags         :: [Tag]
+     , s_tag_mode     :: Maybe Bool
+     , s_text         :: Maybe String
+     , s_upload       :: Maybe DateInterval
+     , s_taken        :: Maybe DateInterval
+     , s_license      :: Maybe [LicenseID]
+     , s_sort         :: Maybe SortKey
+     , s_privacy      :: Maybe Privacy
+     , s_bbox         :: Maybe BoundingBox
+     , s_accuracy     :: Maybe Accuracy
+     , s_safe_search  :: Maybe Safety
+     , s_content_type :: Maybe ContentType
+     , s_machine_tags :: [Tag]
+     , s_machine_tag_mode :: Maybe Bool
+     , s_group_id     :: Maybe GroupID
+     , s_contacts     :: Maybe Bool
+     , s_woe_id       :: Maybe WhereOnEarthID
+     , s_place_id     :: Maybe PlaceID
+     , s_media        :: Maybe MediaType
+     , s_has_geo      :: Maybe Bool
+     , s_lat          :: Maybe Decimal
+     , s_lon          :: Maybe Decimal
+     , s_radius       :: Maybe Decimal
+     , s_radius_units :: Maybe String
+     }
+
+nullSearchConstraints :: SearchConstraints
+nullSearchConstraints = SearchConstraints
+     { s_tags      = []
+     , s_tag_mode  = Nothing
+     , s_text      = Nothing
+     , s_upload    = Nothing
+     , s_taken     = Nothing
+     , s_license   = Nothing
+     , s_sort      = Nothing
+     , s_privacy   = Nothing
+     , s_bbox      = Nothing
+     , s_accuracy  = Nothing
+     , s_safe_search  = Nothing
+     , s_content_type = Nothing
+     , s_machine_tags = []
+     , s_machine_tag_mode = Nothing
+     , s_group_id = Nothing
+     , s_contacts = Nothing
+     , s_woe_id   = Nothing
+     , s_place_id = Nothing
+     , s_media    = Nothing
+     , s_has_geo  = Nothing
+     , s_lat      = Nothing
+     , s_lon      = Nothing
+     , s_radius   = Nothing
+     , s_radius_units = Nothing
+     }
+
+-- | Set the content type of a photo.
+setContentType :: PhotoID -> ContentType -> FM ()
+setContentType pid c = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setContentType"
+	       [ ("photo_id", pid)
+	       , ("content_type", showContentType c)
+	       ]
+
+-- | Set one or both of the dates for a photo.
+setDates :: PhotoID -> Maybe DateString -> Maybe DateString -> Maybe DateGranularity -> FM ()
+setDates pid datePosted dateTaken dateTakenGranularity = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setDates"
+	       (mbArg "date_posted" datePosted $
+	         mbArg "date_taken" dateTaken $
+		  mbArg "date_taken_granularity" (fmap show dateTakenGranularity) $
+		    [ ("photo_id", pid) ])
+
+-- | Set the meta information for a photo.
+setMeta :: PhotoID -> Title -> Description -> FM ()
+setMeta pid title desc = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setMeta"
+	       [ ("photo_id", pid)
+	       , ("title", title)
+	       , ("description", desc)
+	       ]
+
+-- | Set permissions for a photo.
+setPerms :: PhotoID -> Permissions -> FM ()
+setPerms pid p = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setPerms"
+               [ ("photo_id", pid)
+	       , ("is_public", showBool (permIsPublic p))
+	       , ("is_friend", showBool (permIsFriend p))
+	       , ("is_family", showBool (permIsFamily p))
+	       , ("perm_comment", show (permCommentLevel p))
+	       , ("perm_addmeta", show (permAddMetaLevel p))
+	       ]
+
+-- | Set the safety level of a photo.
+setSafetyLevel :: PhotoID -> Maybe Safety -> Maybe Bool -> FM ()
+setSafetyLevel pid mbSaf mbHid = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setSafetyLevel"
+	       (mbArg "safety_level" (fmap showSafety mbSaf) $
+	         mbArg "hidden" (fmap showBool mbHid) $
+		    [ ("photo_id", pid) ])
+
+-- | Set the tags for a photo.
+setTags :: PhotoID -> [Tag] -> FM ()
+setTags pid ts = withWritePerm $ postMethod $ 
+    flickCall_ "flickr.photos.setTags"
+	       (lsArg "tags" ts $
+		    [ ("photo_id", pid)])
+
+-- | locate the URL for the photo..local, non-Flickr, helper function.
+-- Returns '<unknown>' if cannot be located.
+getPhotoURL :: PhotoDetails -> URLString
+getPhotoURL p = 
+   case fromMaybe "" (photoURL (photoDetailsPhoto p)) of
+     "" -> case photoDetailsURLs p of
+             [] -> "<unknown>"
+	     (u:_) -> urlDetailsURL u
+     us -> us
+  

@@ -0,0 +1,55 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Comments+-- Description : flickr.photos.comments - setting/getting photo comments.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.comments API, setting/getting photo comments.+--------------------------------------------------------------------+module Flickr.Photos.Comments where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Add comment to a photo as the currently authenticated user.+addComment :: PhotoID -> String -> FM CommentID+addComment pid comm = withWritePerm $ postMethod $+  flickTranslate toCommentID $ +    flickrCall "flickr.photos.comments.addComment"+               [ ("photo_id", pid)+	       , ("comment_text", comm)+	       ]++-- | Delete a comment as the currently authenticated user.+deleteComment :: CommentID -> FM ()+deleteComment cid = withWritePerm $ postMethod $+    flickCall_ "flickr.photos.comments.deleteComment"+               [ ("comment_id", cid)+	       ]++-- | Edit the text of a comment as the currently authenticated user.+editComment :: CommentID -> String -> FM ()+editComment cid comm = withWritePerm $ postMethod $+    flickCall_ "flickr.photos.comments.editComment"+               [ ("comment_id", cid)+	       , ("comment_text", comm)+	       ]++-- | Returns the comments for a photo.+getList :: PhotoID -> FM [Comment]+getList pid = +  flickTranslate toCommentList $ +    flickrCall "flickr.photos.comments.getList"+               [ ("photo_id", pid)+	       ]+++++

@@ -0,0 +1,69 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Geo+-- Description : flickr.photos.geo - setting/getting photo geo location.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.geo API, setting/getting photo geo location.+--------------------------------------------------------------------+module Flickr.Photos.Geo where++import Flickr.Monad+import Flickr.Utils+import Flickr.Types+import Flickr.Types.Import++-- | Get the geo data (latitude and longitude and the accuracy level) for a photo.+getLocation :: PhotoID -> FM GeoLocation+getLocation pid = +  flickTranslate toGeoLocation $+    flickrCall "flickr.photos.geo.getLocation"+               [ ("photo_id", pid) ]++-- | Get permissions for who may view geo data for a photo.+getPerms :: PhotoID -> FM Permissions+getPerms pid = +  flickTranslate toPermissions $+    flickrCall "flickr.photos.geo.getPerms"+               [ ("photo_id", pid) ]++-- | Removes the geo data associated with a photo.+removeLocation :: PhotoID -> FM ()+removeLocation pid = withWritePerm $ postMethod $+    flickCall_ "flickr.photos.geo.removeLocation"+               [ ("photo_id", pid) ]++-- | Sets the geo data (latitude and longitude and, optionally,+-- the accuracy level) for a photo. Before users may assign+-- location data to a photo they must define who, by default,+-- may view that information. Users can edit this preference+-- at http://www.flickr.com/account/geo/privacy/. If a user+-- has not set this preference, the API method will return +-- an error.+setLocation :: PhotoID -> GeoLocation -> FM ()+setLocation pid (la,lo,ac) = withWritePerm $ postMethod $ +    flickCall_ "flickr.photos.geo.setLocation"+                 [ ("photo_id", pid)+	         , ("lat", la)+	         , ("lon", lo)+		 , ("accuracy", show ac)+	         ]++-- | Set the permission for who may view the geo data associated with a photo.+setPerms :: PhotoID -> Permissions -> FM ()+setPerms pid p = withWritePerm $ postMethod $ +    flickCall_ "flickr.photos.geo.setPerms"+               [ ("photo_id", pid)+	       , ("is_public",  showBool $ permIsPublic p)+	       , ("is_friend",  showBool $ permIsFriend p)+	       , ("is_family",  showBool $ permIsFamily p)+	       , ("is_contact", showBool (permIsFamily p || permIsFriend p))+	       ]+++

@@ -0,0 +1,33 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Licenses+-- Description : flickr.photos.licenses - setting/getting photo licensing.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.licenses API, setting/getting photo licensing.+--------------------------------------------------------------------+module Flickr.Photos.Licenses where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Fetches a list of available photo licenses for Flickr.+getInfo :: FM [License]+getInfo = +  flickTranslate toLicenseList $+   flickrCall "flickr.photos.licenses.getInfo"+              []++-- | Sets the license for a photo.+setLicense :: PhotoID -> LicenseID -> FM ()+setLicense pid lid = withWritePerm $ postMethod $+   flickCall_ "flickr.photos.licenses.setLicense"+              [ ("photo_id", pid)+	      , ("license_id", lid)+	      ]

@@ -0,0 +1,53 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Notes+-- Description : flickr.photos.notes - manage photo annotations.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.notes API, managing a user's photo annotations.+--------------------------------------------------------------------+module Flickr.Photos.Notes where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Add a note to a photo. Coordinates and sizes are in +-- pixels, based on the 500px image size shown on individual +-- photo pages.+add :: PhotoID -> Point -> Size -> String -> FM NoteID+add pid xy wh txt = withWritePerm $ postMethod $+  flickTranslate toNoteID $+    flickrCall "flickr.photos.notes.add"+               [ ("photo_id", pid)+	       , ("note_x",   show $ pointX xy)+	       , ("note_y",   show $ pointY xy)+	       , ("note_w",   show $ sizeW  wh)+	       , ("note_h",   show $ sizeH  wh)+	       , ("note_text", txt)+	       ]+++-- | Delete a note from a photo.+delete :: NoteID -> FM ()+delete nid = withWritePerm $ postMethod $ +  flickCall_ "flickr.photos.notes.delete"+             [ ("note_id", nid) ]++-- | Edit a note on a photo. Coordinates and sizes are in pixels, +-- based on the 500px image size shown on individual photo pages. +edit :: NoteID -> Point -> Size -> String -> FM ()+edit nid xy wh txt = withWritePerm $ postMethod $ +  flickCall_ "flickr.photos.notes.edit"+             [ ("note_id", nid)+	     , ("note_x",   show $ pointX xy)+	     , ("note_y",   show $ pointY xy)+	     , ("note_w",   show $ sizeW  wh)+	     , ("note_h",   show $ sizeH  wh)+	     , ("note_text", txt)+	     ]

@@ -0,0 +1,27 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Transform+-- Description : flickr.photos.transform - rotation, mostly.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.transform API, rotation only right now.+--------------------------------------------------------------------+module Flickr.Photos.Transform where++import Flickr.Monad+import Flickr.Types++-- | Rotate a photo.+rotate :: PhotoID -> Latitude -> FM ()+rotate pid d = withWritePerm $ postMethod $ +  flickCall_ "flickr.photos.transform.rotate"+             [ ("photo_id", pid)+	     , ("degrees", d)+	     ]++

@@ -0,0 +1,93 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photos.Upload+-- Description : flickr.photos.upload - check upload status.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photos.upload API, check status of upload API initiated actions.+--------------------------------------------------------------------+module Flickr.Photos.Upload where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import+import Flickr.Utils++import Text.XML.Light.Proc   ( strContent )++import Data.List++-- | Checks the status of one or more asynchronous photo upload tickets.+checkTickets :: [TicketID] -> FM [Ticket]+checkTickets tids = +  flickTranslate toTicketList $+    flickrCall "flickr.photos.upload.checkTickets"+               [ ("tickets", intercalate "," tids) ]++-- | Upload a photo, returning an upload id/ticket.+uploadPhoto :: FilePath     -- ^ local file to upload+            -> Maybe String -- ^ title+            -> Maybe String -- ^ description+	    -> [Tag]+	    -> UploadAttr+	    -> FM PhotoID+uploadPhoto photo title desc tgs attr = withWritePerm $ withBase upload_base $ postMethod $ +  flickTranslate toPhotoID $ +   flickCall ""+             (mbArg "title" title $+	      mbArg "description" desc $+	      lsArg "tags"  tgs $+	      mbArg "is_public" (fmap showBool $ uploadPublic attr) $ +	      mbArg "is_friend" (fmap showBool $ uploadFriend attr) $ +	      mbArg "is_family" (fmap showBool $ uploadFamily attr) $ +	      mbArg "safety_level"   (fmap showSafety $ uploadSafety attr) $ +	      mbArg "content_type"    (fmap showContentType $ uploadContentType attr) $ +	      mbArg "hidden"    (fmap showBool $ uploadHidden attr) [("photo",'@':photo)])++data UploadAttr+ = UploadAttr+     { uploadPublic :: Maybe Bool+     , uploadFriend :: Maybe Bool+     , uploadFamily :: Maybe Bool+     , uploadSafety :: Maybe Safety+     , uploadContentType :: Maybe ContentType+     , uploadHidden :: Maybe Bool+     }++nullUploadAttr :: UploadAttr+nullUploadAttr = UploadAttr+     { uploadPublic = Nothing+     , uploadFriend = Nothing+     , uploadFamily = Nothing+     , uploadSafety = Nothing+     , uploadContentType = Nothing+     , uploadHidden = Nothing+     }++-- | Upload a photo, returning an upload id/ticket.+replacePhoto :: FilePath     -- ^ local file to upload/replace.+             -> PhotoID+	     -> Maybe Bool+	     -> FM (String,String, PhotoID)+replacePhoto photo pid mbAsync = withWritePerm $ withBase replace_base $ postMethod $ +  flickTranslate toRes $ +   flickCall ""+             (mbArg "async" (fmap showBool mbAsync) $ +	            [ ("photo_id", pid)+		    , ("photo",'@':photo)+		    ])+ where +  toRes s = parseDoc eltRes s+  +  eltRes e = do+    s  <- pAttr "secret" e+    os <- pAttr "originalsecret" e+    return (s,os,strContent e)+++

@@ -0,0 +1,127 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photosets+-- Description : flickr.photosets - navigating and managing sets.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photosets API, navigating and managing photo sets.+--------------------------------------------------------------------+module Flickr.Photosets where++import Flickr.Monad+import Flickr.Types+import Flickr.Utils+import Flickr.Types.Import++import Data.List++-- | Add a photo to the end of an existing photoset.+addPhoto :: PhotosetID -> PhotoID -> FM ()+addPhoto psid pid = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.addPhoto"+             [ ("photoset_id", psid)+	     , ("photo_id", pid)+	     ]++-- | Create a new photoset for the calling user.+create :: String -> Maybe String -> PhotoID -> FM Photoset+create title mbDesc primPid = withWritePerm $ postMethod $+  flickTranslate toPhotoset $+   flickrCall "flickr.photosets.create"+              (mbArg "description" mbDesc $+                [ ("title", title)+	        , ("primary_photo_id", primPid)+	        ])++-- | Delete a photoset.+delete :: PhotosetID -> FM ()+delete psid = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.delete"+             [ ("photoset_id", psid)+	     ]++-- | Modify the meta-data for a photoset.+editMeta :: PhotosetID -> String -> Maybe String -> FM ()+editMeta psid title mbDesc = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.editMeta"+             (mbArg "description" mbDesc $+               [ ("photoset_id", psid)+	       , ("title", title)+	       ])++-- | Modify the photos in a photoset. Use this method to add, remove and re-order photos.+editPhotos :: PhotosetID -> PhotoID -> [PhotoID] -> FM ()+editPhotos psid primPhoto pids = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.editPhotos"+               [ ("photoset_id", psid)+	       , ("primary_photo_id", primPhoto)+	       , ("photo_ids", intercalate "," pids)+	       ]++-- | Returns next and previous photos for a photo in a set.+getContext :: PhotosetID -> PhotoID -> FM (Photo, Photo)+getContext psid pid = +  flickTranslate toPhotoPair $+   flickrCall "flickr.photosets.getContext"+                [ ("photo_id", pid)+	        , ("photoset_id", psid)+	        ]++-- | Gets information about a photoset.+getInfo :: PhotosetID -> FM Photoset+getInfo psid = +  flickTranslate toPhotoset $+   flickrCall "flickr.photosets.getInfo"+                [ ("photoset_id", psid)+	        ]++-- | Returns the photosets belonging to the specified user.+getList :: Maybe UserID -> FM (Bool, [Photoset])+getList mbUser = +  flickTranslate toRes $ +   flickrCall "flickr.photosets.getList"+              (mbArg "user_id" mbUser [])+ where+  toRes s = parseDoc eltRes s+  +  eltRes e = do+    u <- eltBool "cancreate" e+    ls <- mapM eltPhotoset (pNodes "photoset" (children e))+    return (u,ls)++-- | Get the list of photos in a set.+getPhotos :: PhotosetID+          -> [PhotoInfo]+	  -> Maybe Privacy+	  -> Maybe MediaType+	  -> FM Photoset+getPhotos psid extras priv med = + flickTranslate toPhotoset $+  flickrCall "flickr.photosets.getPhotos"+             (mbArg "privacy_filter" (fmap (show.fromEnum) priv) $+	      mbArg "media" (fmap show med) $ +	      lsArg "extras" (map show extras)+	       [ ("photoset_id", psid) ])++-- | Set the order of photosets for the calling user.+orderSets :: [PhotosetID] -> FM ()+orderSets psids = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.orderSets"+               [ ("photoset_ids", intercalate "," psids)+	       ]++-- | Remove a photo from a photoset.+removePhoto :: PhotosetID -> PhotoID -> FM ()+removePhoto psid pid = withWritePerm $ postMethod $+  flickCall_ "flickr.photosets.removePhoto"+             [ ("photoset_id", psid)+	     , ("photo_id", pid)+	     ]+++

@@ -0,0 +1,52 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Photosets.Comments+-- Description : flickr.photosets.comments - manage comments on photo sets.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.photosets.comments API, manage comments on photo sets.+--------------------------------------------------------------------+module Flickr.Photosets.Comments where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Add a comment to a photoset.+addComment :: PhotosetID -> String -> FM CommentID+addComment psid c = withWritePerm $ postMethod $+  flickTranslate toCommentID $ +    flickrCall "flickr.photosets.comments.addComment"+               [ ("photoset_id", psid)+	       , ("comment_text", c)+	       ]++-- | Delete a photoset comment as the currently authenticated user.+deleteComment :: CommentID -> FM ()+deleteComment cid = withWritePerm $ postMethod $+    flickCall_ "flickr.photosets.comments.deleteComment"+               [ ("comment_id", cid)+	       ]++-- | Edit the text of a comment as the currently authenticated user.+editComment :: CommentID -> String -> FM ()+editComment cid c = withWritePerm $ postMethod $+    flickCall_ "flickr.photosets.comments.editComment"+               [ ("comment_id", cid)+	       , ("comment_text", c)+	       ]++-- | Returns the comments for a photoset.+getList :: PhotosetID -> FM [Comment]+getList psid = +  flickTranslate toCommentList $ +    flickrCall "flickr.photosets.comments.getList"+               [ ("photoset_id", psid)+	       ]++

@@ -0,0 +1,80 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Places+-- Description : flickr.places - geo locating photos.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.places API, locating photos by places and geo.+--------------------------------------------------------------------+module Flickr.Places where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Return a list of place IDs for a query string.+-- The flickr.places.find method is not a geocoder. +-- It will round up to the nearest place type to +-- which place IDs apply. For example, if you pass +-- it a street level address it will return the city +-- that contains the address rather than the street, +-- or building, itself.+find :: String -> FM (PlaceQuery, [Place])+find q = +  flickTranslate toPlaces $ +    flickrCall "flickr.places.find"+               [("query", q)]++-- | Return a place ID for a latitude, longitude and accuracy triple.+-- +-- The flickr.places.findByLatLon method is not meant to be +-- a (reverse) geocoder in the traditional sense. It is designed+-- to allow users to find photos for "places" and will round+-- up to the nearest place type to which corresponding place IDs +-- apply.+-- +-- For example, if you pass it a street level coordinate it will +-- return the city that contains the point rather than the street, +-- or building, itself.+-- +-- It will also truncate latitudes and longitudes to three +-- decimal points.+findByLatLon :: Latitude -> Longitude -> Maybe Accuracy -> FM (PlaceQuery, [Place])+findByLatLon la lon acc = +  flickTranslate toPlaces $ +    flickCall "flickr.places.findByLatLon" +              (mbArg "accuracy" (fmap show acc) $+	         [("lat", la),("lon", lon)])++-- | Return a list of the top 100 unique places clustered by a given placetype for a user. +placesForUser :: PlaceType+              -> Maybe WhereOnEarthID+	      -> Maybe PlaceID+	      -> Maybe Threshold+	      -> FM [Place]+placesForUser pt woe_id pid th = withReadPerm $+ flickTranslate toPlacesList $+   flickCall "flickr.places.placesForUser" +             (mbArg "woe_id" woe_id  $ +	      mbArg "place_id" pid   $+	      mbArg "threshold" (fmap show th) $+  	            [("place_type", pt)])++-- | Find Flickr Places information by Place Id.+resolvePlaceId :: PlaceID -> FM LocationPlace+resolvePlaceId pid = +  flickTranslate toLocationPlace $+   flickrCall "flickr.places.resolvePlaceId" +              [("place_id", pid)]++-- | Find Flickr Places information by Place URL.+resolvePlaceURL :: URLString -> FM LocationPlace+resolvePlaceURL purl = +  flickTranslate toLocationPlace $+    flickrCall "flickr.places.resolvePlaceURL" +               [("url", purl)]

@@ -0,0 +1,50 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Prefs+-- Description : flickr.prefs - accessing user preferences.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- flickr.prefs API, accessing a user's preferences.+--------------------------------------------------------------------+module Flickr.Prefs where++import Flickr.Monad+import Flickr.Types+import Flickr.Types.Import++-- | Returns the default content type preference for the user.+getContentType :: FM ContentType+getContentType = withReadPerm $+ flickTranslate toContentType $+  flickCall "flickr.prefs.getContentType" []++-- | Returns the default privacy level for geographic information +-- attached to the user's photos. +getGeoPerms :: FM Privacy+getGeoPerms = withReadPerm $+  flickTranslate (toPrivacy "geoperms") $+   flickCall "flickr.prefs.getGeoPerms" []++-- | Returns the default hidden preference for the user.+getHidden :: FM Bool+getHidden = withReadPerm $+  flickTranslate (toBool "hidden") $+   flickCall "flickr.prefs.getHidden" []++-- | Returns the default privacy level preference for the user.+getPrivacy :: FM Privacy+getPrivacy = withReadPerm $+  flickTranslate (toPrivacy "privacy") $ +   flickCall "flickr.prefs.getPrivacy" []++-- | Returns the default safety level preference for the user.+getSafetyLevel :: FM Int+getSafetyLevel = withReadPerm $+  flickTranslate (toSafetyLevel "safety_level") $+   flickCall "flickr.prefs.getSafetyLevel" []+

@@ -0,0 +1,79 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Tags
+-- Description : flickr.tags - fetch photos by tag or cluster membership.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
+-- Stability : provisional
+-- Portability: portable
+--
+-- The flickr.tags API, fetching photos by tag or cluster membership.
+--------------------------------------------------------------------
+module Flickr.Tags where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+-- | Returns the first 24 photos for a given tag cluster.
+getClusterPhotos :: TagID -> ClusterID -> FM (PhotoContext, [Photo])
+getClusterPhotos t c = 
+   flickTranslate toPhotoList $
+     flickrCall "flickr.tags.getClusterPhotos"
+                [ ("tag", t)
+		, ("cluster_id", c)
+		]
+
+-- | Gives you a list of tag clusters for the given tag.
+getClusters :: Tag -> FM [Cluster]
+getClusters t = 
+  flickTranslate toClusterList $
+    flickrCall "flickr.tags.getClusters"
+               [ ("tag", t) ]
+
+-- | Returns a list of hot tags for the given period.
+getHotList :: Maybe DayWeek -> Maybe Int -> FM [TagDetails]
+getHotList period count = 
+  flickTranslate toTagDetailsList $
+    flickrCall "flickr.tags.getHotList"
+               (mbArg "period" (fmap (\ x -> if x then "day" else "week") period) $
+	        mbArg "count"  (fmap show count) [])
+
+-- | Get the tag list for a given photo.
+getListPhoto :: PhotoID -> FM [TagDetails]
+getListPhoto pid = 
+  flickTranslate toTagDetailsList $
+    flickrCall "flickr.tags.getListPhoto"
+               [ ("photo_id", pid) ]
+
+-- | Get the tag list for a given user (or the currently logged in user).
+getListUser :: Maybe UserID -> FM [TagDetails]
+getListUser mbid = 
+  flickTranslate toTagDetailsList $
+   flickrCall "flickr.tags.getListUser"
+              (mbArg "user_id" mbid [])
+
+-- | Get the popular tags for a given user (or the currently logged in user).
+getListUserPopular :: Maybe UserID -> Maybe Int -> FM [TagDetails]
+getListUserPopular uid c = 
+  flickTranslate toTagDetailsList $
+    flickrCall "flickr.tags.getListUserPopular"
+               (mbArg "user_id" uid $
+	        mbArg "count" (fmap show c) [])
+
+-- | Get the raw versions of a given tag (or all tags) for the currently logged-in user.
+getListUserRaw :: Maybe Tag -> FM [TagDetails]
+getListUserRaw t = 
+  flickTranslate toTagDetailsList $
+   flickrCall "flickr.tags.getListUserRaw"
+              (mbArg "tag" t [])
+
+-- | Returns a list of tags 'related' to the given tag, based on clustered usage analysis.
+getRelated :: Tag -> FM [TagDetails]
+getRelated t = 
+  flickTranslate toTagDetailsList $
+   flickrCall "flickr.tags.getRelated"
+              [ ("tag", t) ]
+

@@ -0,0 +1,563 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Types
+-- Description : Collection of Haskell types for Flickr
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+--
+-- Haskell rendering of types used and introduced by the Flickr API.
+--------------------------------------------------------------------
+module Flickr.Types where
+
+--import Flickr.Monad
+import Text.XML.Light.Types as XML
+
+
+-- these should come from somewhere else..
+type URLString = String
+type DateString = String
+type UserID     = String
+type UserName   = String
+type NSID       = UserID
+type PhotoID    = String
+type PhotosetID = String
+type BlogID     = String
+type CategoryID = String
+type ChatId     = String
+type Key        = String
+type Tag        = String
+type TagID      = Tag
+type Title      = String
+type Description = String
+type PlaceID    = String
+type GroupID    = String
+type WhereOnEarthID = String
+type LicenseID = String
+type CommentID = String
+type TicketID  = String
+type NoteID    = String
+type ClusterID = String
+type DayWeek   = Bool -- False => Day; True => Week
+type PermissionID = String
+
+type Date = DateString
+
+type DateInterval = (Date,Maybe Date)
+
+data AppInfo
+ = AppInfo
+      { appTitle       :: String
+      , appDescription :: String
+      , appLogo        :: URLString
+      , appAboutURL    :: Maybe URLString
+      }
+
+data Signature = Signature { sigComputed :: String }
+
+data AuthRequest
+ = AuthRequest
+     { authKey        :: Key
+     , authPermission :: String
+     , authFrob       :: Maybe AuthFrob
+     , authSig        :: Signature 
+     }
+     
+data AuthFrob = AuthFrob { aFrob :: String }
+
+type AuthTokenValue = String
+type AuthMiniToken  = String
+
+data AuthToken
+ = AuthToken
+     { authToken :: AuthTokenValue
+     , authPerms :: [String] -- many/one ?
+     , authUser  :: User
+     }
+
+data User
+ = User
+     { userName       :: UserName
+     , userId         :: String
+     , userFullName   :: Maybe String  -- aka 'real name'
+     , userIsAdmin    :: Maybe Bool
+     , userIsPro      :: Maybe Bool
+     , userLocation   :: Maybe String
+     , userProfileURL :: Maybe URLString
+     , userPhotosURL  :: Maybe URLString
+     , userPhotoStat  :: Maybe UserPhotoStat
+     , userAttrs      :: [XML.Attr]
+     }
+
+nullUser :: User
+nullUser
+ = User
+     { userName       = ""
+     , userId         = ""
+     , userFullName   = Nothing
+     , userIsAdmin    = Nothing
+     , userIsPro      = Nothing
+     , userLocation   = Nothing
+     , userProfileURL = Nothing
+     , userPhotosURL  = Nothing
+     , userPhotoStat  = Nothing
+     , userAttrs      = []
+     }
+
+
+data UserPhotoStat
+ = UserPhotoStat
+     { userPhotoFirst :: Maybe DateString
+     , userPhotoCount :: Maybe Int
+     }
+
+data Activity
+ = Activity
+     { actType    :: String
+     , actUser    :: User
+     , actDate    :: DateString
+     , actContent :: String
+     } 
+
+data Item
+ = Item
+     { itType     :: String
+     , itId       :: String
+     , itTitle    :: Maybe String
+     , itActivity :: Maybe [Activity]
+     , itOwner    :: UserID
+     , itSecret   :: String
+     , itServer   :: String
+     , itComments :: Integer
+     , itViews    :: Integer
+     , itPhotos   :: Integer
+     , itPrimary  :: Integer
+     , itMore     :: Bool
+     }
+     
+data Blog
+ = Blog
+     { blogId      :: BlogID
+     , blogName    :: String
+     , blogNeedsPW :: Bool
+     , blogURL     :: URLString
+     }
+
+data Photo
+ = Photo
+     { photoId     :: PhotoID
+     , photoTitle  :: String
+     , photoOwner  :: Maybe User
+     , photoSecret :: String
+     , photoServer :: Maybe Integer
+     , photoFarm   :: Maybe String
+     , photoURL    :: Maybe URLString
+     , photoLicense :: Maybe LicenseID
+     , photoPublic :: Maybe Bool
+     , photoFriend :: Maybe Bool
+     , photoFamily :: Maybe Bool
+     }
+
+data PhotoDetails
+ = PhotoDetails
+     { photoDetailsPhoto    :: Photo
+     , photoDetailsRotation :: Maybe Int
+     , photoDetailsLicense  :: Maybe LicenseID
+     , photoDetailsIsFavorite :: Maybe Bool
+     , photoDetailsIsPublic   :: Maybe Bool
+     , photoDetailsIsFamily   :: Maybe Bool
+     , photoDetailsIsFriend   :: Maybe Bool
+     , photoDetailsOrigFormat :: Maybe String
+     , photoDetailsOrigSecret :: Maybe String
+     , photoDetailsTitle    :: Maybe String
+     , photoDetailsDesc     :: Maybe String
+     , photoDetailsDates    :: PhotoDate
+     , photoDetailsPerms    :: Maybe (Int,Int)
+     , photoDetailsEdits    :: Maybe (Bool,Bool)
+     , photoDetailsComments :: Maybe Int
+     , photoDetailsNotes    :: [Note]
+     , photoDetailsTags     :: [TagDetails]
+     , photoDetailsURLs     :: [URLDetails]
+     }
+     
+data PhotoSize
+ = PhotoSizeSmallSquare
+ | PhotoSizeThumb
+ | PhotoSizeSmall
+ | PhotoSizeMedium
+ | PhotoSizeLarge
+ | PhotoSizeOriginal
+   deriving ( Eq, Enum )
+
+data PhotoDate
+ = PhotoDate
+     { photoDatePosted :: DateString
+     , photoDateTaken  :: DateString
+     , photoDateLastUpdate :: DateString     
+     , photoDateGranularity :: Maybe Int
+     }
+
+data Note
+ = Note 
+    { noteId         :: NoteID
+    , noteAuthor     :: UserID
+    , noteAuthorName :: UserName
+    , notePoint      :: Maybe Point
+    , noteSize       :: Maybe Size
+    , noteText       :: String
+    }
+
+data PhotoInfo
+ = PhotoLicense
+ | PhotoDateUpload
+ | PhotoDateTaken
+ | PhotoOwnerName
+ | PhotoIconServer
+ | PhotoOriginalFormat
+ | PhotoLastUpdate
+ | PhotoGeo
+ | PhotoTags
+ | PhotoMachineTags
+ | PhotoO_Dims
+ | PhotoViews
+ | PhotoMedia
+ 
+instance Show PhotoInfo where
+  show x = 
+   case x of
+     PhotoLicense -> "license"
+     PhotoDateUpload -> "date_upload"
+     PhotoDateTaken -> "date_taken"
+     PhotoOwnerName -> "owner_name"
+     PhotoIconServer -> "icon_server"
+     PhotoOriginalFormat -> "original_format"
+     PhotoLastUpdate     -> "last_update"
+     PhotoGeo -> "geo"
+     PhotoTags -> "tags"
+     PhotoMachineTags -> "machine_tags"
+     PhotoO_Dims -> "o_dims"
+     PhotoViews -> "views"
+     PhotoMedia -> "media"
+
+data Photoset
+ = Photoset 
+     { photosetId           :: PhotoID
+     , photosetOwner        :: UserID
+     , photosetPrimaryPhoto :: PhotoID
+     , photosetPhotos       :: Int
+     , photosetTitle        :: String
+     , photosetDescription  :: String
+     }
+
+data PhotoPool
+ = PhotoPool
+     { photoPoolId    :: PhotoID
+     , photoPoolTitle :: String
+     }
+     
+data PhotoContext
+ = PhotoContext
+     { photoCtxtPage    :: Maybe Int
+     , photoCtxtPages   :: Maybe Int
+     , photoCtxtPerPage :: Maybe Int
+     , photoCtxtTotal   :: Maybe Int
+     }
+
+
+data PhotoCount
+ = PhotoCount
+     { photoCount     :: Int
+     , photoCountFrom :: Date
+     , photoCountTo   :: Date
+     }
+
+data MediaType
+ = Photos
+ | Videos
+ | All
+
+instance Show MediaType where
+  show All = "all"
+  show Photos = "photos"
+  show Videos = "videos"
+ 
+data Privacy
+ = Public
+ | Contacts
+ | Private Bool{-for friends?-} Bool{-for family?-}
+
+instance Enum Privacy where
+  fromEnum x = 
+    case x of
+      Public -> 1
+      Contacts -> 2 -- hmm..
+      Private True False -> 2
+      Private False True -> 3
+      Private True True  -> 4
+      Private False False -> 5
+      
+  toEnum x = 
+   case x of
+     0 -> Public
+     1 -> Public
+     2 -> Private True False
+     3 -> Private False True
+     4 -> Private True True
+     5 -> Private False False
+     _ -> Contacts
+
+
+data SortKey
+ = SortKey
+      { sortKind :: String
+      , sortDir  :: AscDesc
+      }
+
+data AscDesc = Asc | Desc
+
+instance Show AscDesc where
+  show Asc = "asc"
+  show Desc = "desc"
+
+instance Show SortKey where
+ show x = sortKind x ++ '-':show (sortDir x)
+
+data EXIF
+ = EXIF
+   { exifTag      :: EXIFTag
+   , exifLabel    :: String
+   , exifRaw      :: Maybe String
+   , exifClean    :: Maybe String
+   }
+   
+data EXIFTag
+  = EXIFTag
+     { exifTagId      :: Tag
+     , exifTagspace   :: String
+     , exifTagspaceId :: Tag
+     }
+     
+data Safety 
+  = Safe | Moderate | Restricted
+    deriving ( Enum )
+
+showSafety :: Safety -> String
+showSafety s = show (succ (fromEnum s))
+
+type Decimal = String -- for now.
+
+type DateGranularity = Int
+ -- 0 => Y-m-d H:i:s
+ -- 4 => Y-m
+ -- 6 => Y
+
+data ContentType 
+ = ContentPhoto | ContentScreenshot | ContentOther
+   deriving ( Enum )
+	
+showContentType :: ContentType -> String
+showContentType c = show (succ (fromEnum c))
+
+type Latitude  = Decimal
+type Longitude = Decimal
+type GeoLocation = (Latitude, Longitude, Accuracy)
+
+data LocationPlace
+ = LocationPlace
+     { locationPlaceId      :: PlaceID
+     , locationPlaceWOEId   :: WhereOnEarthID
+     , locationPlaceLat     :: Latitude
+     , locationPlaceLong    :: Longitude
+     , locationPlaceURL     :: URLString
+     , locationPlaceType    :: PlaceType
+     , locationPlaceDetails :: [LocationPlace]
+     , locationPlaceDesc    :: String
+     }
+
+type Accuracy = Int -- range: 1-16
+ -- 1 => World level
+ -- 3 => Country
+ -- 6 => Region
+ -- 11 => City
+ -- 16 => Street
+
+data BoundingBox
+ = BoundingBox
+    { bboxMinLongitude :: Int
+    , bboxMinLatitude  :: Int
+    , bboxMaxLongitude :: Int -- [-180...180]
+    , bboxMaxLatitude  :: Int -- [-90..90]
+    }
+
+instance Show BoundingBox where
+ show x = shows (bboxMinLongitude x) 
+            (',':shows (bboxMinLatitude x) 
+	       (',':shows (bboxMaxLongitude x)
+ 	        (',':shows (bboxMaxLatitude x) "")))
+    
+data Size = Size { sizeW :: Int, sizeH :: Int}
+data Point = Point { pointX :: Int, pointY :: Int}
+
+data Comment
+ = Comment { commentId     :: CommentID
+           , commentAuthor :: User
+	   , commentDate   :: Date
+	   , commentURL    :: Maybe URLString
+	   , commentText   :: String
+	   }
+	   
+data Permissions
+ = Permissions
+      { permId         :: PermissionID
+      , permIsPublic   :: Bool
+      , permIsFriend   :: Bool
+      , permIsFamily   :: Bool
+      , permCommentLevel :: Int  -- 0 = nobody, 1 = friends&fam, 2 = contacts, 3 = everybody
+      , permAddMetaLevel :: Int -- same
+      }
+      
+data Ticket
+ = Ticket
+      { ticketId       :: TicketID
+      , ticketComplete :: Int
+      , ticketInvalid  :: Bool
+      , ticketPhoto    :: PhotoID
+      }
+      
+data License
+ = License { licenseId :: LicenseID
+           , licenseName :: String
+	   , licenseLink :: URLString
+	   }
+	   
+ 
+data PlaceQuery 
+ = PlaceQuery 
+     { placeQuery          :: Maybe String
+     , placeQueryLatitude  :: Maybe Decimal
+     , placeQueryLongitude :: Maybe Decimal
+     , placeQueryAccuracy  :: Maybe Accuracy
+     , placeTotal          :: Int
+     }
+
+type Threshold = Int
+
+type PlaceType = String
+
+data Place
+ = Place
+     { placeId    :: PlaceID
+     , placeWOEId :: WhereOnEarthID
+     , placeLat   :: Decimal
+     , placeLong  :: Decimal
+     , placeURL   :: URLString
+     , placeType  :: PlaceType -- accuracy string.
+     , placeDesc  :: String
+     }
+
+
+data GroupCat
+ = SubCat SubCategory
+ | AGroup Group
+ 
+data Category
+ = Category
+    { catName   :: String
+    , catId     :: Maybe CategoryID
+    , catPath   :: String
+    , catPaths  :: String
+    , catSubs   :: [GroupCat]
+    }
+
+data Group
+ = Group
+    { groupId       :: GroupID
+    , groupName     :: String
+    , groupMembers  :: Maybe Integer
+    , groupIsOnline :: Maybe Integer
+    , groupChatId   :: Maybe ChatId
+    , groupInChat   :: Maybe Integer
+    }
+    
+data SubCategory
+ = SubCategory
+    { subCatId :: CategoryID
+    , subName  :: String
+    , subCount :: Integer
+    }
+
+data FileSize
+ = FileSize
+    { fileSizeBytes :: Integer
+    , fileSizeKB    :: Maybe Integer
+    }
+
+data Bandwidth
+ = Bandwidth
+    { bandWidthBytes          :: Integer
+    , bandWidthKB             :: Maybe Integer
+    , bandWidthUsedBytes      :: Integer
+    , bandWidthUsedKB         :: Maybe Integer
+    , bandWidthRemainingBytes :: Integer
+    , bandWidthRemainingKB    :: Maybe Integer
+    }
+
+data PhotosetQuota
+ = PhotosetQuota
+    { photosetCreated   :: Integer
+    , photosetRemaining :: Maybe Int  -- Nothing => unlimited/lots (pro users)
+    }
+
+data Cluster
+ = Cluster
+    { clusterTags  :: [Tag]
+    , clusterCount :: Int
+    }
+
+data TagDetails
+ = TagDetails
+    { tagDetailsId     :: TagID
+    , tagDetailsAuthor :: UserID
+    , tagDetailsRaw    :: [String]
+    , tagDetailsName   :: String
+    , tagDetailsCount  :: Maybe Int
+    , tagDetailsScore  :: Maybe Int
+    }
+
+data URLDetails
+ = URLDetails
+    { urlDetailsURL  :: URLString
+    , urlDetailsType :: String
+    }
+
+data Filter = Friends | Family | Both | Neither
+
+instance Show Filter where
+  show x = 
+    case x of
+      Friends -> "friends"
+      Family  -> "family"
+      Both    -> "both"
+      Neither -> "neither"
+
+data Contact
+ = Contact
+     { conId       :: String
+     , conUser     :: User
+     , conIcon     :: Maybe Bool
+     , conIsFriend :: Maybe Bool
+     , conIsFamily :: Maybe Bool
+     , conIgnored  :: Maybe Bool
+     }
+
+data SizeDetails
+ = SizeDetails 
+     { sizeDetailsLabel  :: String
+     , sizeDetailsWidth  :: Int
+     , sizeDetailsHeight :: Int
+     , sizeDetailsSource :: URLString
+     , sizeDetailsURL    :: URLString
+     }

@@ -0,0 +1,806 @@+--------------------------------------------------------------------+-- |+-- Module      : Flickr.Types.Import+-- Description : Parsing Flickr API responses.+-- Copyright   : (c) Sigbjorn Finne, 2008+-- License     : BSD3+--+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>+-- Stability   : provisional+-- Portability : portable+--+-- Translating XML responses into Haskell type representations+-- of the Flickr API resources/entities/types.+--------------------------------------------------------------------+module Flickr.Types.Import where++import Flickr.Types+import Flickr.Utils+import Flickr.Monad ( parseDoc, ErrM )++import Control.Monad ( guard, mplus )+import Data.Char ( toLower )+import Data.Maybe ( mapMaybe )++import Text.XML.Light.Types+import Text.XML.Light.Proc   ( strContent, findChild )++toAuthFrob :: String -> ErrM AuthFrob+toAuthFrob s = parseDoc eltAuthFrob s++eltAuthFrob :: Element -> Maybe AuthFrob+eltAuthFrob e = do+  guard (elName e == nsName "frob")+  return AuthFrob{aFrob = strContent e}++toAuthToken :: String -> ErrM AuthToken+toAuthToken s = parseDoc eltAuthToken s++eltAuthToken :: Element -> Maybe AuthToken+eltAuthToken e = ifNamed "auth" e $ do+  let es = children e+  t    <- pLeaf "token" es+  p    <- pLeaf "perms" es+  user <- pNode "user" es >>= eltUser+  return AuthToken{ authToken = t+                  , authPerms = words p+		  , authUser = user+		  }+		  +toUser :: String -> ErrM User+toUser s = parseDoc eltUser s++eltUser :: Element -> Maybe User+eltUser u = do+  nid   <- pAttr "nsid" u `mplus` pAttr "id" u +  uname <- pAttr "username" u `mplus` (fmap strContent $ findChild (nsName "username") u)+  let fname = pAttr "fullname" u `mplus` (fmap strContent $ findChild (nsName "realname") u )+  let pro   = eltBool "ispro" u+  let adm   = eltBool "isadmin" u+  return +     nullUser{ userName     = uname+             , userId       = nid+	     , userFullName = fname+	     , userIsPro    = pro+	     , userIsAdmin  = adm+	     }++toGroupList :: String -> ErrM [Group]+toGroupList s = parseDoc eltGroupList s++eltGroupList :: Element -> Maybe [Group]+eltGroupList e = ifNamed "groups" e $ do+  let ls = pNodes "group" (children e)+  mapM eltGroup ls++toGroup :: String -> ErrM Group+toGroup s = parseDoc eltGroup s++eltGroup :: Element -> Maybe Group+eltGroup u = ifNamed "group" u $ do+  nid   <- pAttr "nsid" u `mplus` pAttr "id" u +  gname <- pAttr "groupname" u `mplus` (fmap strContent $ findChild (nsName "groupname") u)+  return +     Group{ groupId      = nid+          , groupName    = gname+	  , groupMembers  = fmap fromIntegral $ eltIntAttr "members" u+	  , groupIsOnline = fmap fromIntegral $ eltIntAttr "members" u+	  , groupChatId   = pAttr "chatid" u `mplus` pAttr "chatnsid" u +	  , groupInChat   = fmap fromIntegral $ eltIntAttr "inchat" u+	  }++toPlaces :: String -> ErrM (PlaceQuery,[Place])+toPlaces s = parseDoc eltPlaces s++toPlacesList :: String -> ErrM [Place]+toPlacesList s = parseDoc eltPlacesList s++eltPlaceQuery :: Element -> Maybe PlaceQuery+eltPlaceQuery e = ifNamed "places" e $ do+   let qu = pAttr "query" e+   let la = pAttr "latitude" e+   let lo = pAttr "longitude" e+   let ac = pAttr "accuracy" e >>= readMb+   t <- pAttr "total" e >>= readMb+   return +    PlaceQuery+      { placeQuery          = qu+      , placeQueryLatitude  = la+      , placeQueryLongitude = lo+      , placeQueryAccuracy  = ac+      , placeTotal = t+      }+   +eltPlaces :: Element -> Maybe (PlaceQuery, [Place])+eltPlaces e = ifNamed "places" e $ do+  q  <- eltPlaceQuery e+  let ls = pNodes "place" (children e)+  ps <- mapM eltPlace ls+  return (q, ps)++eltPlacesList :: Element -> Maybe [Place]+eltPlacesList e = ifNamed "places" e $ do+  let ls = pNodes "place" (children e)+  mapM eltPlace ls++eltPlace :: Element -> Maybe Place+eltPlace e = ifNamed "place" e $ do+  pid   <- pAttr "place_id" e+  woeid <- pAttr "woeid" e+  lat   <- pAttr "latitude" e+  long  <- pAttr "longitude" e+  url   <- pAttr "place_url" e+  ty    <- pAttr "place_type" e+  let d = strContent e+  return Place +    { placeId = pid+    , placeWOEId = woeid+    , placeLat = lat+    , placeLong = long+    , placeURL  = url+    , placeType = ty+    , placeDesc = d+    }+  +toBlogs :: String -> ErrM [Blog]+toBlogs s = parseDoc eltBlogsList s++eltBlogsList :: Element -> Maybe [Blog]+eltBlogsList e = ifNamed "blogs" e $ do+  let ls = pNodes "blog" (children e)+  mapM eltBlog ls++eltBlog :: Element -> Maybe Blog+eltBlog e = ifNamed "blog" e $ do+  bid   <- pAttr "id" e+  nm    <- pAttr "name" e+  npwd  <- eltBool "needspassword" e+  url   <- pAttr "url" e+  return Blog+    { blogId      = bid+    , blogName    = nm+    , blogNeedsPW = npwd+    , blogURL     = url+    }++toLocationPlace :: String -> ErrM LocationPlace+toLocationPlace s = parseDoc eltLocationPlace s++eltLocationPlace :: Element -> Maybe LocationPlace+eltLocationPlace e = do+  pid   <- pAttr "place_id" e+  woeid <- pAttr "woeid" e+  lat   <- pAttr "latitude" e+  long  <- pAttr "longitude" e+  url   <- pAttr "place_url" e+  let ty  = fromMaybe (qName $ elName e) $ pAttr "place_type" e+  let d = strContent e+  cs    <- mapM eltLocationPlace (children e)+  return LocationPlace+    { locationPlaceId = pid+    , locationPlaceWOEId = woeid+    , locationPlaceLat = lat+    , locationPlaceLong = long+    , locationPlaceURL  = url+    , locationPlaceType = ty+    , locationPlaceDesc = d+    , locationPlaceDetails = cs+    }++toContentType :: String -> ErrM ContentType+toContentType s = parseDoc eltContentType s++eltContentType :: Element -> Maybe ContentType+eltContentType e = do+  x <- pAttr "content_type" e+  let getV ((v,_):_) = Just (v::Int)+      getV _ = Nothing+  case getV $ reads x of+    Just 1 -> return ContentPhoto+    Just 2 -> return ContentScreenshot+    _      -> return ContentOther++toPrivacy :: String -> String -> ErrM Privacy+toPrivacy x s = parseDoc (eltPrivacy x) s++eltPrivacy :: String -> Element -> Maybe Privacy+eltPrivacy tg e = do+  x <- pAttr tg e+  let getV ((v,_):_) = Just (v::Int)+      getV _ = Nothing+  case getV $ reads x of+    Just 0 -> return Public+    Just 1 -> return Public+    Just 2 -> return (Private False False)+    Just 3 -> return (Private True{-friends-} True{-family-})+    Just 4 -> return (Private True{-friends-} False{-family-})+    Just 5 -> return (Private False{-friends-} True{-family-})+    Just 6 -> return (Private False{-friends-} True{-family-})+    _ -> fail ("unexpected privacy setting: " ++ x)++toBool :: String -> String -> ErrM Bool+toBool x s = parseDoc (eltBool x) s++eltBool :: String -> Element -> Maybe Bool+eltBool tg e = do+  x <- pAttr tg e+  let getV ((v,_):_) = Just (v::Int)+      getV _ = Nothing+  case getV $ reads x of+    Just 0 -> return False+    Just 1 -> return True+    _ -> case map toLower x of+          "true"  -> return True+	  "false" -> return False+	  _ -> fail ("unexpected bool value: " ++ x)++toSafetyLevel :: String -> String -> ErrM Int+toSafetyLevel x s = parseDoc (eltIntAttr x) s++eltIntAttr :: String -> Element -> Maybe Int+eltIntAttr tg e = do+  x <- pAttr tg e+  let getV ((v,_):_) = Just (v::Int)+      getV _ = Nothing+  case getV $ reads x of+    Just v -> return v+    _      -> fail ("unexpected non-Int value: " ++ x)++toString :: String -> String -> ErrM String+toString x s = parseDoc (eltStringAttr x) s++eltStringAttr :: String -> Element -> Maybe String+eltStringAttr tg e = pAttr tg e++toItems :: String -> ErrM [Item]+toItems s = parseDoc eltItems s++eltItems :: Element -> Maybe [Item]+eltItems e = ifNamed "items" e $ do+  let ls = pNodes "item" (children e)+  mapM eltItem ls+  +eltItem :: Element -> Maybe Item+eltItem e = ifNamed "item" e $ do+  ty     <- pAttr "type" e+  iid    <- pAttr "id" e+  own    <- pAttr "owner" e+  prim   <- eltIntAttr "primary" e+  serv   <- pAttr "server" e+  sec    <- pAttr "secret" e+  let comold = fromMaybe 0 $ eltIntAttr "commentsold" e+      comnew = fromMaybe 0 $ eltIntAttr "commentsnew" e+      +      com     = fromMaybe 0 $ eltIntAttr "comments" e+  vie    <- eltIntAttr "views" e+  npho   <- eltIntAttr "photos" e+  more   <- eltBool "more" e+  let tit = fmap strContent $ findChild (nsName "title") e+  let act = findChild (nsName "activity") e >>= eltActivity+  return Item+     { itType     = ty+     , itId       = iid+     , itTitle    = tit+     , itActivity = act+     , itOwner    = own+     , itSecret   = sec+     , itServer   = serv+     , itPhotos   = fromIntegral npho+     , itPrimary  = fromIntegral prim+     , itComments = fromIntegral (com + comold + comnew)+     , itViews    = fromIntegral vie+     , itMore     = more+     }+    +eltActivity :: Element -> Maybe [Activity]+eltActivity e = do+  let es = pNodes "event" (children e)+  mapM eltEvent es++eltEvent :: Element -> Maybe Activity+eltEvent e = do+  ty  <- pAttr "type" e+  uid <- pAttr "user" e+  usr <- pAttr "username" e+  dat <- pAttr "dateadded" e+  let s = strContent e+  return Activity+    { actType = ty+    , actUser = nullUser{userName=usr,userId=uid}+    , actDate = dat+    , actContent = s+    }++toContactList :: String -> ErrM [Contact]+toContactList s = parseDoc eltContactList s++eltContactList :: Element -> Maybe [Contact]+eltContactList e = ifNamed "contacts" e $ do+  let ls = pNodes "contact" (children e)+  mapM eltContact ls++eltContact :: Element -> Maybe Contact+eltContact e = do+  cid <- pAttr "nsid" e+  usr <- eltUser e+  let ico = eltBool "iconserver" e+  let fri = eltBool "friend" e+  let fam = eltBool "family" e+  let ign = eltBool "ignored" e+  return Contact+    { conId = cid+    , conUser = usr+    , conIcon = ico+    , conIsFriend = fri+    , conIsFamily = fam+    , conIgnored  = ign+    }+     +  +toPhotoList :: String -> ErrM (PhotoContext, [Photo])+toPhotoList s = parseDoc eltPhotoList s++toPhotoPair :: String -> ErrM (Photo,Photo)+toPhotoPair s = parseDoc eltPhotoPair s++eltPhotoList :: Element -> Maybe (PhotoContext, [Photo])+eltPhotoList e = ifNamed "photos" e $ do+  ls <- mapM eltPhoto $ pNodes "photo" (children e)+  c  <- eltPhotoContext e+  return (c, ls)++eltPhotoPair :: Element -> Maybe (Photo, Photo)+eltPhotoPair e = do+  f <- findChild (nsName "prevphoto") e >>= eltPhoto +  s <- findChild (nsName "nextphoto") e >>= eltPhoto +  return (f,s)++++eltPhoto :: Element -> Maybe Photo+eltPhoto e = do+  pid <- pAttr "id" e+  let own = pAttr "owner" e+  sec <- pAttr "secret" e+  tit <- pAttr "title" e `mplus` fmap strContent (findChild (nsName "title") e)+  let url = pAttr "url" e+  return Photo+     { photoId      = pid+     , photoOwner   = fmap (\ x -> nullUser{userId=x}) own+     , photoURL     = url+     , photoSecret  = sec+     , photoServer  = fmap fromIntegral (eltIntAttr "server" e)+     , photoFarm    = pAttr "farm" e+     , photoLicense = pAttr "license" e+     , photoTitle   = tit+     , photoPublic  = eltBool "ispublic" e+     , photoFriend  = eltBool "isfriend" e+     , photoFamily  = eltBool "isfamily" e+     }++eltPhotoContext :: Element -> Maybe PhotoContext+eltPhotoContext e = + return PhotoContext+     { photoCtxtPage    = eltIntAttr "page" e+     , photoCtxtPages   = eltIntAttr "pages" e+     , photoCtxtPerPage = eltIntAttr "perpage" e+     , photoCtxtTotal   = eltIntAttr "total" e+     }++toCategory :: String -> ErrM Category+toCategory s = parseDoc eltCategory s++eltCategory :: Element -> Maybe Category+eltCategory e = do+  nm  <- pAttr "name" e+  pth <- pAttr "path" e+  let mid = pAttr "id" e+  pts <- pAttr "pathids" e+  let ls = children e+  let cs  = mapMaybe eltGroupCat ls+  return Category+   { catName = nm+   , catId   = mid+   , catPath = pth+   , catPaths = pts+   , catSubs  = cs+   }+  +eltGroupCat :: Element -> Maybe GroupCat+eltGroupCat e + | elName e == nsName "subcat" = eltSubCategory e >>= \ x -> return (SubCat x)+ | elName e == nsName "group"  = eltGroup e  >>= \ x -> return (AGroup x)+ | otherwise = Nothing++eltSubCategory :: Element -> Maybe SubCategory+eltSubCategory e = do+  cid <- pAttr "id" e+  nm  <- pAttr "name" e+  c   <- eltIntAttr "count" e+  return SubCategory+    { subCatId = cid+    , subName  = nm+    , subCount = fromIntegral c+    }++eltBandwidth :: Element -> Maybe Bandwidth+eltBandwidth e = do+  mx <- eltIntAttr "maxbytes" e+  let xkb = eltIntAttr "maxkb" e+  us <- eltIntAttr "usedbytes" e+  let uskb = eltIntAttr "usedkb" e+  re <- eltIntAttr "remainingbytes" e+  let rekb = eltIntAttr "remainingkb" e+  return Bandwidth+    { bandWidthBytes          = fromIntegral mx+    , bandWidthKB             = fmap fromIntegral xkb+    , bandWidthUsedBytes      = fromIntegral us+    , bandWidthUsedKB         = fmap fromIntegral uskb+    , bandWidthRemainingBytes = fromIntegral re+    , bandWidthRemainingKB    = fmap fromIntegral rekb+    }++eltFileSize :: Element -> Maybe FileSize+eltFileSize e = do+  fs <- eltIntAttr "maxbytes" e+  let fskb = eltIntAttr "maxkb" e+  return FileSize+    { fileSizeBytes = fromIntegral fs+    , fileSizeKB    = fmap fromIntegral fskb+    }++eltPhotosetQuota :: Element -> Maybe PhotosetQuota+eltPhotosetQuota e = do+  c <- eltIntAttr "created" e+  z <- pAttr "remaining" e+  let +   f = case z of+        "remaining" -> Nothing+	x -> case reads x of+	      ((v,_):_) -> Just v+	      _ -> Nothing+  return PhotosetQuota+    { photosetCreated = fromIntegral c+    , photosetRemaining = f+    }++toPhotoset :: String -> ErrM Photoset+toPhotoset s = parseDoc eltPhotoset s++eltPhotoset :: Element -> Maybe Photoset+eltPhotoset e = do+  pid <- pAttr "id" e+  uid <- pAttr "owner" e+  prim <- pAttr "primary" e+  c    <- eltIntAttr "photos" e+  tit  <- pAttr "title" e+  desc <- pAttr "description" e+  return Photoset+     { photosetId           = pid+     , photosetOwner        = uid+     , photosetPrimaryPhoto = prim+     , photosetPhotos       = c+     , photosetTitle        = tit+     , photosetDescription  = desc+     }++toPhotoPool :: String -> ErrM PhotoPool+toPhotoPool s = parseDoc eltPhotoPool s++eltPhotoPool :: Element -> Maybe PhotoPool+eltPhotoPool e = do+  pid <- pAttr "id" e+  tit <- pAttr "title" e+  return PhotoPool+    { photoPoolId = pid+    , photoPoolTitle = tit+    }++toPhotoDetails :: String -> ErrM PhotoDetails+toPhotoDetails s = parseDoc eltPhotoDetails s++eltPhotoDetails :: Element -> Maybe PhotoDetails+eltPhotoDetails e = do+  ph  <- eltPhoto e+  let+   rot = eltIntAttr "rotation" e+   fav = eltBool "isfavorite" e+   lic = pAttr "license" e+   ofm = pAttr "originalformat" e+   ose = pAttr "originalsecret" e+   tit = fmap strContent (findChild (nsName "title") e)+   des = fmap strContent (findChild (nsName "description") e)++   es = children e++   isp = pNode "visibility" es >>= eltBool "ispublic"+   fam = pNode "visibility" es >>= eltBool "isfamily"+   fri = pNode "visibility" es >>= eltBool "isfriend"++   per = do+     ch <- pNode "permissions" es+     a  <- eltIntAttr "permcomment" ch+     b  <- eltIntAttr "permaddmeta" ch+     return (a,b)++   edi = do+     ch <- pNode "editability" es+     a  <- eltBool "cancomment" ch+     b  <- eltBool "canaddmeta" ch+     return (a,b)+   ns = mapMaybe eltNote (fromMaybe [] $ fmap children $ pNode "notes" es)+   ts = mapMaybe eltTagDetails (fromMaybe [] $ fmap children $ pNode "tags" es)+   us = mapMaybe eltURLDetails (fromMaybe [] $ fmap children $ pNode "urls" es)++  d   <- pNode "dates" es >>= eltPhotoDate     +  return PhotoDetails+     { photoDetailsPhoto       = ph+     , photoDetailsRotation    = rot+     , photoDetailsLicense     = lic+     , photoDetailsIsFavorite  = fav+     , photoDetailsIsPublic    = isp+     , photoDetailsIsFamily    = fam+     , photoDetailsIsFriend    = fri+     , photoDetailsOrigFormat  = ofm+     , photoDetailsOrigSecret  = ose+     , photoDetailsTitle       = tit+     , photoDetailsDesc        = des+     , photoDetailsDates       = d+     , photoDetailsPerms       = per+     , photoDetailsEdits       = edi+     , photoDetailsComments    = pNode "comments" es >>= intContent+     , photoDetailsNotes       = ns+     , photoDetailsTags        = ts+     , photoDetailsURLs        = us+     }++eltPhotoDate :: Element -> Maybe PhotoDate+eltPhotoDate e = do+   p <- pAttr "posted" e+   t <- pAttr "taken" e+   l <- pAttr "lastupdate" e+   return PhotoDate+     { photoDatePosted      = p+     , photoDateTaken       = t+     , photoDateLastUpdate  = l+     , photoDateGranularity = eltIntAttr "takengranularity" e+     }++eltNote :: Element -> Maybe Note+eltNote e = do+  i   <- pAttr "id" e+  uid <- pAttr "author" e+  nm  <- pAttr "authorname" e+  let x = eltIntAttr "x" e+      y = eltIntAttr "y" e+      w = eltIntAttr "w" e+      h = eltIntAttr "h" e+      s = strContent e+  return Note+    { noteId         = i+    , noteAuthor     = uid+    , noteAuthorName = nm+    , notePoint      = x >>= \ xv -> y >>= \ yv -> return (Point xv yv)+    , noteSize       = w >>= \ wv -> h >>= \ hv -> return (Size wv hv)+    , noteText       = s+    }++eltTagDetails :: Element -> Maybe TagDetails+eltTagDetails e = do+  i   <- pAttr "id" e+  uid <- pAttr "author" e+  let c  = eltIntAttr "count" e+  let s  = eltIntAttr "score" e+  rs <- (pAttr "raw" e >>= \ x -> return [x]) `mplus`+        (return (map strContent (pNodes "raw" (children e))))+  return TagDetails+    { tagDetailsId     = i+    , tagDetailsAuthor = uid+    , tagDetailsRaw    = rs+    , tagDetailsName   = strContent e+    , tagDetailsCount  = c+    , tagDetailsScore  = s+    }++eltURLDetails :: Element -> Maybe URLDetails+eltURLDetails e = do+  ty <- pAttr "type" e+  return URLDetails+    { urlDetailsType = ty+    , urlDetailsURL  = strContent e+    }++toPhotoCountList :: String -> ErrM [PhotoCount]+toPhotoCountList s = parseDoc eltPhotoCountList s++eltPhotoCountList :: Element -> Maybe [PhotoCount]+eltPhotoCountList e = ifNamed "photocounts" e $ do+  let ls = mapMaybe eltPhotoCount $ pNodes "photocount" (children e)+  return ls++eltPhotoCount :: Element -> Maybe PhotoCount+eltPhotoCount e = ifNamed "photocount" e $ do+  c <- eltIntAttr "count" e+  fd <- pAttr "fromdate" e+  td <- pAttr "todate" e+  return PhotoCount+    { photoCount = c+    , photoCountFrom = fd+    , photoCountTo   = td+    }++toEXIFList :: String -> ErrM [EXIF]+toEXIFList s = parseDoc eltEXIFList s++eltEXIFList :: Element -> Maybe [EXIF]+eltEXIFList e = do+  let ls = mapMaybe eltEXIF $ pNodes "exif" (children e)+  return ls++eltEXIF :: Element -> Maybe EXIF+eltEXIF e = ifNamed "exif" e $ do+  ts   <- pAttr "tagspace" e+  tsid <- pAttr "tagspaceid" e+  tid  <- pAttr "tag" e+  lbl  <- pAttr "label" e+  let rw = fmap strContent $ findChild (nsName "raw") e+  let cl = fmap strContent $ findChild (nsName "clean") e+  return EXIF+    { exifTag = EXIFTag{exifTagId=tid,exifTagspace=ts,exifTagspaceId=tsid}+    , exifLabel = lbl+    , exifRaw   = rw+    , exifClean = cl+    }++toPermissions :: String -> ErrM Permissions+toPermissions s = parseDoc eltPermissions s++eltPermissions :: Element -> Maybe Permissions+eltPermissions e = do+  i  <- pAttr "id" e+  pu <- eltBool "ispublic" e+  fa <- eltBool "isfamily" e+  fr <- eltBool "isfriend" e+  pc <- eltIntAttr "permcomment" e+  pa <- eltIntAttr "permaddmeta" e+  return Permissions+      { permId         = i+      , permIsPublic   = pu+      , permIsFriend   = fr+      , permIsFamily   = fa+      , permCommentLevel = pc+      , permAddMetaLevel = pa+      }++toSizeList :: String -> ErrM [SizeDetails]+toSizeList s = parseDoc eltSizeList s++eltSizeList :: Element -> Maybe [SizeDetails]+eltSizeList e = do+  let ls = mapMaybe eltSize $ pNodes "size" (children e)+  return ls++eltSize :: Element -> Maybe SizeDetails+eltSize e = ifNamed "size" e $ do+  la   <- pAttr "label" e+  w   <- eltIntAttr "width" e+  h   <- eltIntAttr "height" e+  src <- pAttr "source" e+  url <- pAttr "url" e+  return SizeDetails+     { sizeDetailsLabel  = la+     , sizeDetailsWidth  = w+     , sizeDetailsHeight = h+     , sizeDetailsSource = src+     , sizeDetailsURL    = url+     }++toPhotoID :: String -> ErrM PhotoID+toPhotoID s = parseDoc eltPhotoID s++eltPhotoID :: Element -> Maybe PhotoID+eltPhotoID e = ifNamed "photoid" e $ return (strContent e)++toCommentID :: String -> ErrM CommentID+toCommentID s = parseDoc eltCommentID s++eltCommentID :: Element -> Maybe CommentID+eltCommentID e = pAttr "id" e -- that wasn't too hard, was it?++toNoteID :: String -> ErrM NoteID+toNoteID s = parseDoc eltNoteID s++eltNoteID :: Element -> Maybe NoteID+eltNoteID e = pAttr "id" e++toCommentList :: String -> ErrM [Comment]+toCommentList s = parseDoc eltCommentList s++eltCommentList :: Element -> Maybe [Comment]+eltCommentList e = +  return $ mapMaybe eltComment $ pNodes "comment" (children e)++eltComment :: Element -> Maybe Comment+eltComment e = ifNamed "comment" e $ do+   i   <- pAttr "id" e+   au  <- eltUser e+   da  <- pAttr "datecreate" e+   return Comment+     { commentId     = i+     , commentAuthor = au+     , commentDate   = da+     , commentURL    = pAttr "permalink" e `mplus` pAttr "url" e+     , commentText   = strContent e+     }++toGeoLocation :: String -> ErrM GeoLocation+toGeoLocation s = parseDoc eltGeoLocation s++eltGeoLocation :: Element -> Maybe GeoLocation+eltGeoLocation e = ifNamed "location" e $ do+   la  <- pAttr "latitude" e+   lo  <- pAttr "longitude" e+   ac  <- eltIntAttr "accuracy" e+   return (la,lo,ac)++toLicenseList :: String -> ErrM [License]+toLicenseList s = parseDoc eltLicenseList s++eltLicenseList :: Element -> Maybe [License]+eltLicenseList e = +  return $ mapMaybe eltLicense $ pNodes "license" (children e)++eltLicense :: Element -> Maybe License+eltLicense e = ifNamed "license" e $ do+  i   <- pAttr "id" e+  nm  <- pAttr "name" e+  url <- pAttr "url" e+  return License+   { licenseId   = i+   , licenseName = nm+   , licenseLink = url+   }++toTicketList :: String -> ErrM [Ticket]+toTicketList s = parseDoc eltTicketList s++eltTicketList :: Element -> Maybe [Ticket]+eltTicketList e = +  return $ mapMaybe eltTicket $ pNodes "ticket" (children e)++eltTicket :: Element -> Maybe Ticket+eltTicket e = ifNamed "ticket" e $ do+   i   <- pAttr "id" e+   c   <- eltIntAttr "complete" e+   p   <- pAttr "photoid" e+   let isInv = fromMaybe False (eltBool "invalid" e)+   return Ticket+      { ticketId       = i+      , ticketComplete = c+      , ticketInvalid  = isInv+      , ticketPhoto    = p+      }++toClusterList :: String -> ErrM [Cluster]+toClusterList s = parseDoc eltClusterList s++eltClusterList :: Element -> Maybe [Cluster]+eltClusterList e = +  return $ mapMaybe eltCluster $ pNodes "cluster" (children e)++eltCluster :: Element -> Maybe Cluster+eltCluster e = ifNamed "cluster" e $ do+   t   <- eltIntAttr "total" e+   let ts = pNodes "tag" (children e)+   return Cluster+      { clusterCount   = t+      , clusterTags    = map strContent ts+      }++toTagDetailsList :: String -> ErrM [TagDetails]+toTagDetailsList s = parseDoc eltTagDetailsList s++eltTagDetailsList :: Element -> Maybe [TagDetails]+eltTagDetailsList e = do+  t <- pNode "tags" (children e)+  return $ mapMaybe eltTagDetails $ pNodes "tag" (children t)

@@ -0,0 +1,114 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.URLs
+-- Description : flickr.urls - locate user photos and groups.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+-- 
+-- The 'flickr.urls' API + convenience functions for creating
+-- URL strings to various Flickr std-format URLs.
+--------------------------------------------------------------------
+module Flickr.URLs 
+       ( getGroup       -- :: GroupID -> FM URLString
+       , getUserPhotos  -- :: Maybe UserID -> FM URLString
+       , getUserProfile -- :: Maybe UserID -> FM URLString
+       , lookupGroup    -- :: URLString -> FM Group
+       , lookupUser     -- :: URLString -> FM User
+       
+       , photoSourceURL     -- :: PhotoDetails -> PhotoSize -> URLString
+       , userProfilePageURL -- :: User -> URLString
+       , userPhotoStreamURL -- :: User -> URLString
+       , userPhotoURL       -- :: User -> PhotoID -> URLString
+       , userPhotosetsURL   -- :: User -> URLString
+       , userPhotosetURL    -- :: User -> PhotosetID -> URLString
+       ) where
+
+import Flickr.Monad
+import Flickr.Types
+import Flickr.Types.Import
+
+import Data.Maybe
+
+-- | Returns the url to a group's page.
+getGroup :: GroupID -> FM URLString
+getGroup gid = do
+  flickTranslate (toString "url") $
+     flickCall "flickr.urls.getGroup" [("group_id", gid)]
+
+-- | Returns the url to a user's photos.
+getUserPhotos :: Maybe UserID -> FM URLString
+getUserPhotos mb = do
+  flickTranslate (toString "url") $
+    flickCall "flickr.urls.getUserPhotos" 
+              (maybeToList (fmap (\ x -> ("user_id", x)) mb))
+
+-- | Returns the url to a user's profile.
+getUserProfile :: Maybe UserID -> FM URLString
+getUserProfile mb = do
+  flickTranslate (toString "url") $
+    flickCall "flickr.urls.getUserProfile"
+              (maybeToList (fmap (\ x -> ("user_id", x)) mb))
+
+-- | Returns a group NSID, given the url to a group's page or photo pool.
+lookupGroup :: URLString -> FM Group
+lookupGroup u = do
+  flickTranslate toGroup $ 
+    flickCall "flickr.urls.lookupGroup" [("url", u)]
+
+-- | Returns a user NSID, given the url to a user's photos or profile.
+lookupUser :: URLString -> FM User
+lookupUser u = do
+  flickTranslate toUser $
+     flickCall "flickr.urls.lookupUser" [("url", u)]
+
+photoSourceURL :: PhotoDetails -> PhotoSize -> URLString
+photoSourceURL p sz = 
+ case photoURL ph of
+   Just u -> u
+   _ -> 
+     -- resisting the temptation to pull in the uri-template 
+     -- package here...
+    "http://farm" ++ fid ++ ".static.flickr.com/" ++ sid ++ 
+    '/':pid ++ '_':sec ++ suff
+ where
+  ph  = photoDetailsPhoto p
+
+  fid = fromMaybe "1" (photoFarm ph)
+  sid = fromMaybe "1" (fmap show $ photoServer ph)
+  pid = photoId ph
+  sec = 
+   case sz of
+     PhotoSizeOriginal -> fromMaybe "1" (photoDetailsOrigSecret p)
+     _ -> photoSecret ph
+  suff = 
+   case sz of
+     PhotoSizeMedium -> ".jpg"
+     PhotoSizeOriginal -> "_o." ++ fromMaybe "jpg" (photoDetailsOrigFormat p)
+     PhotoSizeSmallSquare -> "_s.jpg"
+     PhotoSizeThumb -> "_t.jpg"
+     PhotoSizeSmall -> "_m.jpg"
+     PhotoSizeLarge -> "_b.jpg"
+
+userProfilePageURL :: User -> URLString
+userProfilePageURL u = 
+  "http://www.flickr.com/people/" ++ userId u ++ "/"
+
+userPhotoStreamURL :: User -> URLString
+userPhotoStreamURL u =
+  "http://www.flickr.com/photos/" ++ userId u ++ "/"
+
+userPhotoURL :: User -> PhotoID -> URLString
+userPhotoURL u pid = 
+  "http://www.flickr.com/photos/" ++ userId u ++ '/':pid
+
+userPhotosetsURL :: User -> URLString
+userPhotosetsURL u = 
+  "http://www.flickr.com/photos/" ++ userId u ++ "/sets/"
+
+userPhotosetURL :: User -> PhotosetID -> URLString
+userPhotosetURL u p = 
+  "http://www.flickr.com/photos/" ++ userId u ++ "/sets/" ++ p

@@ -0,0 +1,96 @@+--------------------------------------------------------------------
+-- |
+-- Module      : Flickr.Utils
+-- Description : assorted functions for unravelling Flickr responses.
+-- Copyright   : (c) Sigbjorn Finne, 2008
+-- License     : BSD3
+--
+-- Maintainer  : Sigbjorn Finne <sof@forkIO.com>
+-- Stability   : provisional
+-- Portability : portable
+--
+-- Assorted functions for unravelling Flickr responses.
+--------------------------------------------------------------------
+module Flickr.Utils
+       ( module Flickr.Utils
+       , fromMaybe
+       ) where
+
+import Text.XML.Light as XML
+import Text.XML.Light.Proc as XML
+import Data.Maybe
+import Data.List
+import Control.Monad
+
+--import Flickr.Monad ( ErrM, FlickErr(..), FlickErrorType(..), flickError )
+
+pNodes       :: String -> [XML.Element] -> [XML.Element]
+pNodes x es   = filter ((nsName x ==) . elName) es
+
+pNode        :: String -> [XML.Element] -> Maybe XML.Element
+pNode x es    = listToMaybe (pNodes x es)
+
+pLeaf        :: String -> [XML.Element] -> Maybe String
+pLeaf x es    = strContent `fmap` pNode x es
+
+pAttr        :: String -> XML.Element -> Maybe String
+pAttr x e     = lookup (nsName x) [ (k,v) | Attr k v <- elAttribs e ]
+
+pMany        :: String -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]
+pMany p f es  = mapMaybe f (pNodes p es)
+
+children     :: XML.Element -> [XML.Element]
+children e    = onlyElems (elContent e)
+
+child :: XML.Element -> XML.Element
+child e = 
+  case children e of
+    [] -> error ("child: empty content " ++ show e)
+    (x:_) -> x
+
+nsName :: String -> QName
+nsName x = QName{qName=x,qURI=Nothing,qPrefix=Nothing}
+
+without :: [String] -> [XML.Attr] -> [XML.Attr]
+without xs as = filter (\ a -> not (attrKey a `elem` qxs)) as
+ where
+  qxs = map nsName xs
+
+ifNamed :: String -> XML.Element -> Maybe a -> Maybe a
+ifNamed s e n = guard (elName e == nsName s) >> n
+
+mbDef :: a -> Maybe a -> Maybe a
+mbDef x Nothing = Just x
+mbDef _ v = v
+
+readMb :: Read a => String -> Maybe a
+readMb x = case reads x of
+             ((v,_):_) -> Just v
+	     _ -> Nothing
+
+piped :: [String] -> String
+piped xs = concat (intersperse "|" xs)
+
+opt :: String -> String -> Maybe (String,String)
+opt a b = Just (a,b)
+
+optB :: String -> Bool -> Maybe (String,String)
+optB _ False = Nothing
+optB a _ = Just (a,"")
+
+opt1 :: String -> [String] -> Maybe (String,String)
+opt1 _ [] = Nothing
+opt1 a b = Just (a,piped b)
+
+mbOpt :: String -> (a -> String) -> Maybe a -> Maybe (String,String)
+mbOpt _tg _ Nothing = Nothing
+mbOpt tg f (Just x) = Just (tg,f x)
+
+showBool :: Bool -> String
+showBool x = show (fromEnum x)
+
+intContent :: Element -> Maybe Int
+intContent e = 
+  case reads (strContent e) of
+    ((v,_):_) -> Just v
+    _ -> Nothing

@@ -0,0 +1,27 @@+Copyright (c) Sigbjorn Finne, 2008.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,49 @@+= hsflickr - Programming Flickr from Haskell =
+
+'hsflickr' is a Haskell package providing a binding to
+the Flickr API - http://www.flickr.com/services/api/
+
+The binding is functionally complete (Nov 2008), letting
+you write applications in Haskell that access and manipulates
+content on Flickr, either public information or per-user
+photos and properties. Including the uploading of new photos.
+
+= Getting started =
+
+For some code samples showing you how to get started using this
+API binding, have a look in the examples/ directory. 
+
+= Building and installing =
+
+This package is provided in Cabal form, so only thing you need to
+do to get going is:
+
+  foo% runghc Setup configure
+  foo% runghc Setup build 
+  foo% runghc Setup install
+
+The package depends on a bunch of other packages though, so you
+need to have them built&installed, as well. They are:
+
+  * HTTP: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HTTP
+  * xml:  http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xml
+  * mime >= 0.3: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mime
+  * utf8-string: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/utf8-string
+
+= Authentication =
+
+To use this API binding to build your own Flickr application, you ought
+to apply for your own set of API keys to identify yourself with when
+prompting the user. See, http://www.flickr.com/services/api/keys/apply/ , 
+for how to apply -- use either a 'mobile' or 'web' type of key. With
+that API key, instantiate your own APIKey value, see Util.Keys for
+definition of that type + examples of its use. 
+
+(The keys that come with the package by default are not guaranteed to
+stick around for too long, esp. if their use end up being used in inapprop.
+ways.)
+
+= Feedback / question =
+
+Please send them to sof@forkIO.com , and I'll try to respond to them
+as best/quickly as possible.

@@ -0,0 +1,8 @@+module Main(main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
+
+

@@ -0,0 +1,42 @@+module Util.Authenticate where
+
+import Flickr.Monad
+import Util.Keys
+import Flickr.Types
+import Flickr.Auth
+
+-- | authenticate the 'web application' way; obtain
+-- a so-called frob, generate a URL for the user to
+-- authorize access via. Once the user has done so,
+-- resolve the full token by performing action.
+authenticateForWeb :: String -> FM (Maybe (URLString, FM AuthToken))
+authenticateForWeb forPerm = do
+  x <- getAPIKey
+  case apiKind x of
+    "web" -> do
+       fr <- getFrob
+       u  <- mkLoginURL (aFrob fr) forPerm
+       return (Just (u, getToken fr))
+    k -> do
+      liftIO $ putStrLn ("Unexpected API key 'kind': " ++ k ++ ", expected 'web'.")
+      return Nothing
+
+-- | Authenticate the 'mobile application' way; emit
+-- an authentication URL for the mobile application
+-- along with an action that takes a authentication
+-- 'mini-token' to resolve into a full token. The mini-token
+-- is either something the application stores (as a secret),
+-- or for the first time around, by having the user write
+-- down the mini-token 9-digit (format is xxx-yyy-zzz) string
+-- and input that to the application through its UI.
+-- 
+authenticateForMobile :: String -> FM (Maybe (URLString, String -> FM AuthToken))
+authenticateForMobile perm = do
+  x <- getAPIKey
+  case apiKind x of
+    "mobile" -> do
+       u <- getMobileAuthURL
+       return (Just (u, \ mt -> getFullToken mt))
+    k -> do
+      liftIO $ putStrLn ("Unexpected API key 'kind': " ++ k ++ ", expected 'mobile'.")
+      return Nothing

@@ -0,0 +1,104 @@+--------------------------------------------------------------------+-- |+-- Module    : Util.Fetch+-- Copyright : (c) Sigbjorn Finne, 2008+-- License   : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: so-so+-- +-- Simple GET\/de-ref of URLs; abstracting out networking backend\/package.+--+module Util.Fetch +       ( readContentsURL+       , readUserContentsURL+       +       , postContentsURL++       , URLString+       , User(..)+       ) where+       +--import Network.Curl+import Network.Browser+import Network.HTTP+import Network.URI++type URLString = String++data User+ = User { userName :: String+        , userPass :: String+	}++readContentsURL :: URLString -> IO String+readContentsURL u = do+  req <- +    case parseURI u of+      Nothing -> fail ("ill-formed URL: " ++ u)+      Just ur -> return (defaultGETRequest ur)+    -- don't like doing this, but HTTP is awfully chatty re: cookie handling..+  let nullHandler _ = return ()+  (_u, resp) <- browse $ setOutHandler nullHandler >> request req+  case rspCode resp of+    (2,_,_) -> return (rspBody resp)+    _ -> fail ("Failed reading URL " ++ show u ++ " code: " ++ show (rspCode resp))++{- Curl version:+readContentsURL :: URLString -> IO String+readContentsURL u = do+  let opts = [ CurlFollowLocation True+	     ]+  (_,xs) <- curlGetString u opts+  return xs+-}++readUserContentsURL :: User -> URLString -> IO String+readUserContentsURL _ u = readContentsURL u++postContentsURL :: URLString -> [(String,String)] -> String -> IO String+postContentsURL u hdrs body = do+  let hs = +       case parseHeaders $ map (\ (x,y) -> x++": " ++ y) hdrs of+         Left{} -> []+	 Right xs -> xs+  req0 <- +    case parseURI u of+      Nothing -> fail ("ill-formed URL: " ++ u)+      Just ur -> return (defaultGETRequest ur)+  let req = req0{rqMethod=POST+                ,rqBody=body+		,rqHeaders=hs+	        }+  let nullHandler _ = return ()+  (_,rsp) <- browse $ setOutHandler nullHandler >> request req+  case rspCode rsp of+    (2,_,_) -> return (rspBody rsp)+    x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u)++{- Curl versions:+readUserContentsURL :: User -> URLString -> IO String+readUserContentsURL u url = do+  let opts = [ CurlHttpAuth [HttpAuthAny]+             , CurlUserPwd (userName u ++ +	                    case userPass u of {"" -> ""; p -> ':':p })+             , CurlFollowLocation True+	     ] +  (_,xs) <- curlGetString url opts+  return xs+     +postContentsURL :: URLString -> [(String,String)] -> String -> IO String+postContentsURL u hdrs body = do+  let opts = [ CurlCustomRequest "POST"+             , CurlFollowLocation True+	     , CurlPost True+	     , CurlPostFields [body]+	     , CurlHttpTransferDecoding False+	     ] ++ [CurlHttpHeaders (map ( \ (x,y) -> (x ++ ':':y)) hdrs)]+  rsp <- curlGetResponse u opts+  case respStatus rsp `div` 100 of+    2 -> return (respBody rsp)+    x -> fail ("POST failed - code: " ++ show x ++ ", URL: " ++ u)++-}

@@ -0,0 +1,57 @@+--------------------------------------------------------------------
+-- |
+-- Module    : Util.Keys
+-- Copyright : (c) Sigbjorn Finne, 2008
+-- License   : BSD3
+--
+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
+-- Stability : provisional
+-- Portability: so-so
+--
+-- hs-flickr keys and secrets; use and authorize with care..
+--
+--------------------------------------------------------------------
+module Util.Keys 
+       ( APIKey(..)
+       , hsflickrAPIKey        -- :: APIKey
+
+       , hsflickr_mobile_key   -- :: APIKey
+       , hsflickr_web_key      -- :: APIKey
+       ) where
+
+-- Note: we use hsflickr_ prefixes to clearly indicate here, and
+-- whereever they are used, the provenance of these keys.
+
+data APIKey
+ = APIKey
+      { apiKind    :: String -- desktop,web,mobile
+      , apiKey     :: String
+      , apiSecret  :: String
+      , apiAuthURL :: Maybe String
+      }
+
+hsflickrAPIKey :: APIKey
+hsflickrAPIKey  = hsflickr_mobile_key
+--hsflickrAPIKey  = hsflickr_web_key
+
+-- | the API key currently registered for hsflickr, 'mobile' application
+-- version (write perms.)
+hsflickr_mobile_key :: APIKey
+hsflickr_mobile_key = APIKey
+      { apiKind    = "mobile"
+      , apiKey     = "a714ef83577adf5ea7e9d1ea3b8f39f0"
+      , apiSecret  = "49b89db22ca223b4"
+      , apiAuthURL = Just "http://www.flickr.com/auth-72157608768003027"
+      }
+
+-- | the API key currently registered for hsflickr, web application
+-- version (write perms.)
+hsflickr_web_key :: APIKey
+hsflickr_web_key = APIKey
+      { apiKind    = "web"
+      , apiKey     = "9978c9501bd9970804605a320052cea1"
+      , apiSecret  = "41a5ec838a12a388" 
+      , apiAuthURL = Just "http://api.flickr.com/services/auth/?"
+      }
+
+

@@ -0,0 +1,266 @@+--------------------------------------------------------------------+-- |+-- Module    : Util.MD5+-- Copyright : (c) Galois, Inc. 2008+-- License   : BSD3+--+-- Maintainer: Sigbjorn Finne <sof@forkIO.com>+-- Stability : provisional+-- Portability: so-so+-- +-- Haskell implementation of MD5, derived from RFC 1321.+-- +module Util.MD5 +	( md5+	, md5sum+	, md5sumStr+	, showDigest+	) where++import Data.Bits+import Data.Word+import Data.Char ( ord, intToDigit )++type MD5Digest = (Word32, Word32, Word32, Word32)++md5sumStr :: [Char] -> String+md5sumStr xs = md5sum (map (fromIntegral.ord) xs)++md5sum :: [Word8] -> String+md5sum ls = showDigest $ md5 ls++md5 :: [Word8] -> [Word8]+md5 ls = splitUp $+             go 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0+                (chunk64 ls)+  where+   splitUp (a,b,c,d) = +     wordToBytes a $ wordToBytes b $ wordToBytes c $ wordToBytes d []++   toWord32 :: [Word8] -> [Word32]+   toWord32 [] = []+   toWord32 (x:y:z:w:xs) = +      ((fromIntegral x) .|.+       (fromIntegral y) `shiftL` 8 .|.+       (fromIntegral z) `shiftL` 16 .|.+       (fromIntegral w) `shiftL` 24) : toWord32 xs+   toWord32 xs = toWord32 (xs ++ replicate (4-length xs) 0)++   chunk64 cls = +     case splitAt 64 cls of+       (as,[]) -> [as]+       (as,bs) -> as : chunk64 bs++   go :: Word32 -> Word32 -> Word32 -> Word32 -> Word64 -> [[Word8]]+      -> MD5Digest+   go a b c d _ []  = (a,b,c,d)+   go a b c d l [x] = +     let+      l' = l + fromIntegral ((length x) `shiftL` 3)+      index = (fromIntegral ((l' `shiftR` 3) .&. 0x3f)) :: Word32+      padlen +       | index < 56 =  56 - index+       | otherwise  = 120 - index+      ++      l0 = (fromIntegral (l' .&. 0xffffffff)) :: Word32+      l1 = (fromIntegral ((l' `shiftR` 32) .&. 0xffffffff)) :: Word32++      len :: [Word8]+      len = wordToBytes l0 (wordToBytes l1 [])++      vs = (x ++ take (fromIntegral padlen) padding ++ len)+     in+     processRound a b c d (toWord32 vs)+   go a b c d l (x:xs) = +     let+      (a1,b1,c1,d1) = processRound a b c d (toWord32 x)+      l1 = l + 64*8+     in+     go a1 b1 c1 d1 l1 xs++   processRound a0 b0 c0 d0 x = +     let+      (x0:x1:x2:x3:x4:x5:x6:x7:x8:x9:x10:x11:x12:x13:x14:x15:xs) = x+      (a1,b1,c1,d1,_,_) = +        round_4 $ round_3 $ round_2 $ round_1+	  (a0,b0,c0,d0,+	   [ x0,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15+	   , x1,x6,x11,x0,x5,x10,x15,x4,x9,x14,x3,x8,x13,x2,x7,x12+	   , x5,x8,x11,x14,x1,x4,x7,x10,x13,x0,x3,x6,x9,x12,x15,x2+	   , x0,x7,x14,x5,x12,x3,x10,x1,x8,x15,x6,x13,x4,x11,x2,x9+	   ],tab)+     in+     if not (null xs)+      then processRound (a0+a1) (b0+b1) (c0+c1) (d0+d1) xs+      else (a0+a1,b0+b1,c0+c1,d0+d1)++selByte :: Int -> Word32 -> Word8+selByte n x = fromIntegral ((x `shiftR` (8*n)) .&. 0xff)+      +wordToBytes :: Word32 -> [Word8] -> [Word8]+wordToBytes w ws = +   (selByte 0 w) : (selByte 1 w) : +   (selByte 2 w) : (selByte 3 w) : ws++type RoundR = (Word32,Word32,Word32,Word32,[Word32],[Word32])++type Round = RoundR -> RoundR++round_1 :: Round+round_1 = +  (\ (a0,b0,c0,d0, +      (x0:x1:x2:x3:x4:x5:x6:x7:x8:x9:x10:x11:x12:x13:x14:x15:xs),+      (t0:t1:t2:t3:t4:t5:t6:t7:t8:t9:t10:t11:t12:t13:t14:t15:ts)) ->+     let +      a1 = b0 + ((a0 + f b0 c0 d0 + x0 + t0) `rotateL`  7)+      d1 = a1 + ((d0 + f a1 b0 c0 + x1 + t1) `rotateL` 12)+      c1 = d1 + ((c0 + f d1 a1 b0 + x2 + t2) `rotateL` 17)+      b1 = c1 + ((b0 + f c1 d1 a1 + x3 + t3) `rotateL` 22)++      a2 = b1 + ((a1 + f b1 c1 d1 + x4 + t4) `rotateL`  7)+      d2 = a2 + ((d1 + f a2 b1 c1 + x5 + t5) `rotateL` 12)+      c2 = d2 + ((c1 + f d2 a2 b1 + x6 + t6) `rotateL` 17)+      b2 = c2 + ((b1 + f c2 d2 a2 + x7 + t7) `rotateL` 22)++      a3 = b2 + ((a2 + f b2 c2 d2 + x8 + t8) `rotateL`  7)+      d3 = a3 + ((d2 + f a3 b2 c2 + x9 + t9) `rotateL` 12)+      c3 = d3 + ((c2 + f d3 a3 b2 + x10 + t10) `rotateL` 17)+      b3 = c3 + ((b2 + f c3 d3 a3 + x11 + t11) `rotateL` 22)++      a4 = b3 + ((a3 + f b3 c3 d3 + x12 + t12) `rotateL`  7)+      d4 = a4 + ((d3 + f a4 b3 c3 + x13 + t13) `rotateL` 12)+      c4 = d4 + ((c3 + f d4 a4 b3 + x14 + t14) `rotateL` 17)+      b4 = c4 + ((b3 + f c4 d4 a4 + x15 + t15) `rotateL` 22)+     in+     (a4, b4, c4, d4, xs, ts))++round_2 :: Round+round_2 = +  (\ (a0,b0,c0,d0, +      (x0:x1:x2:x3:x4:x5:x6:x7:x8:x9:x10:x11:x12:x13:x14:x15:xs),+      (t0:t1:t2:t3:t4:t5:t6:t7:t8:t9:t10:t11:t12:t13:t14:t15:ts)) ->+     let+      a1 = b0 + ((a0 + g b0 c0 d0 + x0 + t0) `rotateL` 5)+      d1 = a1 + ((d0 + g a1 b0 c0 + x1 + t1) `rotateL` 9)+      c1 = d1 + ((c0 + g d1 a1 b0 + x2 + t2) `rotateL` 14)+      b1 = c1 + ((b0 + g c1 d1 a1 + x3 + t3) `rotateL` 20)++      a2 = b1 + ((a1 + g b1 c1 d1 + x4 + t4) `rotateL`  5)+      d2 = a2 + ((d1 + g a2 b1 c1 + x5 + t5) `rotateL`  9)+      c2 = d2 + ((c1 + g d2 a2 b1 + x6 + t6) `rotateL` 14)+      b2 = c2 + ((b1 + g c2 d2 a2 + x7 + t7) `rotateL` 20)++      a3 = b2 + ((a2 + g b2 c2 d2 + x8 + t8) `rotateL`  5)+      d3 = a3 + ((d2 + g a3 b2 c2 + x9 + t9) `rotateL`  9)+      c3 = d3 + ((c2 + g d3 a3 b2 + x10 + t10) `rotateL` 14)+      b3 = c3 + ((b2 + g c3 d3 a3 + x11 + t11) `rotateL` 20)++      a4 = b3 + ((a3 + g b3 c3 d3 + x12 + t12) `rotateL`  5)+      d4 = a4 + ((d3 + g a4 b3 c3 + x13 + t13) `rotateL`  9)+      c4 = d4 + ((c3 + g d4 a4 b3 + x14 + t14) `rotateL` 14)+      b4 = c4 + ((b3 + g c4 d4 a4 + x15 + t15) `rotateL` 20)+     in+     (a4, b4, c4, d4, xs, ts))++round_3 :: Round+round_3 = +  (\ (a0,b0,c0,d0, +      (x0:x1:x2:x3:x4:x5:x6:x7:x8:x9:x10:x11:x12:x13:x14:x15:xs),+      (t0:t1:t2:t3:t4:t5:t6:t7:t8:t9:t10:t11:t12:t13:t14:t15:ts)) ->+     let+      a1 = b0 + ((a0 + h b0 c0 d0 + x0 + t0) `rotateL` 4)+      d1 = a1 + ((d0 + h a1 b0 c0 + x1 + t1) `rotateL` 11)+      c1 = d1 + ((c0 + h d1 a1 b0 + x2 + t2) `rotateL` 16)+      b1 = c1 + ((b0 + h c1 d1 a1 + x3 + t3) `rotateL` 23)++      a2 = b1 + ((a1 + h b1 c1 d1 + x4 + t4) `rotateL`  4)+      d2 = a2 + ((d1 + h a2 b1 c1 + x5 + t5) `rotateL` 11)+      c2 = d2 + ((c1 + h d2 a2 b1 + x6 + t6) `rotateL` 16)+      b2 = c2 + ((b1 + h c2 d2 a2 + x7 + t7) `rotateL` 23)++      a3 = b2 + ((a2 + h b2 c2 d2 + x8 + t8) `rotateL`  4)+      d3 = a3 + ((d2 + h a3 b2 c2 + x9 + t9) `rotateL`  11)+      c3 = d3 + ((c2 + h d3 a3 b2 + x10 + t10) `rotateL` 16)+      b3 = c3 + ((b2 + h c3 d3 a3 + x11 + t11) `rotateL` 23)++      a4 = b3 + ((a3 + h b3 c3 d3 + x12 + t12) `rotateL`  4)+      d4 = a4 + ((d3 + h a4 b3 c3 + x13 + t13) `rotateL` 11)+      c4 = d4 + ((c3 + h d4 a4 b3 + x14 + t14) `rotateL` 16)+      b4 = c4 + ((b3 + h c4 d4 a4 + x15 + t15) `rotateL` 23)+     in+     (a4, b4, c4, d4, xs, ts))++round_4 :: Round+round_4 = +  (\ (a0,b0,c0,d0, +      (x0:x1:x2:x3:x4:x5:x6:x7:x8:x9:x10:x11:x12:x13:x14:x15:xs),+      (t0:t1:t2:t3:t4:t5:t6:t7:t8:t9:t10:t11:t12:t13:t14:t15:ts)) ->+     let+      a1 = b0 + ((a0 + i b0 c0 d0 + x0 + t0) `rotateL` 6)+      d1 = a1 + ((d0 + i a1 b0 c0 + x1 + t1) `rotateL` 10)+      c1 = d1 + ((c0 + i d1 a1 b0 + x2 + t2) `rotateL` 15)+      b1 = c1 + ((b0 + i c1 d1 a1 + x3 + t3) `rotateL` 21)++      a2 = b1 + ((a1 + i b1 c1 d1 + x4 + t4) `rotateL`  6)+      d2 = a2 + ((d1 + i a2 b1 c1 + x5 + t5) `rotateL` 10)+      c2 = d2 + ((c1 + i d2 a2 b1 + x6 + t6) `rotateL` 15)+      b2 = c2 + ((b1 + i c2 d2 a2 + x7 + t7) `rotateL` 21)++      a3 = b2 + ((a2 + i b2 c2 d2 + x8 + t8) `rotateL`  6)+      d3 = a3 + ((d2 + i a3 b2 c2 + x9 + t9) `rotateL`  10)+      c3 = d3 + ((c2 + i d3 a3 b2 + x10 + t10) `rotateL` 15)+      b3 = c3 + ((b2 + i c3 d3 a3 + x11 + t11) `rotateL` 21)++      a4 = b3 + ((a3 + i b3 c3 d3 + x12 + t12) `rotateL`  6)+      d4 = a4 + ((d3 + i a4 b3 c3 + x13 + t13) `rotateL` 10)+      c4 = d4 + ((c3 + i d4 a4 b3 + x14 + t14) `rotateL` 15)+      b4 = c4 + ((b3 + i c4 d4 a4 + x15 + t15) `rotateL` 21)+     in+     (a4, b4, c4, d4, xs, ts))+++f,g,h,i :: Word32 -> Word32 -> Word32 -> Word32+f x y z = (x .&. y) .|. (complement x .&. z)+g x y z = (x .&. z) .|. (y .&. complement z)+h x y z = (x `xor` y `xor` z)+i x y z = (y `xor` (x .|. complement z))++padding :: [Word8]+padding = (0x80:replicate 63 0x00)++-- [ (floor ((4294967296.0::Double) * abs (sin (fromIntegral i)))) :: Integer +--      | i <- [1..(64::Int)] ]+tab :: [Word32]+tab =+ [ 0xd76aa478, 0xe8c7b756, 0x242070db, 0xc1bdceee+ , 0xf57c0faf, 0x4787c62a, 0xa8304613, 0xfd469501+ , 0x698098d8, 0x8b44f7af, 0xffff5bb1, 0x895cd7be+ , 0x6b901122, 0xfd987193, 0xa679438e, 0x49b40821+ + , 0xf61e2562, 0xc040b340, 0x265e5a51, 0xe9b6c7aa+ , 0xd62f105d, 0x02441453, 0xd8a1e681, 0xe7d3fbc8+ , 0x21e1cde6, 0xc33707d6, 0xf4d50d87, 0x455a14ed+ , 0xa9e3e905, 0xfcefa3f8, 0x676f02d9, 0x8d2a4c8a++ , 0xfffa3942, 0x8771f681, 0x6d9d6122, 0xfde5380c+ , 0xa4beea44, 0x4bdecfa9, 0xf6bb4b60, 0xbebfbc70+ , 0x289b7ec6, 0xeaa127fa, 0xd4ef3085, 0x04881d05+ , 0xd9d4d039, 0xe6db99e5, 0x1fa27cf8, 0xc4ac5665++ , 0xf4292244, 0x432aff97, 0xab9423a7, 0xfc93a039+ , 0x655b59c3, 0x8f0ccc92, 0xffeff47d, 0x85845dd1+ , 0x6fa87e4f, 0xfe2ce6e0, 0xa3014314, 0x4e0811a1+ , 0xf7537e82, 0xbd3af235, 0x2ad7d2bb, 0xeb86d391+ ]++showDigest :: [Word8] -> String+showDigest ds = foldr showHex "" ds+ where+  showHex :: Word8 -> String -> String+  showHex x xs = (hdig a):(hdig b):xs+   where+    (a,b) = x `divMod` 16+    +    hdig hd = intToDigit (fromIntegral hd)+

@@ -0,0 +1,117 @@+module Util.MIME where
+
+import System.IO
+import System.Random
+import Numeric ( showHex )
+import Data.List ( intercalate )
+
+import Codec.MIME.Type as MIME
+
+uploadFileType :: String -> MIME.Type
+uploadFileType bou = MIME.Type
+  { mimeType = Multipart FormData
+  , mimeParams = [("boundary", bou)]
+  }
+
+mixedType :: IO (MIMEValue, String)
+mixedType = do
+  let low = (2^(32::Integer)-1) :: Integer
+  x <- randomRIO (low,low*low)
+  let boundary = replicate 30 '-' ++ showHex x ""
+  return (nullMIMEValue
+    { mime_val_type = MIME.Type { mimeType   = Multipart Mixed
+                                , mimeParams = [("boundary", boundary)]
+				}
+    }, boundary)
+
+uploadFile :: String -> FilePath -> IO MIMEValue
+uploadFile nm fp = do
+{-
+  let low = (2^(32::Integer)-1) :: Integer
+  x <- randomRIO (low,low*low)
+  let boundary = replicate 30 '-' ++ showHex x ""
+-}
+  let file_disp = 
+        Disposition
+               { dispType   = DispFormData
+	       , dispParams = [ Name nm, Filename fp ]
+	       }
+  h <- openBinaryFile fp ReadMode
+  ls <- hGetContents h
+  let fileValue = 
+       nullMIMEValue
+        { mime_val_type = Type{mimeType=Text "plain", mimeParams=[]}
+        , mime_val_disp = Just file_disp
+        , mime_val_content = Single ls
+        , mime_val_headers = [ ("Content-Transfer-Encoding", "binary")
+	                     , ("Content-Length", show (length ls))
+			     ]
+        , mime_val_inc_type = True
+        }
+  return fileValue -- MIMEValue
+{-
+    { mime_val_type = uploadFileType boundary
+    , mime_val_disp = Nothing
+    , mime_val_content = Multi [fileValue]
+    }
+-}
+showMIMEValue :: String -> MIMEValue -> ([(String,String)], String)
+showMIMEValue m mv = 
+ let marker = 
+       case mimeType (mime_val_type mv) of
+         Multipart{} -> 
+	   case lookup "boundary" (mimeParams (mime_val_type mv)) of
+	     Just x -> crnl ++ '-':'-':x
+	     _ -> m
+         _ -> m
+ in
+ ( withType $ withDisp (mime_val_headers mv)
+ , (if True || null m then (crnl++) else (\x -> m ++ crnl ++ x))
+    (showMIMEContent marker (mime_val_content mv))
+ )
+ where
+  withType 
+   | mime_val_inc_type mv = (("Content-Type", showType (mime_val_type mv)):)
+   | otherwise = id
+
+  withDisp = 
+    case mime_val_disp mv of
+      Nothing -> id
+      Just d  -> (("Content-Disposition", showDisposition d):)
+
+showMIMEContent :: String -> MIMEContent -> String
+showMIMEContent _marker (Single s) = s
+showMIMEContent  marker (Multi ms) = 
+  concat (map (s.(showMIMEValue marker)) ms) ++ marker ++ "--"
+ where
+  s (hs,v) = marker ++ crnl ++
+    intercalate crnl (map (\ (a,b) -> (a ++ ':':' ':b)) hs) ++ crnl ++ v
+
+crnl :: String
+crnl = "\r\n"
+
+showDisposition :: Disposition -> String
+showDisposition d = 
+  showDispType (dispType d) ++
+   (concat $ map showDispParam (dispParams d))
+ 
+showDispType :: DispType -> String
+showDispType dt = 
+ case dt of
+   DispInline -> "inline"
+   DispAttachment -> "attachment"
+   DispFormData   -> "form-data"
+   DispOther x    -> x
+
+showDispParam :: DispParam -> String
+showDispParam dp = ';':' ':
+  case dp of
+    Name x -> "name="++show x
+    Filename x -> "filename=" ++ show x
+    CreationDate s -> "creation-date=" ++ show s
+    ModDate s -> "modification-date=" ++ show s
+    ReadDate s -> "read-date=" ++ show s
+    MIME.Size x -> "size=" ++ show x
+    OtherParam a b -> a ++ '=':show b
+
+    

@@ -0,0 +1,151 @@+module Util.Post where
+
+import Codec.MIME.Type as MIME
+import Codec.MIME.Parse as MIME
+import Util.MIME
+import Codec.URLEncoder
+
+import Data.List
+import System.Random
+import Numeric
+
+-- ease the working with POST requests and their
+-- outgoing payloads.
+
+data PostReq
+ = PostReq
+    { prName :: String
+    , prVals :: [PostParam]
+    }
+
+data PostKind
+ = PostQuery
+ | PostWWWForm
+ | PostFormData
+
+newPostRequest :: String -> PostReq
+newPostRequest s = PostReq{prName=s,prVals=[]}
+
+testRequest :: PostReq
+            -> Maybe PostKind
+	    -> IO ()
+testRequest a b = do
+  (as,bs,cs) <- toRequest a b
+  putStrLn ("URL query portion: " ++ as)
+  putStrLn (unlines $ map (\ (k,v) -> k ++ ':':' ':v) bs)
+  putStrLn ""
+  putStrLn cs
+  
+
+toRequest :: PostReq
+          -> Maybe PostKind
+	  -> IO (String, [(String,String)], String)
+toRequest pr mbKind = 
+  case mbKind of
+    Nothing -> 
+      case filter isPostFile (prVals pr) of
+        (_:_) -> toRequest pr (Just PostFormData)
+	_ -> toRequest pr (Just PostWWWForm)
+    Just PostQuery -> 
+      case partition isPostFile (prVals pr) of
+        (ls@(_:_),bs) -> do
+	  putStrLn ("toRequest: POST request contains " ++ 
+	        shows (length ls) (" files; unable to represent as query string"))
+          putStrLn ("Defaulting to multiform/form-data instead")
+	  toRequest pr{prVals=bs++ls} (Just PostFormData)
+        _ -> return (intercalate "&" $ 
+	                map (\ (PostNameValue n v) -> encodeString n ++ '=':encodeString v) (prVals pr), [],"")
+    Just PostWWWForm ->
+      case partition isPostFile (prVals pr) of
+        (ls@(_:_),bs) -> do
+	  putStrLn ("toRequest: POST request contains " ++ 
+	        shows (length ls) (" files; unable to represent as application/x-www-form-urlencoded"))
+          putStrLn ("Defaulting to multiform/form-data instead")
+	  toRequest pr{prVals=bs++ls} (Just PostFormData)
+        _ -> return ( ""
+	            , [("Content-Type", "application/x-www-form-urlencoded")]
+	            , crnl ++ (intercalate "&" $ 
+	                 map (\ (PostNameValue n v) -> encodeString n ++ '=':encodeString v) (prVals pr))
+		    )
+    Just PostFormData -> do
+      mv <- toMIMEValue (prVals pr)
+      let (hs,bod) = showMIMEValue "" mv
+      return ( "", hs, bod)
+
+addNameValue :: String -> String -> PostReq -> PostReq
+addNameValue n v pr = pr{prVals=(PostNameValue n v):prVals pr}
+
+addNameFile :: String -> FilePath -> Maybe String -> PostReq -> PostReq
+addNameFile nm fp mbTy pr = pr{prVals=(PostFile nm fp mbTy):prVals pr}
+
+data PostParam
+ = PostNameValue String    -- name
+                 String    -- value (assume: un-encoded)
+ | PostFile String         -- name
+            FilePath       -- local file to post
+	    (Maybe String) --  Just ty => use 'ty' as content-type
+
+isPostFile :: PostParam -> Bool
+isPostFile PostFile{} = True
+isPostFile _ = False
+
+toMIMEValue :: [PostParam] -> IO MIMEValue
+toMIMEValue ps = do
+  let low = (2^(32::Integer)-1) :: Integer
+  x <- randomRIO (low,low*low)
+  let boundary = replicate 30 '-' ++ showHex x ""
+  let (fs,ns) = 
+        case partition isPostFile ps of
+	  ([_],_) -> ([],ps)
+	  xs -> xs
+
+  fns <- mapM (fromPostParam boundary) ns
+  (mi,b)  <- mixedType
+  ffs <- mapM (fromPostParam b) fs
+  let addM [] = []
+      addM xs = [mi{mime_val_content=Multi xs}]
+      
+  return MIMEValue
+    { mime_val_type    = MIME.Type{ mimeType   = Multipart FormData
+                                  , mimeParams = [("boundary", boundary)]
+				  }
+    , mime_val_disp    = Nothing
+    , mime_val_content = Multi (fns ++ addM ffs)
+    , mime_val_inc_type = True
+    , mime_val_headers = []
+    }
+
+fromPostParam :: String -> PostParam -> IO MIMEValue
+fromPostParam _boundary (PostNameValue n v) = 
+  return MIMEValue
+     { mime_val_type = MIME.Type
+         { mimeType = Application "x-www-form-urlencoded"
+	 , mimeParams=[]
+	 }
+     , mime_val_disp = Just $
+         Disposition { dispType = DispFormData 
+                     , dispParams = [Name n]
+		     }
+     , mime_val_content = Single (encodeString v)
+     , mime_val_headers = []
+     , mime_val_inc_type = False
+     }
+fromPostParam _boundary (PostFile nm fp mbTy) = do
+  ty <- 
+    case mbTy of
+      Nothing -> getMIMEType fp
+      Just ty -> toMIMEType ty
+  mv <- uploadFile nm fp
+  return mv{mime_val_type=ty}
+
+toMIMEType :: String -> IO Type
+toMIMEType tyStr = 
+  case parseMIMEType tyStr of
+    Just t -> return t
+    _      -> return MIME.Type{mimeType=Text "plain",mimeParams=[]}
+
+getMIMEType :: String -> IO Type
+getMIMEType x = 
+  case parseMIMEType x of
+    Just t -> return t
+    _      -> return MIME.Type{mimeType=Application "octet-stream",mimeParams=[]}

@@ -0,0 +1,87 @@+{-
+  Example of how to create a picture gallery of thumbnails
+  from Flickr, dividing it up into multiple HTML pages.
+  
+  The functionality is exposed as a stand-alone application
+  here, but it shouldn't take much imagination to work out
+  how to take the HTML-generating functions and use it as
+  part of your web application (using your server-side
+  Haskell wrapper of choice..)
+
+  On the Flickr API side, it demonstrates how to use the
+  search-by-tag + interestingness.
+  
+-}
+module Main(main) where
+
+-- the base API functionality, including monad and
+-- supporting types; good thing to start your hsflickr
+-- import lists with
+import Flickr.API
+import Util.Keys ( hsflickrAPIKey, APIKey(..) )
+
+import Flickr.Photos as Photos
+import Flickr.URLs   as URL
+
+import Text.XHtml
+
+import System.IO
+import System.Environment
+
+import Data.Maybe
+
+searchPhotos :: String -> FM [PhotoDetails]
+searchPhotos q = do
+  (_, ps) <- Photos.search Nothing nullSearchConstraints{s_text=Just q} []
+  mapM (\ x -> Photos.getInfo (photoId x) Nothing) ps
+
+generateThumbs :: String -> [(URLString,URLString,String)] -> Html
+generateThumbs s labs = body (
+  concatHtml [ h1 (stringToHtml ("Gallery of '" ++ s ++ "' Flickr photos"))
+             , table (concatHtml (map toRow rws))
+	     ])
+ where
+  rws = splitInto 4 labs
+
+toRow :: [(String,String,String)] -> Html
+toRow xs = tr $ 
+  concatHtml $ 
+    map (\ (imgUrl,imgPage,ttl) -> 
+           td (thediv (anchor (image ! [src imgUrl]) ! [href imgPage] +++ br +++
+               stringToHtml ttl) ! [align "center"] ))
+        xs
+
+main :: IO ()
+main = do
+  ls0 <- getArgs
+  (out,ls) <- 
+    case ls0 of
+      "-o":x:xs -> do
+         h <- openFile x WriteMode
+	 return (\ xs -> hPutStrLn h xs >> hFlush h, xs)
+      _ -> return (putStrLn, ls0)
+  case ls of
+    [] -> do
+      prg <- getProgName
+      putStrLn ("Usage: " ++ prg ++ " search-term")
+    (x:_) -> do
+      putStrLn ("Please authenticate via: " ++ fromMaybe "<unknown>" (apiAuthURL hsflickrAPIKey))
+      putStrLn ("Hit <return> when done so..")
+      hFlush stdout
+      getLine
+      ps <- flickAPI hsflickrAPIKey $ withPageSize 20 $ searchPhotos x
+      let lls = map (\ ph -> ( photoSourceURL ph PhotoSizeThumb
+                             , getPhotoURL ph
+                             , photoTitle (photoDetailsPhoto ph)
+			     ))
+	            ps
+      out (renderHtml $ generateThumbs x lls)
+
+
+splitInto :: Int -> [a] -> [[a]]
+splitInto _ [] = []
+splitInto x xs = 
+  case splitAt x xs of
+   (as,[]) -> [as]
+   (as,bs) -> as : splitInto x bs
+

@@ -0,0 +1,24 @@+module Main(main) where
+
+import Flickr.API
+import Util.Keys ( hsflickrAPIKey )
+
+import Flickr.Photos as Photos
+import System.Environment
+
+searchPhotos :: String -> FM [PhotoDetails]
+searchPhotos q = do
+  (_, ps) <- Photos.search Nothing nullSearchConstraints{s_text=Just q} []
+  mapM (\ x -> Photos.getInfo (photoId x) Nothing) ps
+
+main :: IO ()
+main = do
+  ls <- getArgs
+  case ls of
+    [] -> do
+      prg <- getProgName
+      putStrLn ("Usage: " ++ prg ++ " search-term")
+    (x:_) -> do
+      ps <- flickAPI hsflickrAPIKey $ withPageSize 20 $ searchPhotos x
+      putStrLn ("Search results for: " ++ x)
+      mapM_ (\ p -> putStrLn (photoTitle (photoDetailsPhoto p) ++ " = " ++ getPhotoURL p)) ps

@@ -0,0 +1,49 @@+{-
+  List the public photos for a given user; demonstrates
+  the use of the flickr.people + photos APIs for accessing
+  public/non-authenticated calls methods.
+-}
+module Main(main) where
+
+import Flickr.API
+import Util.Keys ( hsflickrAPIKey )
+
+import Flickr.People as People
+import Flickr.Photos as Photos
+import System.Environment
+
+getUserFromName :: String -> FM (Maybe User)
+getUserFromName uname = do
+  mb  <- tryFlick $ People.findByUsername uname
+  case mb of
+    Left err 
+     | flickErrorCode err == 1 -> do
+       liftIO $ putStrLn ("Unknown user: " ++ uname)
+       return Nothing
+     | otherwise -> liftIO (putStrLn (show (flickErrorCode err))) >> throwFlickErr err
+    Right u -> return (Just u)
+
+getPubPhotos :: String -> FM [PhotoDetails]
+getPubPhotos uname = do
+  mb  <- getUserFromName uname
+  case mb of
+    Nothing -> return []
+    Just u  -> do
+        -- only return the first ten photos:..
+      ps <- withPageSize 10 $ People.getPublicPhotos (userId u) Nothing []
+      liftIO $ putStrLn ("Number of public photos: " ++ show (length ps))
+      mapM (\ x -> Photos.getInfo (photoId x) Nothing) ps
+
+main :: IO ()
+main = do
+  ls <- getArgs
+  case ls of
+    [] -> do
+      prg <- getProgName
+      putStrLn ("Usage: " ++ prg ++ " user-name")
+    (x:_) -> do
+      ps <- flickAPI hsflickrAPIKey $ getPubPhotos x
+      putStrLn ("Public photos for: " ++ x)
+      mapM_ (\ p -> putStrLn (photoTitle (photoDetailsPhoto p) ++ " = " ++ getPhotoURL p)) ps
+
+  

@@ -0,0 +1,49 @@+module Main(main) where
+
+import Flickr.API
+import Flickr.Photos.Upload as Photos
+
+import System.IO
+import System.Environment
+
+import Util.Authenticate
+import Util.Keys
+
+-- assume you have set the api_key and secret..but no token.
+loginUser :: String -> FM (URLString, AuthToken)
+loginUser p = do
+  (Just (u, mkT)) <- authenticateForWeb p
+  liftIO (putStrLn ("Authorization URL: " ++ u))
+  liftIO (putStrLn ("Hit return after user has authorized call"))
+  liftIO (hFlush stdout)
+  liftIO getLine
+  tok <- mkT
+  return (u, tok)
+
+getAToken :: [String] -> FM (AuthToken, [String], APIKey)
+getAToken ls = do
+   case ls of
+     ("-t":x:ls1) -> do
+       liftIO $ putStrLn ("Using mini-token: " ++ x)
+       (Just (_, mkT)) <- authenticateForMobile "write"
+       tok <- mkT x
+       liftIO $ putStrLn ("Token: " ++ authToken tok)
+       return (tok, ls1, hsflickr_mobile_key)
+     _ -> do
+       (_,tok) <- withAPIKey hsflickr_web_key $ loginUser "write"
+       liftIO $ putStrLn ("Token: " ++ authToken tok)
+       return (tok, ls, hsflickr_web_key)
+
+main :: IO ()
+main = flick $ do
+  ls0          <- liftIO $ getArgs
+  (tok, ls,ak) <- getAToken ls0
+  case ls of
+    (photo_file:title:desc:tags) -> withAPIKey ak $ withAuthToken (authToken tok) $ do
+       pid <- Photos.uploadPhoto photo_file (Just title) (Just desc) tags nullUploadAttr
+       liftIO $ putStrLn ("Photo ID of uploaded photo: " ++ pid)
+    _ -> liftIO $ do
+      p <- getProgName
+      putStrLn ("Usage: " ++ p ++ " [-t mini-token] upload_file title description [tag]*")
+  
+  

@@ -0,0 +1,90 @@+name: flickr
+version: 0.2
+Synopsis: Haskell binding to the Flickr API
+Description:
+   The flickr API binding lets you access flickr.com's
+   resources and methods from Haskell.
+
+   Implements the full API, as specified by <http://flickr.com/services/api/>
+category      : Web
+license       :  BSD3
+license-file  : LICENSE
+author        : Sigbjorn Finne <sof@forkIO.com>
+maintainer    : sof@forkIO.com
+cabal-version :  >= 1.2
+build-type    : Simple
+extra-source-files: README 
+                    examples/Uploader.hs 
+                    examples/Gallery.hs
+                    examples/SearchPhotos.hs
+                    examples/ShowPublicPhotos.hs
+
+flag new-base
+  Description: Build with new smaller base library
+  Default: False
+
+library
+ Exposed-modules: Flickr.API,
+                  Flickr.Types,
+                  Flickr.Types.Import,
+                  Flickr.Activity,
+                  Flickr.Auth,
+                  Flickr.Blogs,
+                  Flickr.Contacts,
+                  Flickr.Favorites,
+                  Flickr.Groups,
+                  Flickr.Groups.Pools,
+                  Flickr.Interestingness,
+                  Flickr.Prefs,
+                  Flickr.People,
+                  Flickr.Photos,
+                  Flickr.Photos.Comments,
+                  Flickr.Photos.Geo,
+                  Flickr.Photos.Upload,
+                  Flickr.Photos.Transform,
+                  Flickr.Photos.Notes,
+                  Flickr.Photos.Licenses,
+                  Flickr.Photosets,
+                  Flickr.Photosets.Comments,
+                  Flickr.Places,
+                  Flickr.Tags,
+                  Flickr.URLs,
+                  Flickr.Utils,
+                  Util.Fetch,
+                  Util.Keys,
+                  Util.MIME,
+                  Util.Post,
+                  Util.Authenticate,
+                  Util.MD5,
+                  Codec.Percent,
+                  Codec.URLEncoder
+
+-- Extra-libraries: curl, xml, HTTP, network
+ Ghc-Options:     -Wall
+
+ build-depends: base, HTTP, network, xml, mime >= 0.3, random, utf8-string, filepath
+ if flag(new-base)
+   Build-Depends: base >= 3
+ else
+   Build-Depends: base < 3
+
+executable showPublic {
+  main-is:              examples/ShowPublicPhotos.hs
+  ghc-options:          -Wall
+}
+
+executable searchPics {
+  main-is:              examples/SearchPhotos.hs
+  ghc-options:          -Wall
+}
+
+executable gallery {
+  main-is:              examples/Gallery.hs
+  build-depends:        xhtml
+  ghc-options:          -Wall
+}
+
+executable uploader {
+  main-is:              examples/Uploader.hs
+  ghc-options:          -Wall
+}