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
addTags :: PhotoID -> [Tag] -> FM ()
addTags pid tgs = withWritePerm $ postMethod $
flickCall_ "flickr.photos.addTags"
(lsArg "tags" tgs
[ ("photo_id", pid) ])
delete :: PhotoID -> FM ()
delete pid = withDeletePerm $ postMethod $
flickCall_ "flickr.photos.delete"
[ ("photo_id", pid) ]
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)
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) [])
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) [])
getContext :: PhotoID -> FM (Photo,Photo)
getContext pid =
flickTranslate toPhotoPair $
flickrCall "flickr.photos.getContext"
[ ("photo_id", pid) ]
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 [])
getExif :: PhotoID -> Maybe String -> FM [EXIF]
getExif pid secret =
flickTranslate toEXIFList $
flickrCall "flickr.photos.getExif"
(mbArg "secret" secret
[ ("photo_id", pid) ])
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
getInfo :: PhotoID -> Maybe String -> FM PhotoDetails
getInfo pid secret =
flickTranslate toPhotoDetails $
flickrCall "flickr.photos.getInfo"
(mbArg "secret" secret
[ ("photo_id", pid) ])
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
getPerms :: PhotoID -> FM Permissions
getPerms pid = withReadPerm $
flickTranslate toPermissions $
flickrCall "flickr.photos.getPerms"
[ ("photo_id", pid) ]
getRecent :: [PhotoInfo] -> FM [Photo]
getRecent extras = liftM snd $
flickTranslate toPhotoList $
flickrCall "flickr.photos.getRecent"
(lsArg "extras" (map show extras) [])
getSizes :: PhotoID -> FM [SizeDetails]
getSizes pid =
flickTranslate toSizeList $
flickrCall "flickr.photos.getSizes"
[ ("photo_id", pid) ]
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
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
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
recentlyUpdated :: DateString -> [PhotoInfo] -> FM (PhotoContext, [Photo])
recentlyUpdated minDate extras = withReadPerm $
flickTranslate toPhotoList $
flickrCall "flickr.photos.recentlyUpdated"
(lsArg "extras" (map show extras)
[ ("min_date", minDate) ])
removeTag :: Tag -> FM ()
removeTag tag = withWritePerm $ postMethod $
flickCall_ "flickr.photos.removeTag"
[ ("tag_id", tag) ]
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
}
setContentType :: PhotoID -> ContentType -> FM ()
setContentType pid c = withWritePerm $ postMethod $
flickCall_ "flickr.photos.setContentType"
[ ("photo_id", pid)
, ("content_type", showContentType c)
]
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) ])
setMeta :: PhotoID -> Title -> Description -> FM ()
setMeta pid title desc = withWritePerm $ postMethod $
flickCall_ "flickr.photos.setMeta"
[ ("photo_id", pid)
, ("title", title)
, ("description", desc)
]
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))
]
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) ])
setTags :: PhotoID -> [Tag] -> FM ()
setTags pid ts = withWritePerm $ postMethod $
flickCall_ "flickr.photos.setTags"
(lsArg "tags" ts $
[ ("photo_id", pid)])
getPhotoURL :: PhotoDetails -> URLString
getPhotoURL p =
case fromMaybe "" (photoURL (photoDetailsPhoto p)) of
"" -> case photoDetailsURLs p of
[] -> "<unknown>"
(u:_) -> urlDetailsURL u
us -> us