--------------------------------------------------------------------
-- |
-- Module      : FriendFeed.List
-- Description : Look up FriendFeed lists
-- Copyright   : (c) Sigbjorn Finne, 2008
-- License     : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
-- Actions for fetching info regarding a user's FriendFeed lists.
-- 
--------------------------------------------------------------------
module FriendFeed.List where

import FriendFeed.Types
import FriendFeed.Types.Import ()
import FriendFeed.Monad

-- | Returns a list of all of the list's members 
-- and the url associated with the list
-- (Authentication required): 
getListProfile :: ListName -> FFm List
getListProfile l = authCall $
  ffeedTranslate $
    ffeedCall ["list",l,"profile"] []

-- | Returns entries from the authenticated users 
-- list with the given nickname:
getListEntries :: ListName -> FFm [Entry]
getListEntries l = authCall $
  ffeedTranslateLs "entries" $
    ffeedCall ["feed","list",l] []