Source

astrosearch / UserInfo.hs

Full commit
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-
Store user info (friends and/or followers) in an AcidState store.
-}

module UserInfo
       ( UserInfoStore(..)
       , emptyUserInfoStore

       , GetTwitterLimits(..)
       , GetAllFriends(..)
       , GetFriends(..)
       , AddTwitterLimits(..)
       , AddFriends(..)
       , SetProtectedFriends(..)
       , HasFriends(..)
       ) where

import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad (liftM)
import Control.Monad.Reader (ask)                  
import Control.Monad.State (get, put)

import Data.Acid
import Data.Time (UTCTime)
import Data.Typeable
import Data.SafeCopy

import SPARQL (UserId)

-- We only store "complete" results for a user.
--
-- TODO: need to improve handling for protected information
--
data UserInfoStore = 
    UserInfoStore 
    { uisLimit   :: Maybe (Int, Integer)
          -- ^ rate limit info from Twitter     
    , uisFriends :: M.Map UserId (Maybe (UTCTime, S.Set UserId))
          -- ^ who does the user follow (their friends) and the time
          --   the search was made.
          --   'Nothing' is used to indicate that
          --   the information is protected.
    , uisFollowers :: M.Map UserId (Maybe (UTCTime, S.Set UserId))
          -- ^ who follows this user  and the time
          --   the search was made.
          --   'Nothing' is used to indicate that
          --   the information is protected.
    } deriving (Typeable)

emptyUserInfoStore :: UserInfoStore
emptyUserInfoStore = UserInfoStore Nothing M.empty M.empty

$(deriveSafeCopy 0 'base ''UserId)
$(deriveSafeCopy 0 'base ''UserInfoStore)

-- | What was the last-saved Twitter API limit in the store?
getTwitterLimits :: Query UserInfoStore (Maybe (Int, Integer))
getTwitterLimits = uisLimit `liftM` ask

-- | Add the Twitter API limit to the store; the `Int`
--   value gives the number of calls left and the
--   `Integer` value is the reset time.
addTwitterLimits :: (Int, Integer) -> Update UserInfoStore ()
addTwitterLimits lims = do
  UserInfoStore _ a b <- get
  put $ UserInfoStore (Just lims) a b

-- | Get all the users and their friendships.
getAllFriends :: Query UserInfoStore (M.Map UserId (Maybe (UTCTime, S.Set UserId)))
getAllFriends = uisFriends `liftM` ask

-- | Get the friends for the user; `Nothing` is returned if the
--   user is not known.
getFriends :: UserId -> Query UserInfoStore (Maybe (Maybe (UTCTime, S.Set UserId)))
getFriends uid = (M.lookup uid . uisFriends) `liftM` ask

-- | Do the users have friends in the store?
hasFriends :: [UserId] -> Query UserInfoStore [Bool]
hasFriends uids = ask >>= \uis -> return $ map (`M.member` uisFriends uis) uids

-- | Add the friends of a user. This replaces any existing
--   information. See also 'setProtectedFriends'.
addFriends :: UserId -> (UTCTime, S.Set UserId) -> Update UserInfoStore ()
addFriends uid friends = do
  UserInfoStore ml a b <- get
  put $ UserInfoStore ml (M.insertWith' const uid (Just friends) a) b

-- | Update the user info to note that they have protected their friends list.
setProtectedFriends :: UserId -> Update UserInfoStore ()
setProtectedFriends userid = do
  UserInfoStore ml a b <- get
  put $ UserInfoStore ml (M.insertWith' const userid Nothing a) b

$(makeAcidic ''UserInfoStore
  [ 'getTwitterLimits
  , 'getAllFriends
  , 'getFriends
  , 'addTwitterLimits
  , 'hasFriends
  , 'addFriends
  , 'setProtectedFriends
  ])