uri-bytestring 0.1.2 → 0.1.3
raw patch · 6 files changed
+337/−8 lines, 6 filesdep ~attoparsec
Dependency ranges changed: attoparsec
Files
- changelog.md +4/−0
- src/URI/ByteString/Lens.hs +2/−3
- src/URI/ByteString/Types.hs +2/−3
- test/URI/ByteString/Arbitrary.hs +66/−0
- test/URI/ByteStringTests.hs +258/−0
- uri-bytestring.cabal +5/−2
changelog.md view
@@ -1,3 +1,7 @@+0.1.3+* Include test modules in distribution++ 0.1.2 * Add support for GHC 7.10
src/URI/ByteString/Lens.hs view
@@ -1,14 +1,13 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} module URI.ByteString.Lens where --------------------------------------------------------------------------------#if !MIN_VERSION_base(4,8,0) import Control.Applicative-#endif import Data.ByteString (ByteString) import Data.Word+-------------------------------------------------------------------------------+import Prelude ------------------------------------------------------------------------------- import URI.ByteString.Types -------------------------------------------------------------------------------
src/URI/ByteString/Types.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -6,12 +5,12 @@ ------------------------------------------------------------------------------- import Data.ByteString (ByteString)-#if !MIN_VERSION_base(4,8,0) import Data.Monoid-#endif import Data.Typeable import Data.Word import GHC.Generics+-------------------------------------------------------------------------------+import Prelude -------------------------------------------------------------------------------
+ test/URI/ByteString/Arbitrary.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module URI.ByteString.Arbitrary where+++-------------------------------------------------------------------------------+import Control.Applicative+import Data.Derive.Arbitrary (makeArbitrary)+import Data.DeriveTH (derive)+import Test.QuickCheck+import Test.QuickCheck.Instances ()+-------------------------------------------------------------------------------+import Prelude+-------------------------------------------------------------------------------+import URI.ByteString+-------------------------------------------------------------------------------+++instance Arbitrary UserInfo where+ arbitrary = UserInfo <$> arbitrary+ <*> arbitrary+++instance Arbitrary Authority where+ arbitrary = Authority <$> arbitrary+ <*> arbitrary+ <*> arbitrary+++instance Arbitrary Host where+ arbitrary = Host <$> arbitrary+++instance Arbitrary Port where+ arbitrary = Port <$> arbitrary+++instance Arbitrary URI where+ arbitrary = URI <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+++instance Arbitrary RelativeRef where+ arbitrary = RelativeRef <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+++instance Arbitrary Scheme where+ arbitrary = Scheme <$> arbitrary+++instance Arbitrary Query where+ arbitrary = Query <$> arbitrary+++instance Arbitrary URIParserOptions where+ arbitrary = URIParserOptions <$> arbitrary+++$(derive makeArbitrary ''SchemaError)+$(derive makeArbitrary ''URIParseError)
+ test/URI/ByteStringTests.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module URI.ByteStringTests (tests) where++-------------------------------------------------------------------------------+import Control.Lens+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8+import Data.Monoid+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+-------------------------------------------------------------------------------+import Prelude+-------------------------------------------------------------------------------+import URI.ByteString+import URI.ByteString.Arbitrary ()+-------------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "URI.Bytestring"+ [+ parseUriTests+ , uriParseErrorInstancesTests+ , lensTests+ ]+++-------------------------------------------------------------------------------+parseUriTests :: TestTree+parseUriTests = testGroup "parseUri"+ [+ testParses "http://www.example.org/" $+ URI (Scheme "http")+ (Just (Authority Nothing (Host "www.example.org") Nothing))+ "/"+ mempty+ Nothing+ , testParseHost "http://www.example.org" "www.example.org"+ -- IPV4+ , testParseHost "http://192.168.1.1" "192.168.1.1"+ -- IPV6+ , testParseHost "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]" "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210"+ , testParseHost "http://[1080:0:0:0:8:800:200C:417A]" "1080:0:0:0:8:800:200C:417A"+ , testParseHost "http://[3ffe:2a00:100:7031::1]" "3ffe:2a00:100:7031::1"+ , testParseHost "http://[::192.9.5.5]" "::192.9.5.5"+ , testParseHost "http://[::FFFF:129.144.52.38]" "::FFFF:129.144.52.38"+ , testParseHost "http://[2010:836B:4179::836B:4179]" "2010:836B:4179::836B:4179"+ , testParseHost "http://[2010:836B:4179::836B:4179]" "2010:836B:4179::836B:4179"+ -- IPVFuture+ , testParseHost "http://[v1.fe80::a+en1]" "v1.fe80::a+en1"+ , testParses "https://user:pass:wo%20rd@www.example.org?foo=bar&foo=baz+quux#frag" $+ URI (Scheme "https")+ (Just (Authority (Just (UserInfo "user" "pass:wo rd")) (Host "www.example.org") Nothing))+ ""+ (Query [("foo", "bar"), ("foo", "baz quux")])+ (Just "frag")+ , testParses "http://www.google.com:80/aclk?sa=l&ai=CChPOVvnoU8fMDI_QsQeE4oGwDf664-EF7sq01HqV1MMFCAAQAigDUO3VhpcDYMnGqYvApNgPoAGq3vbiA8gBAaoEKE_QQwekDUoMeW9IQghV4HRuzL_l-7vVjlML559kix6XOcC1c4Tb9xeAB76hiR2QBwGoB6a-Gw&sig=AOD64_3Ulyu0DcDsc1AamOIxq63RF9u4zQ&rct=j&q=&ved=0CCUQ0Qw&adurl=http://www.aruba.com/where-to-stay/hotels-and-resorts%3Ftid%3D122"+ URI { uriScheme = Scheme {schemeBS = "http"}+ , uriAuthority = Just Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "www.google.com"}, authorityPort = Just (Port 80)}+ , uriPath = "/aclk"+ , uriQuery = Query {queryPairs =+ [("sa", "l")+ ,("ai", "CChPOVvnoU8fMDI_QsQeE4oGwDf664-EF7sq01HqV1MMFCAAQAigDUO3VhpcDYMnGqYvApNgPoAGq3vbiA8gBAaoEKE_QQwekDUoMeW9IQghV4HRuzL_l-7vVjlML559kix6XOcC1c4Tb9xeAB76hiR2QBwGoB6a-Gw")+ ,("sig", "AOD64_3Ulyu0DcDsc1AamOIxq63RF9u4zQ")+ ,("rct", "j")+ ,("q", "")+ ,("ved", "0CCUQ0Qw")+ ,("adurl", "http://www.aruba.com/where-to-stay/hotels-and-resorts?tid=122")+ ]}+ , uriFragment = Nothing+ }++ , testParseFailure "$$$$://www.example.org/" (MalformedScheme NonAlphaLeading)+ , testParses "http://www.example.org/foo#bar" $+ URI (Scheme "http")+ (Just (Authority Nothing (Host "www.example.org") Nothing))+ "/foo"+ mempty+ (Just "bar")+ , testParseFailure "http://www.example.org/foo#bar#baz" MalformedFragment+ , testParseFailure "https://www.example.org?listParam[]=foo,bar" MalformedQuery+ , testParsesLax "https://www.example.org?listParam[]=foo,bar" $+ URI (Scheme "https")+ (Just (Authority Nothing (Host "www.example.org") Nothing))+ ""+ (Query [("listParam[]", "foo,bar")])+ Nothing++ , testParses "https://www.example.org?listParam%5B%5D=foo,bar" $+ URI (Scheme "https")+ (Just (Authority Nothing (Host "www.example.org") Nothing))+ ""+ (Query [("listParam[]", "foo,bar")])+ Nothing++ , parseTestURI strictURIParserOptions "http://www.example.org/." $+ Right $ URI+ (Scheme "http")+ (Just (Authority Nothing (Host "www.example.org") Nothing))+ "/."+ (Query [])+ Nothing+ , parseTestURI strictURIParserOptions "http:/." $+ Right $ URI+ (Scheme "http")+ Nothing+ "/."+ (Query [])+ Nothing++ -- RFC 3986, Section 4.2+ , parseTestRelativeRef strictURIParserOptions "verysimple" $+ Right $ RelativeRef+ Nothing+ "verysimple"+ (Query [])+ Nothing+ , parseTestRelativeRef strictURIParserOptions "this:that/thap/sub?1=2" $+ Left $ MalformedPath+ , parseTestRelativeRef strictURIParserOptions "./this:that/thap/sub?1=2" $+ Right $ RelativeRef+ Nothing+ "./this:that/thap/sub"+ (Query [("1", "2")])+ Nothing+ ]+++-------------------------------------------------------------------------------+uriParseErrorInstancesTests :: TestTree+uriParseErrorInstancesTests = testGroup "URIParseError instances"+ [+ testProperty "roundtrips between Show and Read" $ \(e :: URIParseError) ->+ read (show e) == e+ ]++lensTests :: TestTree+lensTests = testGroup "lenses"+ [+ testProperty "schemeBSL Lens" $ \bs bs' ->+ let wrapped = Scheme bs+ in (wrapped ^. schemeBSL) === schemeBS wrapped .&&.+ (wrapped & schemeBSL .~ bs') === wrapped { schemeBS = bs'}+ , testProperty "hostBSL Lens" $ \bs bs' ->+ let wrapped = Host bs+ in (wrapped ^. hostBSL) === hostBS wrapped .&&.+ (wrapped & hostBSL .~ bs') === wrapped { hostBS = bs'}+ , testProperty "portNumberL Lens" $ \n n' ->+ let wrapped = Port n+ in (wrapped ^. portNumberL) === portNumber wrapped .&&.+ (wrapped & portNumberL .~ n') === wrapped { portNumber = n'}+ , testProperty "queryPairsL Lens" $ \ps ps' ->+ let wrapped = Query ps+ in wrapped ^. queryPairsL === queryPairs wrapped .&&.+ (wrapped & queryPairsL .~ ps') === wrapped { queryPairs = ps'}++ , testProperty "authorityUserInfoL Lens" $ \a ui ->+ (a ^. authorityUserInfoL === authorityUserInfo a) .&&.+ ((a & authorityUserInfoL .~ ui) === a { authorityUserInfo = ui })+ , testProperty "authorityHostL Lens" $ \a host ->+ (a ^. authorityHostL === authorityHost a) .&&.+ ((a & authorityHostL .~ host) === a { authorityHost = host })+ , testProperty "authorityPortL Lens" $ \a port ->+ (a ^. authorityPortL === authorityPort a) .&&.+ ((a & authorityPortL .~ port) === a { authorityPort = port })++ , testProperty "uiUsernameL Lens" $ \ui bs ->+ (ui ^. uiUsernameL === uiUsername ui) .&&.+ ((ui & uiUsernameL .~ bs) === ui { uiUsername = bs })+ , testProperty "uiPasswordL Lens" $ \ui bs ->+ (ui ^. uiPasswordL === uiPassword ui) .&&.+ ((ui & uiPasswordL .~ bs) === ui { uiPassword = bs })++ , testProperty "uriSchemeL Lens" $ \uri x ->+ (uri ^. uriSchemeL === uriScheme uri) .&&.+ ((uri & uriSchemeL .~ x) === uri { uriScheme = x })+ , testProperty "uriAuthorityL Lens" $ \uri x ->+ (uri ^. uriAuthorityL === uriAuthority uri) .&&.+ ((uri & uriAuthorityL .~ x) === uri { uriAuthority = x })+ , testProperty "uriPathL Lens" $ \uri x ->+ (uri ^. uriPathL === uriPath uri) .&&.+ ((uri & uriPathL .~ x) === uri { uriPath = x })+ , testProperty "uriQueryL Lens" $ \uri x ->+ (uri ^. uriQueryL === uriQuery uri) .&&.+ ((uri & uriQueryL .~ x) === uri { uriQuery = x })+ , testProperty "uriFragmentL Lens" $ \uri x ->+ (uri ^. uriFragmentL === uriFragment uri) .&&.+ ((uri & uriFragmentL .~ x) === uri { uriFragment = x })++ , testProperty "rrAuthorityL Lens" $ \rr x ->+ (rr ^. rrAuthorityL === rrAuthority rr) .&&.+ ((rr & rrAuthorityL .~ x) === rr { rrAuthority = x })+ , testProperty "rrPathL Lens" $ \rr x ->+ (rr ^. rrPathL === rrPath rr) .&&.+ ((rr & rrPathL .~ x) === rr { rrPath = x })+ , testProperty "rrQueryL Lens" $ \rr x ->+ (rr ^. rrQueryL === rrQuery rr) .&&.+ ((rr & rrQueryL .~ x) === rr { rrQuery = x })+ , testProperty "rrFragmentL Lens" $ \rr x ->+ (rr ^. rrFragmentL === rrFragment rr) .&&.+ ((rr & rrFragmentL .~ x) === rr { rrFragment = x })+ ]++testParses :: ByteString -> URI -> TestTree+testParses = testParses' strictURIParserOptions+++testParseHost :: ByteString -> ByteString -> TestTree+testParseHost uri expectedHost =+ testParses uri $+ URI (Scheme "http")+ (Just (Authority Nothing (Host expectedHost) Nothing))+ mempty+ mempty+ Nothing+++testParsesLax :: ByteString -> URI -> TestTree+testParsesLax = testParses' laxURIParserOptions+++testParses' :: URIParserOptions -> ByteString -> URI -> TestTree+testParses' opts s u = testGroup "testParses'"+ [ parseTestURI opts s $ Right u+ , parseTestRelativeRef opts (makeRelativeRefBS s) $ Right (makeRelativeRefTyped u)+ ]+++makeRelativeRefTyped :: URI -> RelativeRef+makeRelativeRefTyped (URI _ a p q f) = RelativeRef a p q f+++makeRelativeRefBS :: ByteString -> ByteString+makeRelativeRefBS s = B8.tail x+ where+ (_, x) = B8.break (==':') s+++testParseFailure :: ByteString -> URIParseError -> TestTree+testParseFailure s = parseTestURI strictURIParserOptions s . Left+++parseTestURI+ :: URIParserOptions+ -> ByteString+ -> Either URIParseError URI+ -> TestTree+parseTestURI opts s r = testCase (B8.unpack s) $ parseURI opts s @?= r+++parseTestRelativeRef+ :: URIParserOptions+ -> ByteString+ -> Either URIParseError RelativeRef+ -> TestTree+parseTestRelativeRef opts s r =+ testCase (B8.unpack s) $ parseRelativeRef opts s @?= r
uri-bytestring.cabal view
@@ -1,5 +1,5 @@ name: uri-bytestring-version: 0.1.2+version: 0.1.3 synopsis: Haskell URI parsing as ByteStrings description: uri-bytestring aims to be an RFC3986 compliant URI parser that uses efficient ByteStrings for parsing and representing the URI data. license: BSD3@@ -33,7 +33,7 @@ build-depends: - attoparsec >= 0.10 && < 0.13+ attoparsec >= 0.10 && < 0.14 , base >= 4.6 && < 4.9 , bytestring >= 0.9.1 && < 0.11 , blaze-builder >= 0.3.0.0 && < 0.5@@ -49,6 +49,9 @@ test-suite test type: exitcode-stdio-1.0 main-is: Main.hs+ other-modules:+ URI.ByteString.Arbitrary+ URI.ByteStringTests hs-source-dirs: test build-depends: uri-bytestring