hScraper (empty) → 0.1.0.0
raw patch · 12 files changed
+585/−0 lines, 12 filesdep +HTTPdep +basedep +bytestringsetup-changed
Dependencies added: HTTP, base, bytestring, directory, http-conduit, http-types, parsec, process, regex-compat, text, transformers
Files
- HScraper.hs +36/−0
- HScraper/HTMLparser.hs +145/−0
- HScraper/Main.hs +54/−0
- HScraper/Network.hs +77/−0
- HScraper/Query.hs +83/−0
- HScraper/QueryParser.hs +42/−0
- HScraper/Tidy.hs +22/−0
- HScraper/Types.hs +41/−0
- LICENSE +28/−0
- README.md +9/−0
- Setup.hs +2/−0
- hScraper.cabal +46/−0
+ HScraper.hs view
@@ -0,0 +1,36 @@+{- |+A library to parse, crawl and scrape webpages.++An example :++@+import HScraper++main :: IO ()+main = do+ html <- parseSite "https://kat.cr/leopard-raws-taimadou-gakuen-35-shiken-shoutai-05-raw-sun-1280x720-x264-aac-mp4-t11528616.html/"+ let q1 = getParsedQuery "a[movieCover]"+ print $ html |>> q1+ let q2 = getParsedQuery "a"+ let ans = html |>> q2+ mapM_ (print . getAttribute "href" ) ans -- get all hyperlinks.+@+-}++module HScraper (+ module HScraper.HTMLparser ,+ module HScraper.Network ,+ module HScraper.Query ,+ module HScraper.Types ,+ module HScraper.Tidy ,+ module HScraper.Main+ ) where+++import HScraper.HTMLparser+import HScraper.Network+import HScraper.Query+import HScraper.Tidy+import HScraper.Types+import HScraper.Main+
+ HScraper/HTMLparser.hs view
@@ -0,0 +1,145 @@+{- |+Module for parsing html.+-}++{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts #-}+module HScraper.HTMLparser (+ parseHtml+ ) where+import Control.Monad (void)+import Control.Applicative((<$>), (<*))++import Data.List (nub)+import Data.Char+import qualified Data.Text as T+import Text.Parsec+++import HScraper.Types++parseHtml :: T.Text -> Either ParseError HTMLTree+parseHtml s = case parse baseParser "" (T.unwords (T.words s)) of+ Left err -> Left err+ Right nodes -> Right $+ if length nodes == 1+ then head nodes+ else case filter filterHelper nodes of+ [] -> toTree "html" [] nodes+ x -> head x+++baseParser = docType <|> parseNodes++filterHelper :: HTMLTree -> Bool+filterHelper (NTree (Element x _) _ ) | x == "html" = True+filterHelper _ = False++oneLiners = (toLeaf . T.pack) <$> do+ _ <- spaces+ _ <- char '<'+ _ <- manyTill (noneOf ">") $try (string "/>")+ return ""++slashFollowedByAlpha = do+ _ <- char '/'+ a <- oneOf ['a'..'z']+ _ <- char '>'+ return [a]++docType = do+ try docTypeHandler+ parseNodes++docTypeHandler = (toLeaf . T.pack) <$> do+ _ <- spaces+ _ <- string "<!"+ _ <- manyTill anyChar (char '>')+ return ""++comments = (toLeaf . T.pack) <$> do+ _ <- spaces+ _ <- string "<!--"+ _ <- manyTill anyChar (try $string "-->")+ return ""++comments' = (toLeaf . T.pack) <$> do+ _ <- spaces+ _ <- string "/*"+ _ <- manyTill anyChar (try $string "*/")+ return ""+parseNodes :: Stream s m Char => ParsecT s u m [HTMLTree]+parseNodes = manyTill parseNode last'+ where+ last' = eof <|> void (try (string "</"))++parseNode :: Stream s m Char => ParsecT s u m HTMLTree+parseNode = try oneLiners <|> try comments <|> try comments' <|> try docTypeHandler<|> parseElement <|> parseText++parseText :: Stream s m Char => ParsecT s u m HTMLTree+parseText = (toLeaf . T.pack) <$>do+ _ <- spaces+ many (noneOf "<")++exceptionList :: [String]+exceptionList = ["link", "br", "img", "meta", "hr", "input"]++endList = ["br>"]++parseElement :: Stream s m Char => ParsecT s u m HTMLTree+parseElement = do+ (tag, attrs) <- between (char '<') (char '>') tagData+ tempTag tag attrs++tempTag :: Stream s m Char => String -> [(T.Text, T.Text)] -> ParsecT s u m HTMLTree+tempTag tag attrs+ | map toLower tag `elem` exceptionList = return $ toTree (T.pack tag) attrs []+ | map toLower tag == "script" = do+ _ <- manyTill anyChar (try $string "</script")+ return $ toTree (T.pack tag) attrs []+ | map toLower tag == "style" = do+ _ <- manyTill anyChar (try $string "</style")+ return $ toTree (T.pack tag) attrs []+ | otherwise = do+ children <- parseNodes+ _ <- string $tag ++ ">"+ return $ toTree (T.pack tag) attrs $nub children++tagData :: Stream s m Char => ParsecT s u m (String, [(T.Text, T.Text)])+tagData = do+ t <- tagName+ attrs <- attributes+ return (t,attrs)++tagName :: Stream s m Char => ParsecT s u m String+tagName = many1 (try (char ':') <|> try (char '-') <|> try (char '_') <|> try (char '.') <|> try (char ';') <|> alphaNum)++attributes :: Stream s m Char => ParsecT s u m [(T.Text, T.Text)]+attributes = spaces >> many (trailingSpaces (try attribute <|> try attribute' <|> try simpleTextInsideTag))++trailingSpaces :: Stream s m Char => ParsecT s u m a -> ParsecT s u m a+trailingSpaces = (<* spaces)++attribute :: Stream s m Char => ParsecT s u m (T.Text, T.Text)+attribute = do+ name <- tagName+ spaces+ _ <- char '='+ spaces+ open <- char '\"' <|> char '\''+ -- value <- many (noneOf [open])+ value <- manyTill (try (char ' ') <|> anyChar) (try $ char open)+ return (T.pack name, T.pack value)++attribute' :: Stream s m Char => ParsecT s u m (T.Text, T.Text)+attribute' = do+ name <- tagName+ spaces+ _ <- char '='+ spaces+ value <- many (noneOf "> ")+ return (T.pack name, T.pack value)++simpleTextInsideTag = do+ a <- many1 alphaNum+ spaces+ return (T.pack a, T.pack "")
+ HScraper/Main.hs view
@@ -0,0 +1,54 @@+{- |+Module for various convenience functions and error-free wrappers of parsers so that+they can be used for batches of urls.+-}++module HScraper.Main (+ getFromFile,+ getParsedHTML,+ getParsedQuery,+ parseSite+ ) where++import System.IO+import HScraper.HTMLparser+import HScraper.Network+import HScraper.Query+import HScraper.Tidy+import HScraper.Types++import Control.Applicative+import Data.Monoid++import qualified Data.Text.IO as TIO+import qualified Data.Text as T++-- | Tries to parse html from file. returns 'NullTree'+-- if parsing fails.+getFromFile :: FilePath -> IO HTMLTree+getFromFile str = getParsedHTML_ <$> parseHtml <$> (openFile str ReadMode >>= TIO.hGetContents)++tempHTMLTree :: IO HTMLTree+tempHTMLTree = getParsedHTML_ <$> parseHtml <$> (tidy =<< fetchResponse "http://home.iitk.ac.in/~nishgu/")++getParsedHTML_ :: Either a HTMLTree -> HTMLTree+getParsedHTML_ = either (const NullTree) id++-- | like 'parseHtml' but returns 'NullTree'+-- if parsing fails.+getParsedHTML :: T.Text -> HTMLTree+getParsedHTML = getParsedHTML_ . parseHtml++getParsedQuery_ :: Either a Query -> Query+getParsedQuery_ = either (const []) id++-- | Takes a 'String' and tries to parse as 'Query'+-- returns empty query if parsing fails.+getParsedQuery :: String -> Query+getParsedQuery = getParsedQuery_ . parseQuery++-- | takes url and returns parsed 'HTMLTree'.+parseSite :: String -> IO HTMLTree+parseSite url = do+ str <- tidy =<< fetchResponse url+ return $ getParsedHTML str
+ HScraper/Network.hs view
@@ -0,0 +1,77 @@+{- |+Module for fetching different requests over network(Wrapper around http-conduit).+-}++module HScraper.Network+ ( fetchResponse+ , parseParams+ , fetchRequestWith+ , defaultGETRequest+ , fetchGETRequest+ , defaultPOSTRequest+ , fetchPOSTRequest+ ) where++import Control.Monad++import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Char8 (pack)+import qualified Data.ByteString as B+import Data.Text.Encoding+import qualified Data.Text as T+import Control.Applicative((<$>))+import Network.HTTP.Conduit+import Network.HTTP.Types.Method+import Network.HTTP.Types.Header++-- | A Simple wrapper around simpleHttp so that+-- it goes along with with other functions.+fetchResponse :: String -> IO T.Text+fetchResponse url = liftM (decodeUtf8 . B.concat . BL.toChunks ) $ simpleHttp url++-- | Parses a list of (key,value) pairs to pass with GET and POST requests.+parseParams :: [(String, String)] -> String+parseParams [] = ""+parseParams [(name, value)] = name ++ "=" ++ value+parseParams ((name, value) : xs) = name ++ "=" ++ value ++ "&" ++ parseParams xs++-- | takes a Request and a Manager and returns the response.+-- Useful when querying with a modified request.+fetchRequestWith :: Request -> Manager -> IO T.Text+fetchRequestWith req manager = decodeUtf8 . B.concat . BL.toChunks . responseBody <$> httpLbs req manager++-- | Minimal GET request, modify it to add proxy,cookies,user-agent etc.+-- Then fetch using @fetchRequestWith.+defaultGETRequest :: String -> [(String,String)] -> IO Request+defaultGETRequest url list = do+ initReq <- parseUrl url+ return initReq { method = methodGet+ , queryString = pack $ parseParams list+ }++-- | Fetches request using @defaultGETRequest.+fetchGETRequest :: String -> [(String, String)] -> IO T.Text+fetchGETRequest url list = do+ req <- defaultGETRequest url list+ man <- newManager tlsManagerSettings+ res <- httpLbs req man+ return $ decodeUtf8 . B.concat . BL.toChunks $ responseBody res++-- | Minimal POST request, modify it to add proxy,cookies,user-agent etc.+-- Then fetch using @fetchRequestWith.+defaultPOSTRequest :: String -> [(String,String)] -> IO Request+defaultPOSTRequest url list = do+ initReq <- parseUrl url+ return initReq { method = methodPost+ , requestBody = RequestBodyBS $ Data.ByteString.Char8.pack $ parseParams list+ , requestHeaders = [ (hContentType, pack "application/x-www-form-urlencoded" ) ]+ }++-- | Fetches request using @defaultPOSTRequest.+fetchPOSTRequest :: String -> [(String, String)] -> IO T.Text+fetchPOSTRequest url list = do+ req <- defaultPOSTRequest url list+ manager <- newManager tlsManagerSettings+ res <- httpLbs req manager+ return $ decodeUtf8 . B.concat . BL.toChunks $ responseBody res+
+ HScraper/Query.hs view
@@ -0,0 +1,83 @@+{- |+ A simple 'Query' format to query the 'HTMLTree'.++ The Syntax is as follows :+@+ "nodeName[Class(optional)]{ID(optional)} > nodeName[Class(optional)]{ID(optional)}"+@++eg : @"div{id1} > span[class][id_h1] > a"@++-}++module HScraper.Query (+ parseQuery,+ (~=~),+ (|>>),+ (>=>),+ getText,+ getEntireText,+ getAttribute+ ) where++import qualified Data.Text as T+import Data.Monoid+import HScraper.Types+import HScraper.QueryParser++(===) :: Eq a => Maybe a -> Maybe a -> Bool+Just x === Just y = x == y+_ === Nothing = True+Nothing === Just _ = False++-- | Compares 'NodeQuery' with a 'NodeType'.+(~=~) :: NodeQuery -> NodeType -> Bool+NodeQuery{} ~=~ Text _ = False+NodeQuery name cls idd ~=~ Element nm xs = (name == nm)+ && (lookup (T.pack "class") xs === cls)+ && (lookup (T.pack "id") xs === idd)++-- | Returns the list of nodes matching the query+-- with root matching the first NodeQuery, and subsequent+-- Children satisfying subsequent 'NodeQueries' continously.+(>=>) :: HTMLTree -> Query -> [HTMLTree]+NullTree >=> _ = []+nt >=> [] = [nt]+nt@(NTree a _) >=> [q]+ | q ~=~ a = [nt]+ | otherwise = []+NTree a xs >=> (q:qs)+ | q ~=~ a = foldl g [] xs+ | otherwise = []+ where g acc l = acc `mappend` (l >=> qs)++-- | Applies '>=>' considering each node as root and+-- combines the result.+(|>>) :: HTMLTree -> Query -> [HTMLTree]+NullTree |>> _ = []+nt@(NTree _ xs) |>> q = foldl (\x y -> (y |>> q) `mappend` x) (nt >=> q) xs++-- | Get Combined Text of immediate children of current node.+getText :: HTMLTree -> T.Text+getText NullTree = T.empty+getText nt@(NTree _ xs ) = foldl f (g nt) xs+ where+ f acc x = acc `T.append` g x+ g (NTree (Text x) _) = x+ g _ = T.empty++-- | Get Entire text contained in the subtree.+getEntireText :: HTMLTree -> T.Text+getEntireText NullTree = T.empty+getEntireText (NTree (Text x) _) = x+getEntireText (NTree (Element _ _) xs) = foldl fn T.empty xs+ where+ fn acc x = acc `T.append` gn x+ gn NullTree = T.empty+ gn (NTree (Text x) _) = x+ gn ntm@(NTree (Element _ _) _) = getEntireText ntm++-- | Get the value of an attribute of a node.+getAttribute :: String -> HTMLTree -> Maybe String+getAttribute str (NTree (Element _ xs ) _) = fmap T.unpack (lookup (T.pack str) xs)+getAttribute _ _ = Nothing
+ HScraper/QueryParser.hs view
@@ -0,0 +1,42 @@+-- | The Syntax is as follows :+-- "nodeName[Class(optional)]{ID(optional)} > nodeName[Class(optional)]{ID(optional)}"+-- eg : "div{id1} > h1[class]"+{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, FlexibleContexts #-}+module HScraper.QueryParser (+ parseQuery+ ) where++import qualified Data.Text as T+import Text.Parsec++import HScraper.Types++parseQuery :: String -> Either ParseError Query+parseQuery s = case parse parseNodeQueries "" (unwords (words s)) of+ Left err -> Left err+ Right nodes -> Right nodes+++parseNodeQueries :: Stream s m Char => ParsecT s u m [NodeQuery]+parseNodeQueries = sepBy node (spaces >> char '>' >> spaces)++clas :: Stream s m Char => ParsecT s u m String+clas = do+ _ <- char '['+ clnm <- many (noneOf "]")+ _ <- char ']'+ return clnm++idd :: Stream s m Char => ParsecT s u m String+idd = do+ _ <- char '{'+ idnm <- many (noneOf "}")+ _ <- char '}'+ return idnm++node :: Stream s m Char => ParsecT s u m NodeQuery+node = do+ name <-many (noneOf " {[>")+ cls <- optionMaybe clas+ ids <- optionMaybe idd+ return (NodeQuery (T.pack name) (fmap T.pack cls) (fmap T.pack ids))
+ HScraper/Tidy.hs view
@@ -0,0 +1,22 @@+{- |+Module for tidying Malformed html using libtidy(see README).+-}+++module HScraper.Tidy (+ tidy+ ) where+import Data.Text as T+import Data.Text.IO as TIO+import System.Process+import System.Directory(getCurrentDirectory)++-- | Takes Malformed html and reuturns correct html if it can+-- be corrected. Output is empty if it cannot be corrected.+tidy :: T.Text -> IO T.Text+tidy t = do+ pwd <- System.Directory.getCurrentDirectory+ let tempFile = pwd ++ "/hscraper_temp.html"+ TIO.writeFile tempFile t+ (_,Just hout,_,_) <- createProcess (proc "tidy" ["-q","-f", "/home/nis/hscraper_webpages.logs", tempFile]){ std_out = CreatePipe }+ TIO.hGetContents hout
+ HScraper/Types.hs view
@@ -0,0 +1,41 @@+--All types should be declared here.+--TODO : XPath+module HScraper.Types where+import qualified Data.Text as T++data NodeType = Text T.Text+ | Element T.Text AttrList+ deriving (Show)++data NTree a = NTree a [NTree a]+ | NullTree+ deriving (Show)++type AttrList = [(T.Text , T.Text)]++type HTMLTree = NTree NodeType++instance Eq NodeType where+ (Text x) == (Text y) = x == y+ (Element x y) == (Element p q) = x == p && y == q+ _ == _ = False++instance (Eq a) => Eq (NTree a) where+ (NTree x y) == (NTree p q) = (x==p)&&(y==q)+ _ == _ = False++toLeaf::T.Text -> HTMLTree+toLeaf t = NTree (Text t) []++toTree::T.Text -> AttrList -> [HTMLTree] -> HTMLTree+toTree t l = NTree (Element t l)++type Name = T.Text++type Class = Maybe T.Text++type ID = Maybe T.Text++data NodeQuery = NodeQuery Name Class ID deriving (Show, Read)++type Query = [NodeQuery]
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2015, Nishant Gupta+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++* Neither the name of hScraper nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README.md view
@@ -0,0 +1,9 @@+# hScraper [](https://travis-ci.org/Nishant9/hScraper)+A Haskell library to scrape and crawl web-pages.++Parses correct html by itself and has support for malformed html using either one of : ++- http://www.html-tidy.org/+- http://tidy.sourceforge.net/++See [Documentation](docs/) for more info.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hScraper.cabal view
@@ -0,0 +1,46 @@+-- Initial hScraper.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: hScraper+version: 0.1.0.0+synopsis: A Haskell library to scrape and crawl web-pages+-- description: +license: BSD3+license-file: LICENSE+author: Nishant Gupta, Ayush Agarwal+maintainer: nishant.gupta291995@google.com, agarwal.ayush9@gmail.com+-- copyright: +category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/Nishant9/hScraper.git++library+ exposed-modules: HScraper.HTMLparser+ , HScraper.Network+ , HScraper.Query+ , HScraper.Tidy+ , HScraper+ , HScraper.Types+ , HScraper.Main++ other-modules: HScraper.QueryParser++-- other-extensions:+ build-depends: base >=4.4 && <4.9+ , http-types+ , directory+ , text+ , bytestring+ , parsec+ , transformers+ , regex-compat+ , HTTP+ , http-conduit+ , process+-- hs-source-dirs: HScraper, tests+ default-language: Haskell2010