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
checkTickets :: [TicketID] -> FM [Ticket]
checkTickets tids =
flickTranslate toTicketList $
flickrCall "flickr.photos.upload.checkTickets"
[ ("tickets", intercalate "," tids) ]
uploadPhoto :: FilePath
-> Maybe String
-> Maybe String
-> [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
}
replacePhoto :: FilePath
-> 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)