genvalidity-network-uri 0.0.0.0 → 0.1.0.0

raw patch · 4 files changed

+76/−10 lines, 4 filesdep −validitydep ~genvaliditydep ~genvalidity-criterionPVP ok

version bump matches the API change (PVP)

Dependencies removed: validity

Dependency ranges changed: genvalidity, genvalidity-criterion

API changes (from Hackage documentation)

Files

• bench/Main.hs +10/−2
• genvalidity-network-uri.cabal +4/−8
• src/Data/GenValidity/URI.hs +60/−0
• test/Data/GenValidity/URISpec.hs +2/−0

@@ -12,6 +12,14 @@ main :: IO () main =   Criterion.defaultMain-    [ genValidBench @URIAuth,-      genValidBench @URI+    [ bgroup+        "generators"+        [ genValidBench @URIAuth,+          genValidBench @URI+        ],+      bgroup+        "shrinkers"+        [ shrinkValidBench @URIAuth,+          shrinkValidBench @URI+        ]     ]

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack  name:           genvalidity-network-uri-version:        0.0.0.0+version:        0.1.0.0 synopsis:       GenValidity support for URI category:       Testing homepage:       https://github.com/NorfairKing/validity#readme@@ -33,7 +33,6 @@     , genvalidity >=1.0     , iproute     , network-uri-    , validity >=0.5     , validity-network-uri   default-language: Haskell2010 @@ -51,7 +50,6 @@   build-depends:       QuickCheck     , base >=4.7 && <5-    , genvalidity     , genvalidity-network-uri     , genvalidity-sydtest     , network-uri@@ -68,11 +66,9 @@       bench/   ghc-options: -Wall   build-depends:-      QuickCheck-    , base >=4.7 && <5+      base >=4.7 && <5     , criterion-    , genvalidity-    , genvalidity-criterion+    , genvalidity-criterion >=1.1.0.0     , genvalidity-network-uri     , network-uri   default-language: Haskell2010

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans -Wno-duplicate-exports #-} @@ -90,6 +91,9 @@     uriRegName <- genHost     uriPort <- genPort     pure $ URIAuth {..}+  shrinkValid (URIAuth ui rn p) = filter isValid $ do+    ((ui', rn'), p') <- shrinkTuple (shrinkTuple shrinkUserInfo shrinkHost) shrinkPort ((ui, rn), p)+    pure (URIAuth ui' rn' p')  instance GenValid URI where   genValid = (`suchThat` isValid) . (`suchThatMap` (parseURIReference . dangerousURIToString)) $ do@@ -99,6 +103,16 @@     uriQuery <- genQuery     uriFragment <- genFragment     pure $ URI {..}+  shrinkValid (URI s mAuth p q f) = filter isValid $ do+    (((s', mAuth'), (p', q')), f') <-+      shrinkTuple+        ( shrinkTuple+            (shrinkTuple shrinkScheme shrinkValid)+            (shrinkTuple shrinkPath shrinkQuery)+        )+        shrinkFragment+        (((s, mAuth), (p, q)), f)+    pure (URI s' mAuth' p' q' f')  genScheme :: Gen String genScheme =@@ -132,6 +146,15 @@         ]     ] +-- Shrinking this is complicated, so we only shrink to more secure versions and to "no scheme"+shrinkScheme :: String -> [String]+shrinkScheme = \case+  "" -> []+  "http:" -> ["", "https:"]+  "ftp:" -> ["", "ftps:"]+  "ws:" -> ["", "wss:"]+  _ -> [""]+ genUserInfo :: Gen String genUserInfo =   nullOrAppend '@' . concat@@ -144,6 +167,12 @@           ]       ) +-- Shrinking this is quite complex, so we only try to shrink to no user info.+shrinkUserInfo :: String -> [String]+shrinkUserInfo = \case+  "" -> []+  _ -> [""]+ genHost :: Gen String genHost =   oneof@@ -152,6 +181,12 @@       genRegName     ] +-- Shrinking this is quite complex, so we only try to shrink to localhost+shrinkHost :: String -> [String]+shrinkHost = \case+  "localhost" -> []+  _ -> ["localhost"]+ genIPLiteral :: Gen String genIPLiteral = do   a <-@@ -194,6 +229,13 @@ genPort :: Gen String genPort = nullOrPrepend ':' <$> genStringBy genCharDIGIT +-- Shrinking this requires parsing the port, which we don't care about, so we+-- only try to shrink to "no port".+shrinkPort :: String -> [String]+shrinkPort = \case+  "" -> []+  _ -> [""]+ genPercentEncodedChar :: Gen String genPercentEncodedChar = do   octet <- choose (0, 255)@@ -297,6 +339,12 @@       (1, elements [":", "@"])     ] +-- Shrinking this is complicated so we only shrink to "no path"+shrinkPath :: String -> [String]+shrinkPath = \case+  "" -> []+  _ -> [""]+ -- @ -- query       = *( pchar / "/" / "?" ) -- @@@ -316,6 +364,12 @@           ]       ) +-- | Shrinking this is complicated so we only shrink to "no query".+shrinkQuery :: String -> [String]+shrinkQuery = \case+  "" -> []+  _ -> [""]+ -- @ -- fragment    = *( pchar / "/" / "?" ) -- @@@ -328,6 +382,12 @@             (1, elements ["/", "?"])           ]       )++-- | Shrinking this is complicated so we only shrink to "no fragment".+shrinkFragment :: String -> [String]+shrinkFragment = \case+  "" -> []+  _ -> [""]  genCharUnreserved :: Gen Char genCharUnreserved =

@@ -13,6 +13,7 @@ spec = do   describe "GenValid URIAuth" $ do     genValidSpec @URIAuth+    shrinkValidSpec @URIAuth    describe "URI" $ do     describe "considers these examples from the spec valid" $ do@@ -133,6 +134,7 @@             Nothing -> expectationFailure "Should have parsed."             Just uri' -> uri' `shouldBe` uri +    shrinkValidSpec @URI     modifyMaxSuccess (* 10) $       describe "GenValid URI" $ do         genValidSpec @URI