diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,20 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2010, Nubis. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -* 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. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Yesod/Test.hs b/Yesod/Test.hs --- a/Yesod/Test.hs +++ b/Yesod/Test.hs @@ -90,7 +90,7 @@ import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) -- | The state used in 'describe' to build a list of specs -data SpecsData = SpecsData Application ConnectionPool [Core.Spec Core.AnyExample] +data SpecsData = SpecsData Application ConnectionPool [Core.Spec] -- | The specs state monad is where 'describe' runs. type Specs = ST.StateT SpecsData IO () diff --git a/Yesod/Test/HtmlParse.hs b/Yesod/Test/HtmlParse.hs --- a/Yesod/Test/HtmlParse.hs +++ b/Yesod/Test/HtmlParse.hs @@ -6,60 +6,9 @@ ( parseHtml ) where -import Text.HTML.TagStream -import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -import Text.XML -import Data.Conduit -import qualified Data.Conduit.List as CL -import Data.Functor.Identity (runIdentity) -import Control.Monad.Trans.Resource (runExceptionT) -import Data.XML.Types (Event (..), Content (ContentText)) -import Control.Arrow ((***)) -import Data.Text.Encoding (decodeUtf8With) -import Data.Text.Encoding.Error (lenientDecode) -import qualified Data.Set as Set +import Text.XML (Document) +import qualified Text.HTML.DOM as HD parseHtml :: L.ByteString -> Either String Document -parseHtml lbs = - either (Left . show) Right - $ runIdentity - $ runExceptionT - $ CL.sourceList (L.toChunks lbs) - $$ tokenStream =$ (CL.concatMap toEvent =$ fromEvents) - -toEvent :: Token -> [Event] -toEvent (TagOpen bsname bsattrs isClose') = - EventBeginElement name attrs : if isClose then [EventEndElement name] else [] - where - name = toName bsname - attrs = map (toName *** (return . ContentText . decodeUtf8With lenientDecode)) bsattrs - isClose = isClose' || isVoid bsname -toEvent (TagClose bsname) = [EventEndElement $ toName bsname] -toEvent (Text bs) = [EventContent $ ContentText $ decodeUtf8With lenientDecode bs] -toEvent (Comment bs) = [EventComment $ decodeUtf8With lenientDecode bs] -toEvent Special{} = [] -toEvent Incomplete{} = [] - -toName :: S.ByteString -> Name -toName bs = Name (decodeUtf8With lenientDecode bs) Nothing Nothing - -isVoid :: S.ByteString -> Bool -isVoid = flip Set.member $ Set.fromList - [ "area" - , "base" - , "br" - , "col" - , "command" - , "embed" - , "hr" - , "img" - , "input" - , "keygen" - , "link" - , "meta" - , "param" - , "source" - , "track" - , "wbr" - ] +parseHtml = Right . HD.parseLBS diff --git a/test/main.hs b/test/main.hs new file mode 100644 --- /dev/null +++ b/test/main.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} +import Test.HUnit hiding (Test) +import Test.Hspec.Monadic +import Test.Hspec.HUnit () + +import Yesod.Test.CssQuery +import Yesod.Test.TransversingCSS +import Yesod.Test.HtmlParse +import Text.XML + +import Data.ByteString.Lazy.Char8 () + +parseQuery_ = either error id . parseQuery +findBySelector_ x = either error id . findBySelector x +parseHtml_ = either error id . parseHtml + +main :: IO () +main = hspecX $ do + describe "CSS selector parsing" $ do + it "elements" $ parseQuery_ "strong" @?= [[DeepChildren [ByTagName "strong"]]] + it "child elements" $ parseQuery_ "strong > i" @?= [[DeepChildren [ByTagName "strong"], DirectChildren [ByTagName "i"]]] + it "comma" $ parseQuery_ "strong.bar, #foo" @?= [[DeepChildren [ByTagName "strong", ByClass "bar"]], [DeepChildren [ById "foo"]]] + describe "find by selector" $ do + it "XHTML" $ + let html = "foo

Hello World

" + query = "body > p" + in findBySelector_ html query @?= ["

Hello World

"] + it "HTML" $ + let html = "foo

Hello World

" + query = "body > p" + in findBySelector_ html query @?= ["

Hello World

"] + describe "HTML parsing" $ do + it "XHTML" $ + let html = "foo

Hello World

" + doc = Document (Prologue [] Nothing []) root [] + root = Element "html" [] + [ NodeElement $ Element "head" [] + [ NodeElement $ Element "title" [] + [NodeContent "foo"] + ] + , NodeElement $ Element "body" [] + [ NodeElement $ Element "p" [] + [NodeContent "Hello World"] + ] + ] + in parseHtml_ html @?= doc + it "HTML" $ + let html = "foo

Hello World

" + doc = Document (Prologue [] Nothing []) root [] + root = Element "html" [] + [ NodeElement $ Element "head" [] + [ NodeElement $ Element "title" [] + [NodeContent "foo"] + ] + , NodeElement $ Element "body" [] + [ NodeElement $ Element "br" [] [] + , NodeElement $ Element "p" [] + [NodeContent "Hello World"] + ] + ] + in parseHtml_ html @?= doc diff --git a/yesod-test.cabal b/yesod-test.cabal --- a/yesod-test.cabal +++ b/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 0.2.0.5 +version: 0.2.0.6 license: MIT license-file: LICENSE author: Nubis @@ -11,7 +11,7 @@ build-type: Simple homepage: http://www.yesodweb.com description: Behaviour Oriented integration Testing for Yesod Applications -extra-source-files: README.md, LICENSE +extra-source-files: README.md, LICENSE, test/main.hs flag blaze_html_0_5 description: use blaze-html 0.5 and blaze-markup 0.5 @@ -29,17 +29,15 @@ , network >= 2.2 && < 2.4 , http-types >= 0.6 && < 0.7 , HUnit >= 1.2 && < 1.3 - , hspec >= 1.0 && < 1.1 + , hspec >= 1.1 && < 1.2 , bytestring >= 0.9 , case-insensitive >= 0.2 , text - , tagstream-conduit >= 0.3 && < 0.4 - , conduit >= 0.4 && < 0.5 - , resourcet >= 0.3 && < 0.4 , xml-conduit >= 0.7 && < 0.8 , xml-types >= 0.3 && < 0.4 , containers - , xml2html >= 0.1.2 && < 0.2 + , xml2html >= 0.1.2.3 && < 0.2 + , html-conduit >= 0.0.1 && < 0.1 if flag(blaze_html_0_5) build-depends: