packages feed

hxt-css (empty) → 0.1.0.0

raw patch · 7 files changed

+682/−0 lines, 7 filesdep +basedep +hxtdep +hxt-csssetup-changed

Dependencies added: base, hxt, hxt-css, parsec, split

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012-2014, Marios Titas++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 Marios Titas 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/XML/HXT/CSS.hs view
@@ -0,0 +1,257 @@+{- |+Module      : Text.XML.HXT.CSS++Stability   : provisional++Turn a CSS selector into an HXT arrow. Matching is done in a case insensitive+fashion. This module does not distinguish between XML and (X)TML and therefore+it will operate case insensitively even on XML documents.+-}++{-# LANGUAGE FlexibleInstances #-}++module Text.XML.HXT.CSS+    ( css+    , cssShallow+    , cssNav+    , cssShallowNav+    , Css++    -- * Supported selectors+    -- $supported_selectors++    -- * Example+    -- $example+    ) +    where++import Data.Char+import Data.Function+import Data.Maybe+import Data.List+import Data.List.Split+import Text.XML.HXT.Core+import qualified Text.XML.HXT.DOM.XmlNode as XN+import Data.Tree.NavigatableTree.Class+import qualified Data.Tree.NavigatableTree.XPathAxis as T+import Text.XML.HXT.DTDValidation.TypeDefs+import Data.Tree.NTree.Zipper.TypeDefs++import Text.XML.HXT.CSS.TypeDefs+import Text.XML.HXT.CSS.Parser++-- | Select elements from an HTML document with a CSS selector. +css :: (ArrowXml a, Css s) => s -> a XmlTree XmlTree+css = withNav . cssNav++-- | Like 'css', except that the selector is anchored at the top. For+-- example, @'cssShallow' \"div\"@ will only select @div@ elements that are+-- in the input of the arrow, it will not recursively search for @div@s+-- contained deeper in the document tree. The latter can be selected by+-- @'cssShallow' \"* div\"@ but is recommended to use 'css' for that. In+-- other words, @'cssShallow' \"div\"@ corresponds to the @\"\/div\"@ XPath+-- expression, whereas @'cssShallow' \"* div\"@ corresponds to @\"\/\/div\"@.+cssShallow :: (ArrowXml a, Css s) => s -> a XmlTree XmlTree+cssShallow = withNav . cssShallowNav++-- | Like 'css', except that it operates on navigatable XML trees.+cssNav :: (ArrowXml a, Css s) => s -> a XmlNavTree XmlNavTree+cssNav s = isElemN >>> skipXmlRoot >>> selectDeep s++-- | Like 'cssShallow', except that it operates on navigatable XML trees.+cssShallowNav :: (ArrowXml a, Css s) => s -> a XmlNavTree XmlNavTree+cssShallowNav s = isElemN >>> skipXmlRoot >>> select s++-- | Things that can be used as a CSS selector. The 'String' instance+-- uses 'safeParseCSS' to parse the string.+class Css s where+    selectDeep :: ArrowXml a => s -> a XmlNavTree XmlNavTree+    select :: ArrowXml a => s -> a XmlNavTree XmlNavTree++    selectDeep s = multi (isElemN >>> select s)++instance Css [Char] where+    selectDeep s =+        case safeParseCSS s of+            Right sel -> selectDeep sel+            Left msg -> constA $ XN.mkError c_err msg++    select s =+        case safeParseCSS s of+            Right sel -> select sel+            Left msg -> constA $ XN.mkError c_err msg++instance Css SelectorsGroup where+    select (SelectorsGroup sels) =+        foldr ((<+>) . select) zeroArrow sels++instance Css Selector where+    select (Selector sss) = select sss+    select (Descendant sss sel) =+        select sss >>> getChildren >>> isElemN >>>+            multi (isElemN >>> select sel)+    select (Child sss sel) =+        select sss >>> getChildren >>> isElemN >>> select sel+    select (AdjSibling sss sel) =+        select sss >>> nextSibling >>> select sel+    select (FolSibling sss sel) =+        select sss >>> followingSiblingAxis >>> select sel++instance Css SimpleSelectorSeq where+    select (SimpleSelectorSeq simpSels) =+        foldr ((>>>) . select) this simpSels++instance Css SimpleSelector where+    select UniversalSelector = this+    select (TypeSelector tagName) = withoutNav $ hasNameCI tagName+    select (IdSelector nodeId) = hasAttrValueN "id" (ciEq nodeId)+    select (ClassSelector className) =+        hasAttrValueN "class" (hasWord className)+    select (AttrSelector attrb sel) =+        hasAttrValueN attrb p+      where+        p = case sel of+                AttrExists -> const True+                AttrEq val -> ciEq val+                AttrContainsSp val -> hasWord val+                AttrBeginHy val -> hypenPrefix val+                AttrPrefix val -> on isPrefixOf fc val+                AttrSuffix val -> on isSuffixOf fc val+                AttrSubstr val -> on isInfixOf fc val+        hypenPrefix s1 s2 =+            case wordsBy (== '-') s2 of+                w : _ | ciEq s1 w -> True+                _ -> False+    select (Pseudo pseudo) = select pseudo+    select (PseudoNth pseudo) = select pseudo+    select (Negation simple) = neg (select simple)++instance Css PseudoClass where+    select PseudoFirstChild = nthChild (== 1)+    select PseudoLastChild  = nthLastChild (== 1)+    select PseudoOnlyChild =+        nthChild (== 1) >>> nthLastChild (== 1)+    select PseudoFirstOfType = nthOfType (== 1)+    select PseudoLastOfType = nthLastOfType (== 1)+    select PseudoOnlyOfType =+        nthOfType (== 1) >>> nthLastOfType (== 1)+    select PseudoEmpty = neg notEmpty+      where+        notEmpty = filterA $ getChildren >>>+            withoutNav (isElem <+> isText <+> isCdata <+> isEntityRef)+    select PseudoRoot = filterA (moveUp' >>> isRootN)++instance Css PseudoNthClass where+    select (PseudoNthChild nth) = nthChild (testNth nth)+    select (PseudoNthLastChild nth) = nthLastChild (testNth nth)+    select (PseudoNthOfType nth) = nthOfType (testNth nth)+    select (PseudoNthLastOfType nth) = nthLastOfType (testNth nth)++--------------------------------------------------------------------------------++-- avoid the ArrowNavigatableTree constraint+moveUp' :: (ArrowList a, NavigatableTree t) => a (t a1) (t a1)+moveUp' = arrL $ maybeToList . mvUp++skipXmlRoot :: ArrowXml a => a XmlNavTree XmlNavTree+skipXmlRoot = ifA isRootN (getChildren >>> isElemN) this++hasParent :: ArrowXml a => a XmlNavTree XmlNavTree+hasParent = filterA $ moveUp' >>> neg isRootN++isRootN :: ArrowXml a => a XmlNavTree XmlNavTree+isRootN = withoutNav isRoot++nextSibling :: ArrowList a => a XmlNavTree XmlNavTree+nextSibling = arrL go+  where+    go x =+        case mvRight x of+            Just x'+                | isElemNodeN x' -> [x']+                | otherwise -> go x'+            Nothing -> []++nthChild :: ArrowXml a => (Int -> Bool) -> a XmlNavTree XmlNavTree+nthChild p = arrL (nthElemFun T.precedingSiblingAxis p) >>> hasParent++nthLastChild :: ArrowXml a => (Int -> Bool) -> a XmlNavTree XmlNavTree+nthLastChild p = arrL (nthElemFun T.followingSiblingAxis p) >>> hasParent++nthOfType :: ArrowXml a => (Int -> Bool) -> a XmlNavTree XmlNavTree+nthOfType p = arrL (nthElemOfTypeFun T.precedingSiblingAxis p) >>> hasParent++nthLastOfType :: ArrowXml a => (Int -> Bool) -> a XmlNavTree XmlNavTree+nthLastOfType p = arrL (nthElemOfTypeFun T.followingSiblingAxis p) >>> hasParent++nthElemOfTypeFun+    :: (XmlNavTree -> [XmlNavTree])+    -> (Int -> Bool) -> XmlNavTree -> [XmlNavTree]+nthElemOfTypeFun axis p x = nthElemFun axis' p x+  where+    axis' = filter ((== xNm) . fc . getNm) . axis+    xNm = fc (getNm x)+    getNm = fromMaybe "" . XN.getQualifiedName .+        (\(XN.NTree n _) -> n) . ntree++nthElemFun+    :: (XmlNavTree -> [XmlNavTree])+    -> (Int -> Bool) -> XmlNavTree -> [XmlNavTree]+nthElemFun axis p x = [x | p n]+  where+    n = 1 + length (filter isElemNodeN $ axis x)++isElemNodeN :: XmlNavTree -> Bool+isElemNodeN = isElemNode . ntree++isElemN :: ArrowXml a => a XmlNavTree XmlNavTree+isElemN = withoutNav isElem++{-hasAttrN :: ArrowXml a => String -> a XmlNavTree XmlNavTree-}+{-hasAttrN n = withoutNav $ (getAttrl >>> hasNameCI n) `guards` this-}++hasAttrValueN+    :: ArrowXml a+    => String -> (String -> Bool) -> a XmlNavTree XmlNavTree+hasAttrValueN n p = withoutNav $+    (getAttrl >>> hasNameCI n >>> xshow getChildren >>> isA p)  `guards` this++hasNameCI :: ArrowXml a => String -> a XmlTree XmlTree+hasNameCI n = (getName >>> isA (ciEq n)) `guards` this++hasWord :: String -> String -> Bool+hasWord w = any (ciEq w) . wordsBy isSpace++ciEq :: String -> String -> Bool+ciEq = on (==) fc++fc :: String -> String+fc = map toLower++{- $supported_selectors+* Element selectors: @*@, @E@, @.class@, @#id@++* Relationship selectors: @E F@, @E > F@, @E + F@, @E ~ F@++* Attribute selectors: @[attr]@, @[attr=\"value\"]@, @[attr~=\"value\"]@,+@[attr|=\"value\"]@, @[attr^=\"value\"]@, @[attr$=\"value\"]@,+@[attr*=\"value\"]@++* Pseudo-classes: @:not(..)@, @:empty@, @:root@, @:first-child@, @:last-child@,+@:only-child@, @:nth-child(N)@, @:nth-last-child(N)@, @:first-of-type@,+@:last-of-type@, @:only-of-type@, @:nth-of-type(N)@, @:nth-last-of-type(N)@++The argument to the @:nth-child()@ family of pseudo-classes can take one of+the following forms: @6@, @2n@, @n+2@, @3n-1@, @-n+6@, @odd@, @even@.+-}++{- $example+> import Text.XML.HXT.Core+> import Text.XML.HXT.CSS+>+> test :: IO [XmlTree]+> test = runX $ doc >>> css "div > span + p:not(:nth-of-type(3n-1))"+>   where+>     doc = readDocument [withParseHTML yes, withWarnings no] path+>     path = "/path/to/document.html"+-}
+ Text/XML/HXT/CSS/Parser.hs view
@@ -0,0 +1,202 @@+{- |+Module      : Text.XML.HXT.CSS.Parser++Stability   : stable++A parser for CSS selectors.+-}++module Text.XML.HXT.CSS.Parser+    ( safeParseCSS+    , parseCSS+    ) where++import Text.Parsec hiding (spaces)+import Text.Parsec.String+import Control.Monad+import Control.Applicative hiding (many, (<|>))+import Data.Char++import Text.XML.HXT.CSS.TypeDefs++-- | Parse a string to an AST. If the parser fails, it returns a left value+-- with an error message.+safeParseCSS :: String -> Either String SelectorsGroup+safeParseCSS s =+    case parse (spaces *> selectorsGroup <* eof) "" s of+        Right sel -> Right sel+        Left msg -> Left $ "Invalid CSS selector " +++            show s ++ ": " ++ show msg++-- | Like 'safeParseCSS', but calls 'error' if given an invalid CSS+-- selector.+parseCSS :: String -> SelectorsGroup+parseCSS = either error id . safeParseCSS++selectorsGroup :: Parser SelectorsGroup+selectorsGroup = SelectorsGroup <$>+    selector `sepBy1` (spaces >> char ',' >> spaces)++selector :: Parser Selector+selector = do+    sss <- simpleSelectorSeq+    choice+        [ try $ Child sss      <$> (spaces *> char '>' *> spaces  *> selector)+        , try $ AdjSibling sss <$> (spaces *> char '+' *> spaces  *> selector)+        , try $ FolSibling sss <$> (spaces *> char '~' *> spaces  *> selector)+        , try $ Descendant sss <$> (                      spaces1 *> selector)+        , return (Selector sss)+        ]++simpleSelectorSeq :: Parser SimpleSelectorSeq+simpleSelectorSeq =+    SimpleSelectorSeq <$> (seq1 <|> seq2)+  where+    seq1 = (:) <$> (typeSelector <|> universalSelector) <*> many part+    seq2 = many1 part+    part = choice [idSelector, classSelector, attrSelector+                  , negation, pseudo]++universalSelector :: Parser SimpleSelector+universalSelector = UniversalSelector <$ char '*'++typeSelector :: Parser SimpleSelector+typeSelector = TypeSelector <$> ident++idSelector :: Parser SimpleSelector+idSelector = IdSelector <$> (char '#' *> many1 nmchar)++classSelector :: Parser SimpleSelector+classSelector = ClassSelector <$> (char '.' *> ident)++attrSelector :: Parser SimpleSelector+attrSelector = do+    void $ char '['+    spaces+    attr <- ident+    attrTest <- option AttrExists $ do+        op <- choice+            [ AttrPrefix     <$ whole "^="+            , AttrSuffix     <$ whole "$="+            , AttrSubstr     <$ whole "*="+            , AttrEq         <$ char '='+            , AttrContainsSp <$ whole "~="+            , AttrBeginHy    <$ whole "|="+            ]+        spaces+        val <- ident <|> stringLit+        spaces+        return (op val)+    spaces+    void $ char ']'+    return $ AttrSelector attr attrTest++negation :: Parser SimpleSelector+negation = Negation <$> (notP *> spaces *> arg <* spaces <* char ')')+  where+    notP = try $ char ':' *> stringCI "not" *> char '('+    arg = choice [typeSelector, universalSelector, idSelector+                 , classSelector, attrSelector, pseudo]++-- does not much :not(..)+pseudo :: Parser SimpleSelector+pseudo = do+    void $ char ':'+    s <- ident+    case () of+        () | Just p <- findPseudoClass s ->+            return (Pseudo p)+        () | Just p <- findPseudoNthClass s -> do+            arg <- char '(' *> nth <* char ')'+            return (PseudoNth $ p arg)+        () | map toLower s == "not" ->+            fail "negation is not allowed here"+        () -> fail $ "'" ++ s ++ "' is not a valid pseudo-class"++nth :: Parser Nth+nth = spaces *> p <* spaces+  where+    p = choice+        [ try fullNth+        , Nth 0 <$> (signOpt <*> integer)+        , Odd  <$ stringCI "odd"+        , Even <$ stringCI "even"+        ]+    fullNth = do+        a <- signOpt <*> option 1 integer+        void $ charCI 'n'+        b <- option 0 $ do+            spaces+            sign <*> (spaces *> integer)+        return (Nth a b)+    sign = id <$ char '+' <|> negate <$ char '-'+    signOpt = option id sign++--------------------------------------------------------------------------------+-- auxiliary parsers++ident :: Parser String+ident = (:) <$> nmstart <*> many nmchar++nmstart :: Parser Char+nmstart = satisfy p <|> nonascii {- <|> escape -} <?> "nmstart"+  where+    p c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || c == '_'++nmchar :: Parser Char+nmchar = satisfy p <|> nonascii {- <|> escape -} <?> "nmchar"+  where+    p c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') ||+        isDigit c || elem c "_-"++stringLit :: Parser String+stringLit = string1 <|> string2+  where+    string1 =+        char '"' *>+            many (noneOf "\n\r\f\\\"" <|> nl <|> nonascii {- <|> escape -})+                <* char '*'+    string2 =+        char '\'' *>+            many (noneOf "\n\r\f\\'"  <|> nl <|> nonascii {- <|> escape -})+                <* char '\''++nonascii :: Parser Char+nonascii = satisfy (> '\DEL') <?> "nonascii"++{-escape :: Parser Char-}+{-escape = mzero -- not supported by any major browser-}++{-unicode :: Parser Char-}+{-unicode = mzero -- not supported by any major browser-}++nl :: Parser Char+nl = choice+    [ void $ char '\n'+    , void $ char '\r' >> optionMaybe (char '\n')+    , void $ char '\f'+    ] >> return '\n'++integer :: (Integral a, Read a) => Parser a+integer = read <$> many1 digit++spaces :: Parser ()+spaces = skipMany (oneOf " \t\r\n\f") <?> "white space"++spaces1 :: Parser ()+spaces1 = skipMany1 (oneOf " \t\r\n\f") <?> "white space"++whole :: String -> Parser String+whole = try . string++stringCI :: String -> Parser String+stringCI (c : cs) = (:) <$> charCI c <*> stringCI cs+stringCI [] = return []++charCI :: Char -> Parser Char+charCI c+    | cL == cU = char c+    | otherwise = char cL <|> char cU+  where+    cL = toLower c+    cU = toUpper c
+ Text/XML/HXT/CSS/TypeDefs.hs view
@@ -0,0 +1,124 @@+{- |+Module      : Text.XML.HXT.CSS.TypeDefs++Stability   : provisional++Data types for the abstract syntax tree of CSS selectors. We (mostly)+follow the naming conventions of the CSS Level 3 specification document+(<http://www.w3.org/TR/css3-selectors/>). The type hierarchy tries to+strike a balance between correctness and complexity. As a result, it is+possible to construct values that correspond to invalid selectors.+For example,++@+'Negation' ('Negation' 'UniversalSelector')+@++is not valid according to the spec, as double negation is not allowed.+Note that 'Text.XML.HXT.CSS.Parser.parseCSS' never produces invalid+selectors.+-}++module Text.XML.HXT.CSS.TypeDefs where++import Data.Char++-- | The top-level selector type.+newtype SelectorsGroup = SelectorsGroup [Selector] -- ^ @E, F@+  deriving (Show, Eq)++data Selector+    = Selector SimpleSelectorSeq            -- ^ @E@+    | Descendant SimpleSelectorSeq Selector -- ^ @E F@+    | Child SimpleSelectorSeq Selector      -- ^ @E > F@+    | AdjSibling SimpleSelectorSeq Selector -- ^ @E + F@+    | FolSibling SimpleSelectorSeq Selector -- ^ @E ~ F@+  deriving (Show, Eq)++newtype SimpleSelectorSeq =+    SimpleSelectorSeq [SimpleSelector] -- ^ @tag#id.class:pseudo@+  deriving (Show, Eq)++data SimpleSelector+    = UniversalSelector            -- ^ @*@+    | TypeSelector String          -- ^ @tag@+    | IdSelector String            -- ^ @#id@+    | ClassSelector String         -- ^ @.class@+    | AttrSelector String AttrTest -- ^ @[..]@+    | Pseudo PseudoClass           -- ^ @:pseudo@+    | PseudoNth PseudoNthClass     -- ^ @:pseudo(2)@+    | Negation SimpleSelector      -- ^ @:not(..)@+  deriving (Show, Eq)++data AttrTest+    = AttrExists            -- ^ @[attr]@+    | AttrEq String         -- ^ @[attr=var]@+    | AttrContainsSp String -- ^ @[attr~=var]@+    | AttrBeginHy String    -- ^ @[attr|=var]@+    | AttrPrefix String     -- ^ @[attr^=var]@+    | AttrSuffix String     -- ^ @[attr$=var]@+    | AttrSubstr String     -- ^ @[attr*=var]@+  deriving (Show, Eq)++-- | Pseudo classes.+data PseudoClass+    = PseudoFirstChild  -- ^ @:first-child@+    | PseudoLastChild   -- ^ @:last-child@+    | PseudoOnlyChild   -- ^ @:only-child@+    | PseudoFirstOfType -- ^ @:first-of-type@+    | PseudoLastOfType  -- ^ @:last-of-type@+    | PseudoOnlyOfType  -- ^ @:only-of-type@+    | PseudoEmpty       -- ^ @:empty@+    | PseudoRoot        -- ^ @:root@+  deriving (Show, Eq)++-- | Pseudo classes that expect a argument of type 'Nth'.+data PseudoNthClass+    = PseudoNthChild      Nth -- ^ @:nth-child(..)@+    | PseudoNthLastChild  Nth -- ^ @:nth-last-child(..)@+    | PseudoNthOfType     Nth -- ^ @:nth-of-type(..)@+    | PseudoNthLastOfType Nth -- ^ @:nth-last-of-type(..)@+  deriving (Show, Eq)++-- | Type of the argument of the @:nth-child@ ('PseudoNthClass')+-- family of pseudo classes. @'Nth' a b@ matches with all integers that can+-- be written in the form @an+b@ for some nonnegative integer @n@.+data Nth+    = Nth Int Int -- ^ @an+b@+    | Odd         -- ^ @odd@+    | Even        -- ^ @even@+  deriving (Show, Eq)++-- | Find a 'PseudoClass' given its name (without the colon).+findPseudoClass :: String -> Maybe PseudoClass+findPseudoClass = flip lookup h . map toLower+  where+    h = [ ("first-child",      PseudoFirstChild)+        , ("last-child",       PseudoLastChild)+        , ("only-child",       PseudoOnlyChild)+        , ("first-of-type",    PseudoFirstOfType)+        , ("last-of-type",     PseudoLastOfType)+        , ("only-of-type",     PseudoOnlyOfType)+        , ("empty",            PseudoEmpty)+        , ("root",             PseudoRoot)+        ]++-- | Find a 'PseudoNthClass' given its name (without the colon).+findPseudoNthClass :: String -> Maybe (Nth -> PseudoNthClass)+findPseudoNthClass = flip lookup h . map toLower+  where+    h = [ ("nth-child",        PseudoNthChild)+        , ("nth-last-child",   PseudoNthLastChild)+        , ("nth-of-type",      PseudoNthOfType)+        , ("nth-last-of-type", PseudoNthLastOfType)+        ]++-- | Check whether an integer satisfies a \"Diophantine\" constraint+-- given in form of a value of type 'Nth'.+testNth :: Nth -> Int -> Bool+testNth (Nth 0 b) k = k == b+testNth (Nth a b) k = r == 0 && n >= 0+  where+    (n, r) = (k - b) `quotRem` a+testNth Odd k = odd k+testNth Even k = even k
+ examples/hxt-css.hs view
@@ -0,0 +1,21 @@+import System.Environment+import Text.XML.HXT.Core hiding (xshow)+import Text.XML.HXT.DOM.ShowXml++import Text.XML.HXT.CSS++main :: IO ()+main = do+    args <- getArgs+    case args of+        [path, sel] -> run path sel+        _ -> do+            prog <- getProgName+            putStrLn $ "Usage: " ++ prog ++ " PATH CSS_SELECTOR"++run :: FilePath -> String -> IO ()+run path sel = do+    let doc = readDocument [withParseHTML yes, withWarnings no] path+    elts <- runX $ doc >>> css sel >>> processChildren none+    mapM_ (\elt -> putStrLn (xshow [elt])) elts+    putStrLn $ "\nFound " ++ show (length elts) ++ " elemement(s)"
+ hxt-css.cabal view
@@ -0,0 +1,46 @@+name:                hxt-css+version:             0.1.0.0+synopsis:            CSS selectors for HXT+description:+  This package makes it possible to easily traverse (X)HTML/XML documents+  using CSS selectors. It supports all CSS level 3 selectors except the+  ones that do not make sense outside a web browser (e.g. such as @:hover@+  or @::first-letter@). Also, there is no support for namespaced selectors.+homepage:            https://github.com/redneb/hxt-css+bug-reports:         https://github.com/redneb/hxt-css/issues+license:             BSD3+license-file:        LICENSE+author:              Marios Titas <rednebΑΤgmxDΟΤcom>+maintainer:          Marios Titas <rednebΑΤgmxDΟΤcom>+category:            XML, HTML+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/redneb/hxt-css.git++flag examples+  description:         Build examples+  default:             False++library+  exposed-modules:     Text.XML.HXT.CSS,+                       Text.XML.HXT.CSS.TypeDefs,+                       Text.XML.HXT.CSS.Parser+  build-depends:       base >=4.6 && <5,+                       hxt >=9.3 && <10,+                       parsec >=3.1 && <4,+                       split >=0.1 && <1+  default-language:    Haskell2010+  ghc-options:         -Wall++executable hxt-css+  hs-source-dirs:      examples+  main-is:             hxt-css.hs+  if !flag(examples)+    buildable:           False+  else+    build-depends:       base >=4.6 && <5, hxt-css, hxt+    default-language:    Haskell2010+    ghc-options:         -Wall