network-uri 2.6.1.0 → 2.6.2.0

raw patch · 8 files changed

+523/−49 lines, 8 filesdep +criteriondep +ghc-primdep +template-haskelldep ~basedep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: criterion, ghc-prim, template-haskell

Dependency ranges changed: base, deepseq

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• Network/URI.hs +139/−39
• Network/URI/Lens.hs +48/−0
• Network/URI/Static.hs +141/−0
• README.md +41/−0
• network-uri.cabal +57/−9
• tests/uri-bench.hs +56/−0
• tests/uri001.hs +28/−1

@@ -0,0 +1,13 @@+# network-uri-2.6.2.0 (2020-01-30)+* Merge network-uri-static (Network.URI.Static) into this package+* Add `Lens`es for the `URI` types+* Optimize `isReserved` and related character-class functions+* Add `Generic` instances for the `URI` type+* Add `Lift` instances for the `URI` type++# network-uri-2.6.2.0 (2019-??-??)+* Start to add some benchmarks for performance analysis+* Correctly parse IPv6 addresses in URIs+* Add `rectify` which normalizes a URI if it is missing certain+  separator characters required by the module, which some users find+  inconvenient.

@@ -1,4 +1,9 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards, CPP #-}+#if __GLASGOW_HASKELL__ < 800+{-# LANGUAGE TemplateHaskell #-}+#else+{-# LANGUAGE TemplateHaskellQuotes #-}+#endif -------------------------------------------------------------------------------- -- | --  Module      :  Network.URI@@ -9,11 +14,12 @@ --  Stability   :  provisional --  Portability :  portable -----  This module defines functions for handling URIs.  It presents substantially the---  same interface as the older GHC Network.URI module, but is implemented using---  Parsec rather than a Regex library that is not available with Hugs.  The internal---  representation of URI has been changed so that URI strings are more---  completely preserved when round-tripping to a URI value and back.+--  This module defines functions for handling URIs.  It presents+--  substantially the same interface as the older GHC Network.URI module, but+--  is implemented using Parsec rather than a Regex library that is not+--  available with Hugs.  The internal representation of URI has been changed+--  so that URI strings are more completely preserved when round-tripping to a+--  URI value and back. -- --  In addition, four methods are provided for parsing different --  kinds of URI string (as noted in RFC3986):@@ -64,7 +70,10 @@       URI(..)     , URIAuth(..)     , nullURI+    , nullURIAuth +    , rectify, rectifyAuth+     -- * Parsing     , parseURI     , parseURIReference@@ -96,7 +105,7 @@     --   The URI spec [3], section 2.4, indicates that all URI components     --   should be escaped before they are assembled as a URI:     --   \"Once produced, a URI is always in its percent-encoded form\"-    , uriToString+    , uriToString, uriAuthToString     , isReserved, isUnreserved     , isAllowedInURI, isUnescapedInURI     , isUnescapedInURIComponent@@ -130,9 +139,11 @@ import Control.DeepSeq (NFData(rnf), deepseq) import Data.Char (ord, chr, isHexDigit, toLower, toUpper, digitToInt) import Data.Bits ((.|.),(.&.),shiftL,shiftR)-import Data.List (unfoldr)+import Data.List (unfoldr, isPrefixOf, isSuffixOf) import Numeric (showIntAtBase) +import Language.Haskell.TH.Syntax (Lift(..))+ #if !MIN_VERSION_base(4,8,0) import Data.Traversable (sequenceA) #endif@@ -144,9 +155,8 @@ import Data.Generics (Data) #endif -#if MIN_VERSION_base(4,6,0)+#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic)-#else #endif  ------------------------------------------------------------@@ -168,12 +178,46 @@     , uriPath       :: String           -- ^ @\/ghc@     , uriQuery      :: String           -- ^ @?query@     , uriFragment   :: String           -- ^ @#frag@-#if MIN_VERSION_base(4,6,0)+#if __GLASGOW_HASKELL__ >= 702     } deriving (Eq, Ord, Typeable, Data, Generic) #else     } deriving (Eq, Ord, Typeable, Data) #endif +-- | Add a prefix to a string, unless it already has it.+ensurePrefix :: String -> String -> String+ensurePrefix p s = if isPrefixOf p s then s else p ++ s++-- | Add a suffix to a string, unless it already has it.+ensureSuffix :: String -> String -> String+ensureSuffix p s = if isSuffixOf p s then s else s ++ p++-- | Given a URIAuth in "nonstandard" form (lacking required separator characters),+-- return one that is standard.+rectifyAuth :: URIAuth -> URIAuth+rectifyAuth a = URIAuth {+  uriUserInfo = unlessEmpty (ensureSuffix "@") (uriUserInfo a),+  uriRegName = uriRegName a,+  uriPort = unlessEmpty (ensurePrefix ":") (uriPort a)+  }++-- | Given a URI in "nonstandard" form (lacking required separator characters),+-- return one that is standard.+rectify :: URI -> URI+rectify u = URI {+  uriScheme = ensureSuffix ":" (uriScheme u),+  uriAuthority = fmap rectifyAuth (uriAuthority u),+  uriPath = uriPath u,+  uriQuery = unlessEmpty (ensurePrefix "?") (uriQuery u),+  uriFragment = unlessEmpty (ensurePrefix "#") (uriFragment u)+  }++-- | Apply the function to the list, unless that list is empty, in+-- which case leave it alone.+unlessEmpty :: ([a] -> [a]) -> [a] -> [a]+unlessEmpty _f [] = []+unlessEmpty  f  x = f x+ instance NFData URI where     rnf (URI s a p q f)         = s `deepseq` a `deepseq` p `deepseq` q `deepseq` f `deepseq` ()@@ -183,7 +227,11 @@     { uriUserInfo   :: String           -- ^ @anonymous\@@     , uriRegName    :: String           -- ^ @www.haskell.org@     , uriPort       :: String           -- ^ @:42@+#if __GLASGOW_HASKELL__ >= 702+    } deriving (Eq, Ord, Show, Typeable, Data, Generic)+#else     } deriving (Eq, Ord, Show, Typeable, Data)+#endif  instance NFData URIAuth where     rnf (URIAuth ui rn p) = ui `deepseq` rn `deepseq` p `deepseq` ()@@ -198,6 +246,14 @@     , uriFragment   = ""     } +-- |Blank URIAuth.+nullURIAuth :: URIAuth+nullURIAuth = URIAuth+    { uriUserInfo   = ""+    , uriRegName    = ""+    , uriPort       = ""+    }+ --  URI as instance of Show.  Note that for security reasons, the default --  behaviour is to suppress any userinfo field (see RFC3986, section 7.5). --  This can be overridden by using uriToString directly with first@@ -348,11 +404,39 @@ isReserved :: Char -> Bool isReserved c = isGenDelims c || isSubDelims c +-- As per https://github.com/haskell/network-uri/pull/46, it was found+-- that the explicit case statement was noticably faster than a nicer+-- expression in terms of `elem`. isGenDelims :: Char -> Bool-isGenDelims c = c `elem` ":/?#[]@"+isGenDelims c =+  case c of+    ':' -> True+    '/' -> True+    '?' -> True+    '#' -> True+    '[' -> True+    ']' -> True+    '@' -> True+    _ -> False +-- As per https://github.com/haskell/network-uri/pull/46, it was found+-- that the explicit case statement was noticably faster than a nicer+-- expression in terms of `elem`. isSubDelims :: Char -> Bool-isSubDelims c = c `elem` "!$&'()*+,;="+isSubDelims c =+  case c of+    '!' -> True+    '$' -> True+    '&' -> True+    '\'' -> True+    '(' -> True+    ')' -> True+    '*' -> True+    '+' -> True+    ',' -> True+    ';' -> True+    '=' -> True+    _ -> False  subDelims :: URIParser String subDelims = (:[]) <$> oneOf "!$&'()*+,;="@@ -445,6 +529,7 @@         }  --  RFC3986, section 3.2.2+--  RFC6874, section 2  host :: URIParser String host = ipLiteral <|> try ipv4address <|> regName@@ -452,7 +537,7 @@ ipLiteral :: URIParser String ipLiteral =     do  { _ <- char '['-        ; ua <- ( ipv6address <|> ipvFuture )+        ; ua <- ( ipv6addrz <|> ipvFuture )         ; _ <- char ']'         ; return $ "[" ++ ua ++ "]"         }@@ -470,6 +555,12 @@ isIpvFutureChar :: Char -> Bool isIpvFutureChar c = isUnreserved c || isSubDelims c || (c==';') +zoneid :: URIParser String+zoneid = concat <$> many1 (unreservedChar <|> escaped)++ipv6addrz :: URIParser String+ipv6addrz = (++) <$> ipv6address <*> option "" (try $ (++) <$> string "%25" <*> zoneid)+ ipv6address :: URIParser String ipv6address =         try ( do@@ -1089,6 +1180,7 @@         (r,'/':ps1) -> (r++"/",ps1)         (r,_)       -> (r,[]) +-- | The segments of the path component of a URI. E.g., segments :: String -> [String] segments str = dropLeadingEmpty $ unfoldr nextSegmentMaybe str     where@@ -1165,47 +1257,51 @@             where                 (p1,p2) = splitLast p +-- | Calculate the path to the first argument, from the second argument. relPathFrom :: String -> String -> String relPathFrom []   _    = "/" relPathFrom pabs []   = pabs-relPathFrom pabs base =                 -- Construct a relative path segments-    if sa1 == sb1                       -- if the paths share a leading segment-        then if (sa1 == "/")            -- other than a leading '/'-            then if (sa2 == sb2)-                then relPathFrom1 ra2 rb2-                else pabs-            else relPathFrom1 ra1 rb1-        else pabs+relPathFrom pabs base =+    if sa1 == sb1                       -- If the first segments are equal+        then if (sa1 == "/")              -- and they're absolute,+            then if (sa2 == sb2)            -- then if the 2nd segs are equal,+                then relPathFrom1 ra2 rb2   -- relativize from there.+                else+                   pabs                     -- Otherwise it's not worth trying.+            else relPathFrom1 ra1 rb1     -- If same & relative, relativize.+        else pabs                       -- If 1st segs not equal, just use pabs.     where         (sa1,ra1) = nextSegment pabs         (sb1,rb1) = nextSegment base         (sa2,ra2) = nextSegment ra1         (sb2,rb2) = nextSegment rb1 ---  relPathFrom1 strips off trailing names from the supplied paths,---  and calls difPathFrom to find the relative path from base to---  target+--  relPathFrom1 strips off trailing names from the supplied paths, and finds+--  the relative path from base to target. relPathFrom1 :: String -> String -> String relPathFrom1 pabs base = relName     where+        -- Relative paths are reckoned without the basename, so split those off.         (sa,na) = splitLast pabs         (sb,nb) = splitLast base         rp      = relSegsFrom sa sb         relName = if null rp then+                      -- If the relative path is empty, and the basenames are+                      -- the same, then the paths must be exactly the same.                       if (na == nb) then ""+                      -- If the name is vulnerable to being misinterpreted,+                      -- add a dot segment in advance to protect it.                       else if protect na then "./"++na                       else na                   else                       rp++na-        -- Precede name with some path if it is null or contains a ':'+        -- If a single-segment path is null or contains a ':', it needs+        -- "protection" from being interpreted as a different kind of URL.         protect s = null s || ':' `elem` s ---  relSegsFrom discards any common leading segments from both paths,---  then invokes difSegsFrom to calculate a relative path from the end+--  relSegsFrom discards any equal leading segments from two *directory*+--  paths, then invokes difSegsFrom to calculate a relative path from the end --  of the base path to the end of the target path.---  The final name is handled separately, so this deals only with---  "directory" segtments.--- relSegsFrom :: String -> String -> String {- relSegsFrom sabs base@@ -1221,14 +1317,8 @@         (sa1,ra1) = nextSegment sabs         (sb1,rb1) = nextSegment base ---  difSegsFrom calculates a path difference from base to target,---  not including the final name at the end of the path---  (i.e. results always ends with '/')------  This function operates under the invariant that the supplied---  value of sabs is the desired path relative to the beginning of---  base.  Thus, when base is empty, the desired path has been found.---+-- Given two paths @a@, @b@, count out the necessary number of ".." segments+-- to get from the depth of @b@ to the path @a@. difSegsFrom :: String -> String -> String {- difSegsFrom sabs base@@ -1275,6 +1365,16 @@         normstr Nothing  = uristr         normstr (Just u) = show (normuri u)         normuri u = u { uriPath = removeDotSegments (uriPath u) }++------------------------------------------------------------+--  Lift instances to support Network.URI.Static+------------------------------------------------------------++instance Lift URI where+    lift (URI {..}) = [| URI {..} |]++instance Lift URIAuth where+    lift (URIAuth {..}) = [| URIAuth {..} |]  ------------------------------------------------------------ --  Deprecated functions

@@ -0,0 +1,48 @@+{-# LANGUAGE Rank2Types #-}+-- | Network uri lenses+module Network.URI.Lens+  ( uriRegNameLens+  , uriUserInfoLens+  , uriPortLens+  , uriAuthorityLens+  , uriSchemeLens+  , uriPathLens+  , uriQueryLens+  , uriFragmentLens+  ) where++import           Control.Applicative+import           Network.URI++type Lens' s a = Lens s s a a+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = sbt s <$> afb (sa s)++uriRegNameLens :: Lens' URIAuth String+uriRegNameLens = lens uriRegName (\parent newVal -> parent {uriRegName = newVal})++uriUserInfoLens :: Lens' URIAuth String+uriUserInfoLens =+  lens uriUserInfo (\parent newVal -> parent {uriUserInfo = newVal})++uriPortLens :: Lens' URIAuth String+uriPortLens = lens uriPort (\parent newVal -> parent {uriPort = newVal})++uriAuthorityLens :: Lens' URI (Maybe URIAuth)+uriAuthorityLens =+  lens uriAuthority (\parent newVal -> parent {uriAuthority = newVal})++uriSchemeLens :: Lens' URI String+uriSchemeLens = lens uriScheme (\parent newVal -> parent {uriScheme = newVal})++uriPathLens :: Lens' URI String+uriPathLens = lens uriPath (\parent newVal -> parent {uriPath = newVal})++uriQueryLens :: Lens' URI String+uriQueryLens = lens uriQuery (\parent newVal -> parent {uriQuery = newVal})++uriFragmentLens :: Lens' URI String+uriFragmentLens =+  lens uriFragment (\parent newVal -> parent {uriFragment = newVal})

@@ -0,0 +1,141 @@+#if __GLASGOW_HASKELL__ < 800+{-# LANGUAGE RecordWildCards, TemplateHaskell, ViewPatterns #-}+#else+{-# LANGUAGE RecordWildCards, TemplateHaskellQuotes, ViewPatterns #-}+#endif+module Network.URI.Static+    (+    -- * Absolute URIs+      uri+#if __GLASGOW_HASKELL__ >= 708+    , staticURI+#endif+    , staticURI'+    -- * Relative URIs+    , relativeReference+#if __GLASGOW_HASKELL__ >= 708+    , staticRelativeReference+#endif+    , staticRelativeReference'+    ) where++import Language.Haskell.TH.Lib (ExpQ)+import Language.Haskell.TH.Quote (QuasiQuoter(..))+import Network.URI (URI(..), parseURI, parseRelativeReference)++#if __GLASGOW_HASKELL__ >= 708+import Language.Haskell.TH.Lib (TExpQ)+import Language.Haskell.TH.Syntax (unTypeQ)+#endif++-- $setup+-- >>> :set -XTemplateHaskell+-- >>> :set -XQuasiQuotes++----------------------------------------------------------------------------+-- Absolute URIs+----------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 708+-- | 'staticURI' parses a specified string at compile time+--   and return an expression representing the URI when it's a valid URI.+--   Otherwise, it emits an error.+--+-- >>> $$(staticURI "http://www.google.com/")+-- http://www.google.com/+--+-- >>> $$(staticURI "http://www.google.com/##")+-- <BLANKLINE>+-- <interactive>...+-- ... Invalid URI: http://www.google.com/##+-- ...+staticURI :: String    -- ^ String representation of a URI+          -> TExpQ URI -- ^ URI+staticURI (parseURI -> Just u) = [|| u ||]+staticURI s = fail $ "Invalid URI: " ++ s+#endif++-- | 'staticURI'' parses a specified string at compile time.+--+-- The typed template haskell 'staticURI' is available only with GHC-7.8+.+staticURI' :: String    -- ^ String representation of a URI+           -> ExpQ      -- ^ URI+#if __GLASGOW_HASKELL__ >= 708+staticURI' = unTypeQ . staticURI+#else+staticURI' (parseURI -> Just u) = [| u |]+staticURI' s = fail $ "Invalid URI: " ++ s+#endif++-- | 'uri' is a quasi quoter for 'staticURI'.+--+-- >>> [uri|http://www.google.com/|]+-- http://www.google.com/+--+-- >>> [uri|http://www.google.com/##|]+-- <BLANKLINE>+-- <interactive>...+-- ... Invalid URI: http://www.google.com/##+-- ...+uri :: QuasiQuoter+uri = QuasiQuoter {+    quoteExp =  staticURI',+    quotePat = undefined,+    quoteType = undefined,+    quoteDec = undefined+}++----------------------------------------------------------------------------+-- Relative URIs+----------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ >= 708+-- | 'staticRelativeReference' parses a specified string at compile time and+--   return an expression representing the URI when it's a valid relative+--   reference. Otherwise, it emits an error.+--+-- >>> $$(staticRelativeReference "/foo?bar=baz#quux")+-- /foo?bar=baz#quux+--+-- >>> $$(staticRelativeReference "http://www.google.com/")+-- <BLANKLINE>+-- <interactive>...+-- ... Invalid relative reference: http://www.google.com/+-- ...+staticRelativeReference :: String -- ^ String representation of a reference+                        -> TExpQ URI -- ^ Refererence+staticRelativeReference (parseRelativeReference -> Just ref) = [|| ref ||]+staticRelativeReference ref = fail $ "Invalid relative reference: " ++ ref+#endif++-- | 'staticRelativeReference'' parses a specified string at compile time and+--   return an expression representing the URI when it's a valid relative+--   reference. Otherwise, it emits an error.+--+-- The typed template haskell 'staticRelativeReference' is available only with GHC-7.8+.+staticRelativeReference' :: String -- ^ String representation of a reference+                         -> ExpQ   -- ^ Refererence+#if __GLASGOW_HASKELL__ >= 708+staticRelativeReference' = unTypeQ . staticRelativeReference+#else+staticRelativeReference' (parseRelativeReference -> Just ref) = [| ref |]+staticRelativeReference' ref = fail $ "Invalid relative reference: " ++ ref+#endif++-- | 'relativeReference' is a quasi quoter for 'staticRelativeReference'.+--+-- >>> [relativeReference|/foo?bar=baz#quux|]+-- /foo?bar=baz#quux+--+-- >>> [relativeReference|http://www.google.com/|]+-- <BLANKLINE>+-- <interactive>...+-- ... Invalid relative reference: http://www.google.com/+-- ...+relativeReference :: QuasiQuoter+relativeReference = QuasiQuoter {+    quoteExp = staticRelativeReference',+    quotePat = undefined,+    quoteType = undefined,+    quoteDec = undefined+}

@@ -0,0 +1,41 @@+The network-uri package+=======================++This package provides facilities for parsing and unparsing URIs, and creating+and resolving relative URI references, closely following the URI spec, IETF+RFC 3986 [1].++The main module in this package, `Network.URI`, was split off from the+network package in the network-2.6 release.++# Network.URI.Static++Network.URI.Static that allows you to declare static URIs in type-safe manner.++With the base module, when you declare a static URI, you need to either use `Maybe URI` or use `URI` and give up type safety.++```haskell+safeButWrappedInMaybeURI :: Maybe URI+safeButWrappedInMaybeURI = parseURI "http://www.google.com/"++directButUnsafeURI :: URI+directButUnsafeURI = fromJust $ parseURI "http://www.google.com/"+```++This library allows you to write static URIs in type-safe manner by checking URIs at compile time using template haskell.++Now, you can write the following.++```haskell+directAndSafeURI :: URI+directAndSafeURI = $$(staticURI "http://www.google.com")+```++You can even use a quasi quote if you'd like.++```haskell+directAndSafeURI :: URI+directAndSafeURI = [uri|"http://www.google.com"|]+```++These two expressions emit an error at compile time if a specified URI is malformed.

@@ -1,14 +1,27 @@ name:                network-uri-version:             2.6.1.0+version:             2.6.2.0 synopsis:            URI manipulation description:-  This package provides an URI manipulation interface.+  This package provides facilities for parsing and unparsing URIs, and creating+  and resolving relative URI references, closely following the URI spec,+  <http://www.ietf.org/rfc/rfc3986.txt IETF RFC 3986>.   .-  In network-2.6 the @Network.URI@ module was split off from the-  network package into this package. If you're using the @Network.URI@-  module you can automatically get it from the right package by adding-  this to your .cabal file:+  == Backward-compatibility   .+  In @network-2.6@ the "Network.URI" module was split off from the+  @network@ package into this package. If you're using the "Network.URI"+  module you can be backward compatible and automatically get it from+  the right package by using the+  </package/network-uri-flag network-uri-flag pseudo-package>+  in your @.cabal@ file's build-depends (along with dependencies for+  both @network-uri@ and @network@):+  .+  >  build-depends:+  >     network-uri-flag == 0.1.*+  .+  Or you can do the same manually by adding this boilerplate to your+  @.cabal@ file:+  .   > flag network-uri   >   description: Get Network.URI from the network-uri package   >   default: True@@ -20,26 +33,46 @@   >   else   >     build-depends: network-uri < 2.6, network < 2.6   .-  That is, get the module from either network < 2.6 or from-  network-uri >= 2.6.+  That is, get the module from either @network < 2.6@ or from+  @network-uri >= 2.6@.+ homepage:            https://github.com/haskell/network-uri bug-reports:         https://github.com/haskell/network-uri/issues license:             BSD3 license-file:        LICENSE+extra-source-files:  README.md, CHANGELOG.md maintainer:          ezra@ezrakilty.net category:            Network build-type:          Simple cabal-version:       >=1.10+tested-with:+  GHC ==8.10.1+   || ==8.8.2+   || ==8.6.5+   || ==8.4.4+   || ==8.2.2+   || ==8.0.2+   || ==7.10.3+   || ==7.8.4+   || ==7.6.3+   || ==7.4.2+   || ==7.2.2+   || ==7.0.2  library   exposed-modules:     Network.URI+    Network.URI.Lens+    Network.URI.Static   build-depends:     base >= 3 && < 5,     deepseq >= 1.1 && < 1.5,     parsec >= 3.0 && < 3.2+  build-depends: template-haskell   default-extensions: CPP, DeriveDataTypeable-  if impl(ghc >= 7.6)+  if impl(ghc < 7.6)+    build-depends: ghc-prim+  if impl(ghc >= 7.2)     default-extensions: DeriveGeneric   ghc-options: -Wall -fwarn-tabs   default-language: Haskell98@@ -56,6 +89,21 @@     test-framework,     test-framework-hunit,     test-framework-quickcheck2++  ghc-options: -Wall -fwarn-tabs+  default-language: Haskell98++test-suite uri-bench+  hs-source-dirs: tests+  main-is: uri-bench.hs+  type: exitcode-stdio-1.0++  build-depends:+    base < 5,+    HUnit,+    network-uri,+    criterion,+    deepseq    ghc-options: -Wall -fwarn-tabs   default-language: Haskell98

@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE BangPatterns #-}+--------------------------------------------------------------------------------+--  $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $+--+--  Copyright (c) 2004, G. KLYNE.  All rights reserved.+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  URITest+--  Copyright   :  (c) 2004, Graham Klyne+--  License     :  BSD-style (see end of this file)+--+-- Performance benchmarks for the network-uri package.+--+--------------------------------------------------------------------------------++module Main where++import Network.URI+    ( parseURI+    , parseURIReference+    , pathSegments+    , relativeFrom+    , relativeTo+    , isReserved+    )++import Criterion.Main+import Control.DeepSeq++main = defaultMain [+    let Just !u = force (parseURI "http://ezample.org/foo/bar/baz//wimple/dimple/simple") in+    bgroup "pathSegments" [+       bench "head" $ nf head (pathSegments u)+     , bench "tail" $ nf tail (pathSegments u)+    ]+  , bgroup "relativeFrom" [+      let Just !u1 = force (parseURI "http://ex.it/foo/bar/baz/bop") in+      let Just !u2 = force (parseURI "http://ex.it/foo/bar/baz/bap") in+      bench "same 4" $ nf (relativeFrom u1) u2+    , let Just !u1 = force (parseURI "http://ex.it/foo/bar/biz/bop") in+      let Just !u2 = force (parseURI "http://ex.it/foo/bar/baz/bap") in+      bench "different 4" $ nf (relativeFrom u1) u2+    ]+  , bgroup "relativeTo" [+      let Just !u1 = force (parseURIReference "../../biz/../biz/./bop") in+      let Just !u2 = force (parseURI "http://ex.it/foo/bar/baz/bap") in+      bench "dots and double dots" $ nf (relativeTo u1) u2+    ]+  , -- Prompted by https://github.com/haskell/network-uri/pull/46+    bgroup "isReserved" [+      bench "isReserved a" $ nf isReserved 'a'+      , bench "isReserved :" $ nf isReserved ':'+    ]+  ]

@@ -38,13 +38,14 @@ import Network.URI     ( URI(..), URIAuth(..)     , nullURI+    , rectify, rectifyAuth     , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI     , parseAbsoluteURI     , isURI, isURIReference, isRelativeReference, isAbsoluteURI     , uriIsAbsolute, uriIsRelative     , relativeTo, nonStrictRelativeTo     , relativeFrom-    , uriToString+    , uriToString, uriAuthToString     , isUnescapedInURIComponent     , isUnescapedInURI, escapeURIString, unEscapeString     , normalizeCase, normalizeEscape, normalizePathSegments@@ -135,6 +136,7 @@ testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]" testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]" testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"+testURIRef030 = testURIRef AbsId "http://[fe80::ff:fe00:1%25eth0]" -- RFC2396 test cases testURIRef031 = testURIRef RelRf "./aaa" testURIRef032 = testURIRef RelRf "../aaa"@@ -1303,6 +1305,30 @@         assertJust testPathSegmentsRoundTrip $ parseURI "http://ex.ca/foo//bar/"   ] +testRectify = TF.testGroup "testRectify"+  [ TF.testCase "" $ testEq "testRectify"+    (show $ rectify $ URI { uriScheme = "http" ,+                            uriAuthority = Just (URIAuth "ezra" "www.google.com" "80") ,+                            uriPath = "/foo/bar" ,+                            uriQuery = "foo=bar&baz=quz" ,+                            uriFragment = "chap10" })+    "http://ezra@www.google.com:80/foo/bar?foo=bar&baz=quz#chap10"+  , -- According to RFC2986, any URL without a // does not have an authority component.+    -- Therefore tag: URIs have all their content in the path component. This is supported+    -- by the urn: example in section 3. Note that tag: URIs have no leading slash on their+    -- path component.+    TF.testCase "" $ testEq "testRectify"+    "tag:timothy@hpl.hp.com,2001:web/externalHome"+    (show $ rectify $ URI { uriScheme = "tag" ,+                            uriAuthority = Nothing,+                            uriPath = "timothy@hpl.hp.com,2001:web/externalHome",+                            uriQuery = "" ,+                            uriFragment = "" })+  , TF.testCase "" $ testEq "testRectifyAuth"+    "//ezra@www.google.com:80"+    ((uriAuthToString id . Just . rectifyAuth $ URIAuth "ezra" "www.google.com" "80") "")+  ]+ -- Full test suite allTests =   [ testURIRefSuite@@ -1319,6 +1345,7 @@   , testIsAbsolute   , testIsRelative   , testPathSegments+  , testRectify   ]  main = TF.defaultMain allTests