uri-bytestring 0.3.2.1 → 0.3.2.2
raw patch · 7 files changed
+296/−208 lines, 7 filesdep +hedgehogdep +safedep +tasty-hedgehogdep −QuickCheckdep −generics-sopdep −quickcheck-instancesdep ~attoparsecdep ~blaze-builderdep ~bytestring
Dependencies added: hedgehog, safe, tasty-hedgehog
Dependencies removed: QuickCheck, generics-sop, quickcheck-instances, tasty-quickcheck
Dependency ranges changed: attoparsec, blaze-builder, bytestring, template-haskell, th-lift-instances
Files
- changelog.md +3/−0
- src/URI/ByteString/Internal.hs +4/−4
- src/URI/ByteString/Types.hs +7/−7
- test/URI/ByteString/Arbitrary.hs +0/−112
- test/URI/ByteString/Generators.hs +156/−0
- test/URI/ByteStringTests.hs +116/−74
- uri-bytestring.cabal +10/−11
changelog.md view
@@ -1,3 +1,6 @@+0.3.2.2+* Loosen dependencies+ 0.3.2.1 * Loosen upper bounds on template-haskell
src/URI/ByteString/Internal.hs view
@@ -26,9 +26,9 @@ sortBy, stripPrefix, (\\)) import qualified Data.Map.Strict as M import Data.Maybe-import Data.Monoid as Monoid+import Data.Monoid as Monoid (mempty) import Data.Ord (comparing)-import Data.Semigroup (Semigroup)+import Data.Semigroup as Semigroup import Data.Word import Text.Read (readMaybe) -------------------------------------------------------------------------------@@ -795,7 +795,7 @@ , Alternative , Monad , MonadPlus- , Semigroup+ , Semigroup.Semigroup , Monoid) @@ -810,7 +810,7 @@ ------------------------------------------------------------------------------- -- | Use with caution. Catch a parser failing and return Nothing. mParse :: Parser' e a -> Parser' e (Maybe a)-mParse p = option Nothing (Just <$> p)+mParse p = A.option Nothing (Just <$> p) -------------------------------------------------------------------------------
src/URI/ByteString/Types.hs view
@@ -12,20 +12,20 @@ module URI.ByteString.Types where --------------------------------------------------------------------------------import Data.ByteString (ByteString)-import qualified Data.Map.Strict as M+import Data.ByteString (ByteString)+import qualified Data.Map.Strict as M import Data.Monoid-import Data.Semigroup (Semigroup)+import Data.Semigroup as Semigroup import Data.Typeable import Data.Word import GHC.Generics-import Instances.TH.Lift()+import Instances.TH.Lift () ------------------------------------------------------------------------------- import Prelude ------------------------------------------------------------------------------- #ifdef LIFT_COMPAT-import Language.Haskell.TH.Syntax() import Language.Haskell.TH.Lift+import Language.Haskell.TH.Syntax () #else import Language.Haskell.TH.Syntax #endif@@ -90,7 +90,7 @@ ------------------------------------------------------------------------------- newtype Query = Query { queryPairs :: [(ByteString, ByteString)] }- deriving (Show, Eq, Semigroup, Monoid, Generic, Typeable, Ord)+ deriving (Show, Eq, Semigroup.Semigroup, Monoid, Generic, Typeable, Ord) #ifdef LIFT_COMPAT deriveLift ''Query@@ -190,7 +190,7 @@ data SchemaError = NonAlphaLeading -- ^ Scheme must start with an alphabet character | InvalidChars -- ^ Subsequent characters in the schema were invalid | MissingColon -- ^ Schemas must be followed by a colon- deriving (Show, Eq, Read, Generic, Typeable)+ deriving (Show, Eq, Read, Generic, Typeable, Enum, Bounded) -------------------------------------------------------------------------------
− test/URI/ByteString/Arbitrary.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module URI.ByteString.Arbitrary where-----------------------------------------------------------------------------------import Control.Applicative-import Data.Proxy (Proxy (..))-import qualified Generics.SOP as SOP-import qualified Generics.SOP.Constraint as SOP-import qualified Generics.SOP.GGP as SOP-import GHC.Generics (Generic)-import Test.QuickCheck-import Test.QuickCheck.Instances ()---------------------------------------------------------------------------------import Prelude---------------------------------------------------------------------------------import URI.ByteString------------------------------------------------------------------------------------- this workaround can go away when--- <https://github.com/nick8325/quickcheck/pull/40> is merged.-sopArbitrary- :: ( SOP.SListI (SOP.GCode b)- , Generic b- , SOP.GTo b- , SOP.AllF SOP.SListI (SOP.GCode b)- , SOP.AllF (SOP.All Arbitrary) (SOP.GCode b)- )- => Gen b-sopArbitrary = fmap SOP.gto sopArbitrary'---sopArbitrary'- :: (SOP.SListI xs, SOP.AllF (SOP.All Arbitrary) xs, SOP.AllF SOP.SListI xs)- => Gen (SOP.SOP SOP.I xs)-sopArbitrary' = oneof (map SOP.hsequence $ SOP.apInjs_POP $ SOP.hcpure p arbitrary)- where- p :: Proxy Arbitrary- p = Proxy---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 (URIRef Absolute) where- arbitrary = URI <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary---instance Arbitrary (URIRef Relative) 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---instance Arbitrary URINormalizationOptions where- arbitrary = URINormalizationOptions <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary---instance Arbitrary SchemaError where- arbitrary = sopArbitrary- shrink = genericShrink---instance Arbitrary URIParseError where- arbitrary = sopArbitrary- shrink = genericShrink
+ test/URI/ByteString/Generators.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module URI.ByteString.Generators where+++-------------------------------------------------------------------------------+import Control.Applicative+import Data.ByteString (ByteString)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+-------------------------------------------------------------------------------+import Prelude+-------------------------------------------------------------------------------+import URI.ByteString+-------------------------------------------------------------------------------++++genUserInfo :: Gen UserInfo+genUserInfo = do+ username <- Gen.utf8 (Range.linear 0 100) Gen.ascii+ password <- Gen.utf8 (Range.linear 0 100) Gen.ascii+ pure $ UserInfo+ { uiUsername = username+ , uiPassword = password+ }+++genAuthority :: Gen Authority+genAuthority = do+ userInfo <- Gen.maybe genUserInfo+ host <- genHost+ port <- Gen.maybe genPort+ pure $ Authority+ { authorityUserInfo = userInfo+ , authorityHost = host+ , authorityPort = port+ }+++genHost :: Gen Host+genHost = Host <$> Gen.utf8 (Range.linear 0 100) Gen.ascii+++genPort :: Gen Port+genPort = Port <$> genPositiveInt+++genRelativeURIRef :: Gen (URIRef Relative)+genRelativeURIRef = do+ authority <- Gen.maybe genAuthority+ path <- Gen.utf8 (Range.linear 0 100) Gen.ascii+ query <- genQuery+ fragment <- Gen.maybe genAlphaNumBS+ pure $ RelativeRef+ { rrAuthority = authority+ , rrPath = path+ , rrQuery = query+ , rrFragment = fragment+ }+++genAbsoluteURIRef :: Gen (URIRef Absolute)+genAbsoluteURIRef = do+ scheme <- genScheme+ authority <- Gen.maybe genAuthority+ path <- Gen.utf8 (Range.linear 0 100) Gen.ascii+ query <- genQuery+ fragment <- Gen.maybe genAlphaNumBS+ pure $ URI+ { uriScheme = scheme+ , uriAuthority = authority+ , uriPath = path+ , uriQuery = query+ , uriFragment = fragment+ }+++genScheme :: Gen Scheme+genScheme = Scheme <$> genAlphaNumBS+++genQuery :: Gen Query+genQuery = do+ pairs <- Gen.list (Range.linear 0 10) ((,) <$> genAlphaNumBS <*> genAlphaNumBS)+ pure $ Query+ { queryPairs = pairs+ }+++genURIParserOptions :: Gen URIParserOptions+genURIParserOptions = do+ cointoss <- Gen.bool+ pure $ URIParserOptions+ { upoValidQueryChar = const cointoss+ }+++genURINormalizationOptions :: Gen URINormalizationOptions+genURINormalizationOptions = do+ dScheme <- Gen.bool+ dHost <- Gen.bool+ dPort <- Gen.bool+ slashPath <- Gen.bool+ dSlashes <- Gen.bool+ dSort <- Gen.bool+ dSegments <- Gen.bool+ ports <- Gen.map (Range.linear 0 10) ((,) <$> genScheme <*> genPort)+ pure $ URINormalizationOptions+ { unoDowncaseScheme = dScheme+ , unoDowncaseHost = dHost+ , unoDropDefPort = dPort+ , unoSlashEmptyPath = slashPath+ , unoDropExtraSlashes = dSlashes+ , unoSortParameters = dSort+ , unoRemoveDotSegments = dSegments+ , unoDefaultPorts = ports+ }+++genSchemaError :: Gen SchemaError+genSchemaError = Gen.enumBounded+++genURIParseError :: Gen URIParseError+genURIParseError = Gen.choice+ [ MalformedScheme <$> genSchemaError+ , pure MalformedUserInfo+ , pure MalformedQuery+ , pure MalformedFragment+ , pure MalformedHost+ , pure MalformedPort+ , pure MalformedPath+ , OtherError <$> genString+ ]+++genString :: Gen String+genString = Gen.string (Range.linear 0 100) Gen.unicode+++genAlphaNumBS :: Gen ByteString+genAlphaNumBS = Gen.utf8 (Range.linear 0 100) Gen.alphaNum+++genBS :: Gen ByteString+genBS = Gen.utf8 (Range.linear 0 100) Gen.unicode+++genPositiveInt :: Gen Int+genPositiveInt = Gen.int (Range.linear 0 maxBound)
test/URI/ByteStringTests.hs view
@@ -4,25 +4,28 @@ module URI.ByteStringTests (tests) where --------------------------------------------------------------------------------import Control.Applicative (Const (..))-import qualified Blaze.ByteString.Builder as BB-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B8+import qualified Blaze.ByteString.Builder as BB+import Control.Applicative (Const (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8 import Data.Either-import Data.Function.Compat ((&))-import Data.Functor.Identity (Identity (..))-import qualified Data.Map.Strict as M+import Data.Function.Compat ((&))+import Data.Functor.Identity (Identity (..))+import qualified Data.Map.Strict as M import Data.Monoid+import Hedgehog+import qualified Hedgehog.Gen as Gen+import Safe (readMay) import Test.Tasty+import Test.Tasty.Hedgehog import Test.Tasty.HUnit-import Test.Tasty.QuickCheck ------------------------------------------------------------------------------- import Prelude ------------------------------------------------------------------------------- import URI.ByteString-import URI.ByteString.Arbitrary ()+import URI.ByteString.Generators --------------------------------------------------------------------------------import URI.ByteStringQQTests ()+import URI.ByteStringQQTests () infixr 4 .~ (.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t@@ -182,8 +185,9 @@ uriParseErrorInstancesTests :: TestTree uriParseErrorInstancesTests = testGroup "URIParseError instances" [- testProperty "roundtrips between Show and Read" $ \(e :: URIParseError) ->- read (show e) == e+ testProperty "roundtrips between Show and Read" $ property $ do+ parseError <- forAll genURIParseError+ trippingShow parseError ] @@ -191,68 +195,96 @@ 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 "authorityL Lens on URI" $ \uri x ->- (uri ^. authorityL === uriAuthority uri) .&&.- ((uri & authorityL .~ x) === uri { uriAuthority = x })- , testProperty "pathL Lens on URI" $ \uri x ->- (uri ^. pathL === uriPath uri) .&&.- ((uri & pathL .~ x) === uri { uriPath = x })- , testProperty "queryL Lens on URI" $ \uri x ->- (uri ^. queryL === uriQuery uri) .&&.- ((uri & queryL .~ x) === uri { uriQuery = x })- , testProperty "fragmentL Lens on URI" $ \uri x ->- (uri ^. fragmentL === uriFragment uri) .&&.- ((uri & fragmentL .~ x) === uri { uriFragment = x })-- , testProperty "authorityL Lens on relative ref" $ \rr x ->- (rr ^. authorityL === rrAuthority rr) .&&.- ((rr & authorityL .~ x) === rr { rrAuthority = x })- , testProperty "pathL Lens on relative ref" $ \rr x ->- (rr ^. pathL === rrPath rr) .&&.- ((rr & pathL .~ x) === rr { rrPath = x })- , testProperty "queryL Lens on relative ref" $ \rr x ->- (rr ^. queryL === rrQuery rr) .&&.- ((rr & queryL .~ x) === rr { rrQuery = x })- , testProperty "fragmentL Lens on relative ref" $ \rr x ->- (rr ^. fragmentL === rrFragment rr) .&&.- ((rr & fragmentL .~ x) === rr { rrFragment = x })+ testProperty "schemeBSL Lens" $ property $ do+ wrapped <- forAll genScheme+ Scheme bs' <- forAll genScheme+ (wrapped ^. schemeBSL) === schemeBS wrapped+ (wrapped & schemeBSL .~ bs') === wrapped { schemeBS = bs'}+ , testProperty "hostBSL Lens" $ property $ do+ wrapped <- forAll genHost+ Host bs' <- forAll genHost+ (wrapped ^. hostBSL) === hostBS wrapped+ (wrapped & hostBSL .~ bs') === wrapped { hostBS = bs'}+ , testProperty "portNumberL Lens" $ property $ do+ wrapped <- forAll genPort+ Port n' <- forAll genPort+ (wrapped ^. portNumberL) === portNumber wrapped+ (wrapped & portNumberL .~ n') === wrapped { portNumber = n'}+ , testProperty "queryPairsL Lens" $ property $ do+ wrapped <- forAll genQuery+ Query ps' <- forAll genQuery+ wrapped ^. queryPairsL === queryPairs wrapped+ (wrapped & queryPairsL .~ ps') === wrapped { queryPairs = ps'}+ , testProperty "authorityUserInfoL Lens" $ property $ do+ authority <- forAll genAuthority+ userInfo <- forAll (Gen.maybe genUserInfo)+ (authority ^. authorityUserInfoL === authorityUserInfo authority)+ (authority & authorityUserInfoL .~ userInfo) === authority { authorityUserInfo = userInfo }+ , testProperty "authorityHostL Lens" $ property $ do+ authority <- forAll genAuthority+ host <- forAll genHost+ (authority ^. authorityHostL === authorityHost authority)+ (authority & authorityHostL .~ host) === authority { authorityHost = host }+ , testProperty "authorityPortL Lens" $ property $ do+ authority <- forAll genAuthority+ port <- forAll (Gen.maybe genPort)+ (authority ^. authorityPortL === authorityPort authority)+ (authority & authorityPortL .~ port) === authority { authorityPort = port }+ , testProperty "uiUsernameL Lens" $ property $ do+ ui <- forAll genUserInfo+ bs <- forAll genBS+ (ui ^. uiUsernameL === uiUsername ui)+ (ui & uiUsernameL .~ bs) === ui { uiUsername = bs }+ , testProperty "uiPasswordL Lens" $ property $ do+ ui <- forAll genUserInfo+ bs <- forAll genBS+ (ui ^. uiPasswordL === uiPassword ui)+ (ui & uiPasswordL .~ bs) === ui { uiPassword = bs }+ , testProperty "uriSchemeL Lens" $ property $ do+ uri <- forAll genAbsoluteURIRef+ x <- forAll genScheme+ uri ^. uriSchemeL === uriScheme uri+ (uri & uriSchemeL .~ x) === uri { uriScheme = x }+ , testProperty "authorityL Lens on URI" $ property $ do+ uri <- forAll genAbsoluteURIRef+ x <- forAll (Gen.maybe genAuthority)+ uri ^. authorityL === uriAuthority uri+ (uri & authorityL .~ x) === uri { uriAuthority = x }+ , testProperty "pathL Lens on URI" $ property $ do+ uri <- forAll genAbsoluteURIRef+ x <- forAll genBS+ uri ^. pathL === uriPath uri+ (uri & pathL .~ x) === uri { uriPath = x }+ , testProperty "queryL Lens on URI" $ property $ do+ uri <- forAll genAbsoluteURIRef+ x <- forAll genQuery+ uri ^. queryL === uriQuery uri+ (uri & queryL .~ x) === uri { uriQuery = x }+ , testProperty "fragmentL Lens on URI" $ property $ do+ uri <- forAll genAbsoluteURIRef+ x <- forAll (Gen.maybe genBS)+ uri ^. fragmentL === uriFragment uri+ (uri & fragmentL .~ x) === uri { uriFragment = x }+ , testProperty "authorityL Lens on relative ref" $ property $ do+ rr <- forAll genRelativeURIRef+ x <- forAll (Gen.maybe genAuthority)+ (rr ^. authorityL === rrAuthority rr)+ (rr & authorityL .~ x) === rr { rrAuthority = x }+ , testProperty "pathL Lens on relative ref" $ property $ do+ rr <- forAll genRelativeURIRef+ x <- forAll genBS+ rr ^. pathL === rrPath rr+ (rr & pathL .~ x) === rr { rrPath = x }+ , testProperty "queryL Lens on relative ref" $ property $ do+ rr <- forAll genRelativeURIRef+ x <- forAll genQuery+ rr ^. queryL === rrQuery rr+ (rr & queryL .~ x) === rr { rrQuery = x }+ , testProperty "fragmentL Lens on relative ref" $ property $ do+ rr <- forAll genRelativeURIRef+ x <- forAll (Gen.maybe genBS)+ rr ^. fragmentL === rrFragment rr+ (rr & fragmentL .~ x) === rr { rrFragment = x } ] @@ -438,3 +470,13 @@ o = noNormalization normalizeURIBS opts bs = let Right x = parseURI laxURIParserOptions bs in normalizeURIRef' opts x++trippingShow+ :: ( Show a+ , Read a+ , Eq a+ , MonadTest m+ )+ => a+ -> m ()+trippingShow a = tripping a show readMay
uri-bytestring.cabal view
@@ -1,5 +1,5 @@ name: uri-bytestring-version: 0.3.2.1+version: 0.3.2.2 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@@ -39,12 +39,12 @@ build-depends: - attoparsec >= 0.13.1.0 && < 0.14+ attoparsec >= 0.13.1.0 , base >= 4.6 && < 5- , bytestring >= 0.9.1 && < 0.11- , blaze-builder >= 0.3.0.0 && < 0.5- , template-haskell >= 2.9 && < 2.15- , th-lift-instances >= 0.1.8 && < 0.2+ , bytestring >= 0.9.1+ , blaze-builder >= 0.3.0.0+ , template-haskell >= 2.9+ , th-lift-instances >= 0.1.8 , containers hs-source-dirs: src@@ -69,27 +69,26 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- URI.ByteString.Arbitrary+ URI.ByteString.Generators URI.ByteStringTests URI.ByteStringQQTests hs-source-dirs: test build-depends: uri-bytestring , HUnit- , QuickCheck , tasty , tasty-hunit- , tasty-quickcheck+ , hedgehog+ , tasty-hedgehog , attoparsec , base , base-compat >= 0.7.0 , blaze-builder , bytestring- , quickcheck-instances , semigroups , transformers , containers- , generics-sop >= 0.2+ , safe default-language: Haskell2010 if flag(lib-Werror)