packages feed

HandsomeSoup (empty) → 0.1

raw patch · 7 files changed

+329/−0 lines, 7 filesdep +HTTPdep +MaybeTdep +basesetup-changed

Dependencies added: HTTP, MaybeT, base, containers, hxt, mtl, network, parsec, transformers

Files

+ HandsomeSoup.cabal view
@@ -0,0 +1,61 @@+-- HandsomeSoup.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                HandsomeSoup++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Work with HTML more easily in HXT++-- A longer description of the package.+Description: See examples and full readme on the Github page: https:\/\/github.com\/egonSchiele\/HandsomeSoup++-- URL for the project homepage or repository.+Homepage:            https://github.com/egonSchiele/HandsomeSoup++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Aditya Bhargava++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          bluemangroupie@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Text++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: README.markdown++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Library+  -- Modules exported by the library.+  Exposed-modules:     Text.HandsomeSoup, Text.CSS.Parser+  +  -- Packages needed in order to build this package.+  Build-depends: base < 5, transformers, HTTP, parsec, containers, mtl, MaybeT, hxt, network+  +  -- Modules not exported by this package.+  Other-modules: Text.CSS.Utils+  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Aditya Bhargava++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 Aditya Bhargava nor the names of other+      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+OWNER 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.markdown view
@@ -0,0 +1,48 @@+# HandsomeSoup++Current Status: very very pre-alpha. Usable but buggy.++HandsomeSoup is the library I wish I had when I started parsing HTML in Haskell.++It is built on top of [HXT](http://www.fh-wedel.de/~si/HXmlToolbox/) and adds a few functions that make is easier to work with HTML.++Most importantly, it adds CSS selectors to HXT. The goal of HandsomeSoup is to be a complete CSS2 parser for HXT (it is very close to this right now).++## Example++[Nokogiri](http://nokogiri.org/), the HTML parser for Ruby, has an example showing how to scrape Google search results. This is easy in HandsomeSoup:++    main = do+        doc <- fromUrl "http://www.google.com/search?q=egon+schiele"+        links <- runX $ doc >>> css "h3.r a" ! "href"+        mapM_ putStrLn links++## What can HandsomeSoup do for you?++### Easily parse an online page using `fromUrl`++    doc <- fromUrl "http://example.com"++### Or a local page using `parseHtml`++    contents <- readFile [filename]+    doc <- parseHtml contents++### Easily extract elements using `css`++Here are some valid selectors:++    doc <<< css "a"+    doc <<< css "*"+    doc <<< css "a#link1"+    doc <<< css "a.foo"+    doc <<< css "p > a"+    doc <<< css "#container h1"+    doc <<< css "img[width]"+    doc <<< css "img[width=400]"+    doc <<< css "a[class~=bar]"++### Easily get attributes using `(!)`++    doc <<< css "img" ! "src"+    doc <<< css "a" ! "href"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/CSS/Parser.hs view
@@ -0,0 +1,106 @@+module Text.CSS.Parser where++import Text.Parsec+import qualified Data.Functor.Identity as I+import Data.List+import Text.CSS.Utils++-- if no tag name was given, sName will be set to '*'+-- attrs are (attr name, attr value).+-- if attr value is the empty string, we just check to+-- make sure that the element has that attribute.+-- if the attr value is prefixed with a '~', we treat+-- that attribute as a list of words separated by a space+-- and make sure that at least one of those words matches.+data Selector = Selector { sName :: String, sAttrs :: [(String,String)], spseudoSelectores :: [String] } | Space | ChildOf | FollowedBy deriving (Show)++-- pretty printers for debugging+pp Space = "<space>"+pp ChildOf = "<child of>"+pp FollowedBy = "<followed by>"+pp (Selector name attrs pseudo) = show name ++ ":" ++ showMap attrs ++ ", " ++ show pseudo+    where showMap m = ("{" ++ (foldl (\acc (k,v) -> acc ++ (show k) ++ ":" ++ (show v) ++ ", ") "" m)) ++ "}"++{- TYPE SELECTORS FOLLOW -}++-- | selects a tag name, like @ h1 @+typeSelector :: ParsecT [Char] u I.Identity [Char]+typeSelector = many1 alphaNum++-- | universal selector, selects @ * @+universalSelector :: ParsecT [Char] u I.Identity String+universalSelector = string "*"++{- SECONDARY SELECTORS FOLLOW -}++-- | selects a pseudo-element or pseudo-class, like @ :link @, @ :first-child @ etc.+pseudoSelector :: ParsecT [Char] u I.Identity [Char]+pseudoSelector = char ':' >> many1 (alphaNum <|> oneOf "-()")++-- | class selector, selects @ .foo @+classSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+classSelector = do+    val <- char '.' >> many1 alphaNum+    return ("class", '~':val)++-- | id selector, selects @ #foo @+idSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+idSelector = do+    val <- char '#' >> many1 alphaNum+    return ("id", val)++-- | selects attributes, like @ [id] @ (element must have id) or @ [id=foo] @ (element must have id foo).+attributeSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+attributeSelector = do+      contents <- between (char '[') (char ']') (many1 (alphaNum <|> oneOf "~="))+      if "~=" `isInfixOf` contents +          then return $ (\(a, b) -> (a, '~':b)) $ splitOn "~=" contents+          else if '=' `elem` contents+               then return $ splitOn "=" contents+               else return (contents, "")++-- | selector for everything after the type except pseudoSelectores+secondarySelector = many1 (classSelector <|> idSelector <|> attributeSelector)++{- COMBINATOR SELECTORS FOLLOW -}++space_ = do+    many1 $ string " "+    return Space++childOf = do+    spaces >> string ">" >> spaces+    return ChildOf++followedBy = do+    spaces >> string "+" >> spaces+    return FollowedBy++{- SIMPLE SELECTORS FOLLOW -}++-- | selects a tagname followed by one or more secondary selectors+-- example: @ a.foo @, @ *#hello @, @ h1 @ etc+simpleSelectorTag :: ParsecT [Char] u I.Identity Selector+simpleSelectorTag = do+    tagName <- typeSelector <|> universalSelector+    attrs <- secondarySelector <|> return []+    pseudo <- many1 pseudoSelector <|> return []+    return $ Selector tagName attrs pseudo++-- | selects one or more secondary selectors+-- and automatically prepends the universal selector to them.+-- example: @ .foo @, @ #hello @ etc+simpleSelectorNoTag = do+    attrs <- secondarySelector+    pseudo <- many1 pseudoSelector <|> return []+    return $ Selector "*" attrs pseudo++-- | A simple selector is either a type selector or universal selector followed immediately by zero or more attribute selectors, ID selectors, or pseudo-classes, in any order.+simpleSelector :: ParsecT [Char] u I.Identity Selector+simpleSelector = simpleSelectorTag <|> simpleSelectorNoTag <|> try childOf <|> try followedBy <|> space_++-- | One or more simple selectors separated by combinators. +selector :: ParsecT [Char] u I.Identity [[Selector]]+selector = many1 simpleSelector `sepBy` (spaces >> string "," >> spaces)++css = parse selector ""
+ Text/CSS/Utils.hs view
@@ -0,0 +1,12 @@+module Text.CSS.Utils where+import Data.List++-- like break, except don't keep the element you broke on.+-- and it takes a list as the thing to break on.+splitOn a xs = _splitOn a "" xs++_splitOn _ begin [] = (begin, [])+_splitOn a begin end@(x:xs)+  | a `isPrefixOf` end = (begin, drop (length a) end)+  | otherwise = _splitOn a (begin ++ [x]) xs+
+ Text/HandsomeSoup.hs view
@@ -0,0 +1,70 @@+module Text.HandsomeSoup (openUrl, fromUrl, parseHtml, (!), css) where++import Text.XML.HXT.Core+import Network.HTTP+import Network.URI+import Data.Tree.NTree.TypeDefs+import Control.Monad.Maybe+import Control.Monad.Trans+import Data.Maybe+import Text.Parsec+import qualified Data.Map as M+import Data.Monoid (mconcat)+import qualified Data.Functor.Identity as I+import qualified Debug.Trace as D+import Data.List+import Control.Monad+import Text.CSS.Parser hiding (css)++-- | Helper function for getting page content. Example:+--+-- > contents <- runMaybeT $ openUrl "http://foo.com"+openUrl :: String -> MaybeT IO String+openUrl url = case parseURI url of+    Nothing -> fail "couldn't parse url"+    Just u  -> liftIO (getResponseBody =<< simpleHTTP (mkRequest GET u))++-- | Given a url, returns a document. Example:+--+-- > doc <- fromUrl "http://foo.com"+fromUrl :: String -> IO (IOSArrow XmlTree (NTree XNode))+fromUrl url = do+  contents <- runMaybeT $ openUrl url+  return $ parseHtml (fromMaybe "" contents)++-- | Given a string, parses it and returns a document. Example:+--+-- > doc = parseHtml "<h1>hello!</h1>"+parseHtml :: String -> IOSArrow XmlTree (NTree XNode)+parseHtml = readString [withParseHTML yes, withWarnings no]++-- | Shortcut for getting attributes. Example:+--+-- > doc >>> css "a" ! "href"+(!) :: ArrowXml cat => cat a XmlTree -> String -> cat a String+(!) a str = a >>> getAttrValue str++-- | A css selector for getting elements from a document. Example:+--+-- > doc >>> css "#menu li"+css :: ArrowXml a => [Char] -> a (NTree XNode) (NTree XNode)+css tag = case (parse selector "" tag) of+       Left err -> D.trace (show err) this+       Right x  -> fromSelectors x++-- | Used internally. works on a selector (i.e a list of simple selectors)+fromSelectors sel@(s:selectors) = foldl (\acc selector -> acc <+> _fromSelectors selector) (_fromSelectors s) selectors++-- | Used internally. works on simple selectors and their combinators+_fromSelectors (s:selectors) = foldl (\acc selector -> make acc selector) (make this s) selectors+  where +        make acc sel@(Selector name attrs pseudo)+          | name == "*" = acc >>> (multi this >>> makeAttrs attrs)+          | otherwise = acc >>> (multi $ hasName name >>> makeAttrs attrs)+        make acc Space = acc >>> multi getChildren+        make acc ChildOf = acc >>> getChildren+        makeAttrs (a:attrs) = foldl (\acc attr -> acc >>> makeAttr attr) (makeAttr a) attrs+        makeAttrs [] = this+        makeAttr (name, "") = hasAttr name+        makeAttr (name, '~':value) = hasAttrValue name (elem value . words)+        makeAttr (name, value) = hasAttrValue name (==value)