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) ++ " " ++ u ++ " " in if include_friends then line ++ (if f then "*" else "") ++ "
\n" else if f then "" else line ++ "
\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 = "

Cothinkers

" ++ "who read your friends

" ++ cothinkers ++ "

Influencers

who your friends read

" ++ influencers ++ "

" writeFile "cothinkers.html" answer putStrLn "\ndone!\n" main = do args <- getArgs case args of [] -> putStrLn "usage: cothinkers username" username : _ -> get_cothinkers username