cothinkers3.hs

import qualified Data.ByteString.Lazy.Char8 as L8
import           Network.HTTP.Client        (defaultManagerSettings, newManager)
import           Network.HTTP.Simple
import           Network.HTTP.Client.TLS
import System.Directory
import qualified Data.Map as M
import Data.List (sortBy)
import Control.Monad
import Control.Applicative
import System.Environment
import System.IO

(isreading, readby) = (">", "<")

get_friends_resp user mg = do
  let fname = "friends_" ++ user ++ ".txt"
  cached <- doesFileExist fname
  if cached then readFile fname
    else do
      let request = setRequestManager mg . parseRequest_ $ "https://www.livejournal.com/misc/fdata.bml?user="++user
      body <- L8.unpack . getResponseBody <$> httpLBS request
      writeFile fname body
      return body

get_friends user marker mg =
  map (drop 2) . filter ((== marker) . take 1) . lines <$> get_friends_resp user mg

process_friend mg n marker (mp, k) user = do
  putStr $ "\r" ++ (show k) ++ "/" ++ (show n)
  hFlush stdout
  readers <- get_friends user marker mg
  return $ (foldl (\m u -> M.insertWith (+) u 1 m) mp readers, k+1)

collect friends mg marker = do
  (m,_) <- foldM (process_friend mg (length friends) marker) (M.empty, 1) friends
  let lst = filter (\(u,k) -> k > 1) $ M.toList m
  return $ map (\(u,k) -> (u,k, elem u friends)) $ sortBy (\(_,k1) (_,k2) -> compare k2 k1) lst

mkline include_friends (u,k,f) =
  let line = (show k) ++ " <a href=\"https://" ++ u ++ ".livejournal.com\">" ++ u ++ "</a> "
  in if include_friends
      then line ++ (if f then "*" else "") ++ "<br>\n"
      else if f then "" else line ++ "<br>\n"

get_cothinkers username = do
  manager <- newManager tlsManagerSettings
  friends <- get_friends username isreading manager
  cothinkers  <- concat . map (mkline False) <$> collect friends manager readby
  influencers <- concat . map (mkline True)  <$> collect friends manager isreading
  let answer = "<table border=0 width=100%><tr><td valign=\"top\"><h3>Cothinkers</h3>" ++
        "<i>who read your friends</i><p>" ++ cothinkers ++
        "</td><td valign=\"top\"><h3>Influencers</h3> <i>who your friends read</i><p>"
        ++ influencers ++ "</td></tr></table>"
  writeFile "cothinkers.html" answer
  putStrLn "\ndone!\n"

main = do
  args <- getArgs
  case args of
    [] -> putStrLn "usage: cothinkers username"
    username : _ -> get_cothinkers username