<commit_before>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- module Crawler

{-
 - TODO: write module description
 -}

module Crawler where

import Control.Monad
import Control.Exception
import Data.Char
import Data.Typeable
import Database.Redis
import Network.HTTP hiding (Connection)
import System.IO
import Text.HTML.TagSoup

import qualified Data.ByteString.Char8 as BC

import Data.Set (Set)
import qualified Data.Set as Set

----------------------------------------------------------------------

type URL = String

defaultURLFile :: FilePath
defaultURLFile = "data/urls.txt"

-- read file containing list of URLs to crawl
readURLFile :: FilePath -> IO [URL]
readURLFile = fmap lines . readFile

-- write new URLs to the end of the URL file, given its open handle
-- TODO: rewrite to process multiple URLs at once
updateURLFile :: FilePath -> String -> IO ()
updateURLFile fp url = undefined
  where
    deleteFirstLine = undefined

-- read file containing list of words to ignore into Set structure
readIgnoreFile :: FilePath -> IO (Set String)
readIgnoreFile = fmap (Set.fromList . lines) . readFile

-- request a page
httpRequest :: URL -> IO String
httpRequest = simpleHTTP . getRequest >=> getResponseBody

sectionTag :: String -> [Tag String] -> [[Tag String]]
sectionTag tag = sections (~== TagOpen tag [])

getTitle :: [Tag String] -> String
getTitle = unwords
         . map (fromTagText . head . filter isTagText)
         . sectionTag "title"

-- get the text content of a page;
-- acceptable content is extracted by validTags and harvested
getBody :: [Tag String] -> [String]
getBody = harvest . sectionTag "p"
  where
    harvest  = map niceText . concatMap getText
    getText  = words . fromTagText . head . filter isTagText
    niceText = filter (\c -> isAlpha c || isSpace c)

getLinks :: [Tag String] -> [String]
getLinks = map getHref . sectionTag "a"
  where
    getHref = fromAttrib "href" . head . filter isTagOpen

{-
 - Possibly better as:

data Page = Data String [String] [String]

 - ?
 -}

-- type Page = (Title, Words, Links)
type Page = (String, [String], [String])

getPage :: String -> Page
getPage page =
    let tags = parseTags page
    in (getTitle tags, getBody tags, getLinks tags)

----------------------------------------------------------------------

-- for debugging
testPage = httpRequest "http://stackoverflow.com/questions/1012573/getting-started-with-haskell"

testGetPage = fmap getPage testPage

----------------------------------------------------------------------

-- exception instance to handle possible exceptions from the crawler
data CrawlerException = RedisError
                      | ServerError
                      deriving (Show, Typeable)
<commit_msg>commenting<commit_after>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- module Crawler

{-
 - TODO: write module description
 -}

module Crawler where

import Control.Monad
import Control.Exception
import Data.Char
import Data.Typeable
import Database.Redis
import Network.HTTP hiding (Connection)
import System.IO
import Text.HTML.TagSoup

import qualified Data.ByteString.Char8 as BC

import Data.Set (Set)
import qualified Data.Set as Set

----------------------------------------------------------------------

type URL = String

defaultURLFile :: FilePath
defaultURLFile = "data/urls.txt"

-- read file containing list of URLs to crawl
readURLFile :: FilePath -> IO [URL]
readURLFile = fmap lines . readFile

-- write new URLs to the end of the URL file, given its open handle
-- TODO: rewrite to process multiple URLs at once
updateURLFile :: FilePath -> String -> IO ()
updateURLFile fp url = undefined
  where
    deleteFirstLine = undefined

-- read file containing list of words to ignore into Set structure
readIgnoreFile :: FilePath -> IO (Set String)
readIgnoreFile = fmap (Set.fromList . lines) . readFile

-- request a page
httpRequest :: URL -> IO String
httpRequest = simpleHTTP . getRequest >=> getResponseBody

sectionTag :: String -> [Tag String] -> [[Tag String]]
sectionTag tag = sections (~== TagOpen tag [])

-- get the title of a page
getTitle :: [Tag String] -> String
getTitle = unwords
         . map (fromTagText . head . filter isTagText)
         . sectionTag "title"

-- get the text content of a page
getBody :: [Tag String] -> [String]
getBody = harvest . sectionTag "p"
  where
    harvest  = map niceText . concatMap getText
    getText  = words . fromTagText . head . filter isTagText
    niceText = filter (\c -> isAlpha c || isSpace c)

-- get the list of all links on a page
getLinks :: [Tag String] -> [String]
getLinks = map getHref . sectionTag "a"
  where
    getHref = fromAttrib "href" . head . filter isTagOpen

-- type Page = (Title, Words, Links)
type Page = (String, [String], [String])

-- unified page get function
getPage :: String -> Page
getPage page =
    let tags = parseTags page
    in (getTitle tags, getBody tags, getLinks tags)

----------------------------------------------------------------------

-- for debugging
testPage = httpRequest "http://stackoverflow.com/questions/1012573/getting-started-with-haskell"

testGetPage = fmap getPage testPage

----------------------------------------------------------------------

-- exception instance to handle possible exceptions from the crawler
data CrawlerException = RedisError
                      | ServerError
                      deriving (Show, Typeable)

{'fraction_non_alphanumeric': 0.16449899248946692, 'fraction_numerical': 0.0029309397325517493, 'mean_word_length': 2.4535104364326377, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1259765', 'n_tokens_mistral': 1495, 'n_tokens_neox': 1461, 'n_words': 552}