ItsNotWorking.hs

module ItsNotWorking (
      getLinks
    ) where

import Text.HTML.TagSoup
import Text.Regex.Posix
import Network.HTTP

isInteresting :: String -> Bool
isInteresting link = any (link =~) supported
                     where supported = [ "mediafire"
                                       , "rapidshare" ]

cleanUp :: [String] -> [String]
cleanUp []     = []
cleanUp (x:xs) = x : cleanUp (filter (/= x) xs)

openURL :: String -> IO String
openURL url = getResponseBody =<< simpleHTTP (getRequest url)

getTagsFromUrl :: String -> IO [Tag String]
getTagsFromUrl = fmap parseTags . openURL

getLinks :: String -> IO [String]
getLinks url = do
    tags <- getTagsFromUrl url
    return $ cleanUp [ link | TagOpen "a" atts <- tags
                            , ("href", link) <- atts
                            , isInteresting link ]

Main.hs

module Main where

import System.Environment
import System.Directory
import ItsNotWorking

baseURL = "http://itsnotworking.mezoka.com/"

makeURL :: String -> String
makeURL x = baseURL ++ x ++ "text/index.html"

grab :: String -> IO ()
grab x = getLinks (makeURL x) >>= appendFile "links" . unlines

main :: IO ()
main = safeRemoveFile "links" >> getArgs >>= mapM_ grab

safeRemoveFile :: String -> IO ()
safeRemoveFile file = do
    exists <- doesFileExist file
    if exists
       then removeFile file
       else return ()