Some usage of liblastfm

lastfm-distance.hs

import Control.Applicative ((<$>))
import Control.Monad ((<=<), forever, liftM, liftM2)
import Data.Function (on)
import Data.Maybe (fromMaybe)
import Data.Time.Format (formatTime)
import Data.Time.LocalTime (getZonedTime)
import GHC.Conc.IO (threadDelay)
import Network.Lastfm.Types
import Network.Lastfm.API.User
import System.Directory (getHomeDirectory)
import System.FilePath ((</>))
import System.Locale (defaultTimeLocale)
import Text.Printf (printf)
import Text.XML.Light

newtype KludgeResponse = KludgeResponse {unwrap :: Element}

{- some config -}
apiKey = APIKey "b25b959554ed76058ac220b7b2e0a026"
user1 = User "smpcln"
user2 = User "MCDOOMDESTROYER"
timeDelay = 5 -- in minutes
logFile = ".log/lastfm-distance.log"

{- main stuff -}
main = do
  homeDir <- getHomeDirectory
  let logFilePath = homeDir </> logFile
      logDiff     = appendFile logFilePath .: logMessage
  forever $ mainLoop logDiff

mainLoop logDiff = do
  diff      <- user1 `subtractCounts` user2
  timestamp <- formatTime defaultTimeLocale "[%s] %D %H:%M" <$> getZonedTime
  logDiff timestamp diff
  threadDelay $ 10^6 * 60 * timeDelay -- in microseconds

(f .: g) x y = f $ g x y

subtractCounts :: User -> User -> IO Integer
subtractCounts = liftM2 ((-) `on` fromMaybe 0) `on` getPlayCount

logMessage :: String -> Integer -> String
logMessage  = printf "%s %d\n"

{- kludges kludges kludges -}
wrap :: String -> Maybe KludgeResponse
wrap = Just . KludgeResponse . (!! 1) . onlyElems . parseXML

tag = lookupChild
content = getContent

lookupChild :: String -> KludgeResponse -> Maybe KludgeResponse
lookupChild tag' = liftM KludgeResponse . findChild (unqual tag') . unwrap

getContent :: KludgeResponse -> Maybe String
getContent = Just . strContent . unwrap

getPlayCount :: User -> IO (Maybe Integer)
getPlayCount user = do
  response <- getInfo (Just user) apiKey
  case response of
    Left _  -> return Nothing
    Right r -> return . fmap read . playCount $ r
  where playCount = getContent <=< lookupChild "playcount" <=< lookupChild "user" <=< wrap