network-uri 2.6.4.2 → 2.7.0.0
raw patch · 7 files changed
+220/−277 lines, 7 filesdep +test-frameworkdep +test-framework-hunitdep +test-framework-quickcheck2dep −QuickCheckdep −ghc-primdep −tastydep ~deepseqdep ~parsecdep ~template-haskell
Dependencies added: test-framework, test-framework-hunit, test-framework-quickcheck2
Dependencies removed: QuickCheck, ghc-prim, tasty, tasty-hunit, tasty-quickcheck, th-compat
Dependency ranges changed: deepseq, parsec, template-haskell
Files
- CHANGELOG.md +2/−43
- Network/URI.hs +44/−43
- Network/URI/Lens.hs +0/−8
- Network/URI/Static.hs +15/−56
- network-uri.cabal +10/−32
- tests/uri-bench.hs +0/−3
- tests/uri001.hs +149/−92
CHANGELOG.md view
@@ -1,43 +1,2 @@-# network-uri-2.6.4.2 (2022-12-18)-* Fix warnings, `-Wtrustworthy-safe` and `-Woperator-whitespace-ext-conflict` on GHC 9.4.-* Slightly improved test coverage.--# network-uri-2.6.4.1 (2021-02-07)-* Fix: Restore "Safe" designation which was accidentally removed.--# network-uri-2.6.4.0 (2021-02-07)-* Add compatibility with GHC 9.0.1.--# network-uri-2.6.3.0 (2020-02-18)-* Add official support for SafeHaskell- NOTE: This is the first version whose SafeHaskell properties have become an- intentional part of the API contract; previous versions were merely- accidentally safe-inferred (or not depending on various factors; in other- words, this was a fragile property).-* Derive `Lift` instances using `DeriveLift` extension, when available.--# network-uri-2.6.2.0 (2020-01-30)-* Mark the modules as Safe for SafeHaskell.--# network-uri-2.6.2.0 (2020-01-30)-* Merge network-uri-static (Network.URI.Static) into this- package, which offers a way to parse URI strings at compile time.-* Add `Lens`es for the `URI` types-* Add `Generic` instances for the `URI` type-* Add `Lift` instances for the `URI` type-* Optimize `isReserved` and related character-class functions.-* Start to add some benchmarks for performance analysis-* Fix a bug: Correctly parse IPv6 addresses in URIs.-* Add `rectify` which normalizes a URI if it is missing certain- separator characters required by the module. Some users found adding- those characters inconvenient when building a URI from parts.-* Add `nullURIAuth` and `uriAuthToString`, paralleling `nullURI` and `uriToString`.--# network-uri-2.6.0.3-* Fix a bug with IPv4 address parsing.--# network-uri-2.6.0.2-* Implement Generic and NFData.--# network-uri-2.6.0.0-* Initial release: Module split off from `network`.+# network-uri-2.6.2.0 (2019-??-??)+* Added a `Generic` instance for `URIAuth`.
Network/URI.hs view
@@ -1,18 +1,7 @@-#if __GLASGOW_HASKELL__ < 800-{-# LANGUAGE RecordWildCards #-}-#endif-{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards, CPP #-} #if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift, StandaloneDeriving #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif-#if MIN_VERSION_template_haskell(2,12,0) && MIN_VERSION_parsec(3,1,13)-{-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TemplateHaskellQuotes #-} #endif- -------------------------------------------------------------------------------- -- | -- Module : Network.URI@@ -151,7 +140,15 @@ import Data.List (unfoldr, isPrefixOf, isSuffixOf) import Numeric (showIntAtBase) +#if __GLASGOW_HASKELL__ >= 800+#ifndef MIN_VERSION_network_uri_static import Language.Haskell.TH.Syntax (Lift(..))+#else+#if MIN_VERSION_network_uri_static(0,1,2)+import Language.Haskell.TH.Syntax (Lift(..))+#endif+#endif+#endif #if !MIN_VERSION_base(4,8,0) import Data.Traversable (sequenceA)@@ -164,8 +161,9 @@ import Data.Generics (Data) #endif -#if __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_base(4,6,0) import GHC.Generics (Generic)+#else #endif ------------------------------------------------------------@@ -187,7 +185,7 @@ , uriPath :: String -- ^ @\/ghc@ , uriQuery :: String -- ^ @?query@ , uriFragment :: String -- ^ @#frag@-#if __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_base(4,6,0) } deriving (Eq, Ord, Typeable, Data, Generic) #else } deriving (Eq, Ord, Typeable, Data)@@ -195,11 +193,11 @@ -- | Add a prefix to a string, unless it already has it. ensurePrefix :: String -> String -> String-ensurePrefix p s = if p `isPrefixOf` s then s else p ++ s+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 p `isSuffixOf` s then s else s ++ p+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.@@ -236,7 +234,7 @@ { uriUserInfo :: String -- ^ @anonymous\@@ , uriRegName :: String -- ^ @www.haskell.org@ , uriPort :: String -- ^ @:42@-#if __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_base(4,6,0) } deriving (Eq, Ord, Show, Typeable, Data, Generic) #else } deriving (Eq, Ord, Show, Typeable, Data)@@ -374,18 +372,17 @@ parseAll parser filename uristr = parse newparser filename uristr where newparser =- do { result <- parser+ do { res <- parser ; eof- ; return result+ ; return res } - ------------------------------------------------------------ -- Predicates ------------------------------------------------------------ uriIsAbsolute :: URI -> Bool-uriIsAbsolute URI{uriScheme = scheme'} = scheme' /= ""+uriIsAbsolute (URI {uriScheme = scheme'}) = scheme' /= "" uriIsRelative :: URI -> Bool uriIsRelative = not . uriIsAbsolute@@ -415,7 +412,7 @@ 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 noticeably faster than a nicer+-- that the explicit case statement was noticably faster than a nicer -- expression in terms of `elem`. isGenDelims :: Char -> Bool isGenDelims c =@@ -430,7 +427,7 @@ _ -> False -- As per https://github.com/haskell/network-uri/pull/46, it was found--- that the explicit case statement was noticeably faster than a nicer+-- that the explicit case statement was noticably faster than a nicer -- expression in terms of `elem`. isSubDelims :: Char -> Bool isSubDelims c =@@ -490,7 +487,7 @@ } } -hierPart :: URIParser (Maybe URIAuth, String)+hierPart :: URIParser ((Maybe URIAuth),String) hierPart = do { _ <- try (string "//") ; ua <- uauthority@@ -547,7 +544,7 @@ ipLiteral :: URIParser String ipLiteral = do { _ <- char '['- ; ua <- ipv6addrz <|> ipvFuture+ ; ua <- ( ipv6addrz <|> ipvFuture ) ; _ <- char ']' ; return $ "[" ++ ua ++ "]" }@@ -840,7 +837,7 @@ } } -relativePart :: URIParser (Maybe URIAuth, String)+relativePart :: URIParser ((Maybe URIAuth),String) relativePart = do { _ <- try (string "//") ; ua <- uauthority@@ -888,7 +885,7 @@ isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') isDigitChar :: Char -> Bool-isDigitChar c = c >= '0' && c <= '9'+isDigitChar c = (c >= '0' && c <= '9') isAlphaNumChar :: Char -> Bool isAlphaNumChar c = isAlphaChar c || isDigitChar c@@ -897,7 +894,7 @@ isHexDigitChar c = isHexDigit c isSchemeChar :: Char -> Bool-isSchemeChar c = isAlphaNumChar c || (c `elem` "+-.")+isSchemeChar c = (isAlphaNumChar c) || (c `elem` "+-.") alphaChar :: URIParser Char alphaChar = satisfy isAlphaChar -- or: Parsec.letter ?@@ -952,17 +949,17 @@ , uriQuery=myquery , uriFragment=myfragment } =- (myscheme++) . uriAuthToString userinfomap myauthority+ (myscheme++) . (uriAuthToString userinfomap myauthority) . (mypath++) . (myquery++) . (myfragment++) -uriAuthToString :: (String->String) -> Maybe URIAuth -> ShowS+uriAuthToString :: (String->String) -> (Maybe URIAuth) -> ShowS uriAuthToString _ Nothing = id -- shows "" uriAuthToString userinfomap (Just URIAuth { uriUserInfo = myuinfo , uriRegName = myregname , uriPort = myport } ) =- ("//"++) . (if null myuinfo then id else (userinfomap myuinfo ++))+ ("//"++) . (if null myuinfo then id else ((userinfomap myuinfo)++)) . (myregname++) . (myport++) @@ -1002,7 +999,7 @@ | otherwise = concatMap (\i -> '%' : myShowHex i "") (utf8EncodeChar c) where myShowHex :: Int -> ShowS- myShowHex n r = case showIntAtBase 16 toChrHex n r of+ myShowHex n r = case showIntAtBase 16 (toChrHex) n r of [] -> "00" [x] -> ['0',x] cs -> cs@@ -1128,7 +1125,7 @@ | isDefined ( uriAuthority ref ) = just_segments ref { uriScheme = uriScheme base } | isDefined ( uriPath ref ) =- if head (uriPath ref) == '/' then+ if (head (uriPath ref) == '/') then just_segments ref { uriScheme = uriScheme base , uriAuthority = uriAuthority base@@ -1273,8 +1270,8 @@ relPathFrom pabs [] = 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 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.@@ -1298,7 +1295,7 @@ 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 (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@@ -1381,15 +1378,22 @@ ------------------------------------------------------------ #if __GLASGOW_HASKELL__ >= 800-deriving instance Lift URI-deriving instance Lift URIAuth+#ifndef MIN_VERSION_network_uri_static+instance Lift URI where+ lift (URI {..}) = [| URI {..} |]++instance Lift URIAuth where+ lift (URIAuth {..}) = [| URIAuth {..} |] #else+#if MIN_VERSION_network_uri_static(0,1,2) instance Lift URI where lift (URI {..}) = [| URI {..} |] instance Lift URIAuth where lift (URIAuth {..}) = [| URIAuth {..} |] #endif+#endif+#endif ------------------------------------------------------------ -- Deprecated functions@@ -1417,12 +1421,9 @@ scheme :: URI -> String scheme = orNull init . uriScheme -runShowS :: ShowS -> String-runShowS s = s ""- {-# DEPRECATED authority "use uriAuthority, and note changed functionality" #-} authority :: URI -> String-authority = dropss . runShowS . uriAuthToString id . uriAuthority+authority = dropss . ($"") . uriAuthToString id . uriAuthority where -- Old-style authority component does not include leading '//' dropss ('/':'/':s) = s
Network/URI/Lens.hs view
@@ -1,10 +1,4 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-}-#if __GLASGOW_HASKELL__ > 704-{-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ > 702-{-# LANGUAGE Trustworthy #-}-#endif -- | Network uri lenses module Network.URI.Lens ( uriRegNameLens@@ -17,9 +11,7 @@ , uriFragmentLens ) where -#if __GLASGOW_HASKELL__ < 710 import Control.Applicative-#endif import Network.URI type Lens' s a = Lens s s a a
Network/URI/Static.hs view
@@ -1,37 +1,24 @@ #if __GLASGOW_HASKELL__ < 800-{-# LANGUAGE RecordWildCards, TemplateHaskell, ViewPatterns #-}+module Network.URI.Static () where #else+ {-# LANGUAGE RecordWildCards, TemplateHaskellQuotes, ViewPatterns #-}-#endif-#if MIN_VERSION_template_haskell(2,12,0)-{-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#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 (unType)+import Language.Haskell.TH.Lib (TExpQ) import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Network.URI (URI(..), parseURI, parseRelativeReference) -#if __GLASGOW_HASKELL__ >= 708-import Language.Haskell.TH.Syntax.Compat (SpliceQ, unTypeCode, toCode)-#endif- -- $setup -- >>> :set -XTemplateHaskell -- >>> :set -XQuasiQuotes@@ -40,7 +27,6 @@ -- 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.@@ -53,23 +39,10 @@ -- <interactive>... -- ... Invalid URI: http://www.google.com/## -- ...-staticURI :: String -- ^ String representation of a URI- -> SpliceQ URI -- ^ URI+staticURI :: String -- ^ String representation of a URI+ -> TExpQ URI -- ^ URI staticURI (parseURI -> Just u) = [|| u ||]-staticURI s = error $ "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' = unTypeCode . toCode . staticURI-#else-staticURI' (parseURI -> Just u) = [| u |]-staticURI' s = fail $ "Invalid URI: " ++ s-#endif+staticURI s = fail $ "Invalid URI: " ++ s -- | 'uri' is a quasi quoter for 'staticURI'. --@@ -83,7 +56,7 @@ -- ... uri :: QuasiQuoter uri = QuasiQuoter {- quoteExp = staticURI',+ quoteExp = fmap unType . staticURI, quotePat = undefined, quoteType = undefined, quoteDec = undefined@@ -93,7 +66,6 @@ -- 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.@@ -106,25 +78,10 @@ -- <interactive>... -- ... Invalid relative reference: http://www.google.com/ -- ...-staticRelativeReference :: String -- ^ String representation of a reference- -> SpliceQ URI -- ^ Refererence+staticRelativeReference :: String -- ^ String representation of a reference+ -> TExpQ URI -- ^ Refererence staticRelativeReference (parseRelativeReference -> Just ref) = [|| ref ||]-staticRelativeReference ref = error $ "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' = unTypeCode . toCode . staticRelativeReference-#else-staticRelativeReference' (parseRelativeReference -> Just ref) = [| ref |]-staticRelativeReference' ref = fail $ "Invalid relative reference: " ++ ref-#endif+staticRelativeReference ref = fail $ "Invalid relative reference: " ++ ref -- | 'relativeReference' is a quasi quoter for 'staticRelativeReference'. --@@ -138,8 +95,10 @@ -- ... relativeReference :: QuasiQuoter relativeReference = QuasiQuoter {- quoteExp = staticRelativeReference',+ quoteExp = fmap unType . staticRelativeReference, quotePat = undefined, quoteType = undefined, quoteDec = undefined }++#endif
network-uri.cabal view
@@ -1,5 +1,5 @@ name: network-uri-version: 2.6.4.2+version: 2.7.0.0 synopsis: URI manipulation description: This package provides facilities for parsing and unparsing URIs, and creating@@ -45,21 +45,7 @@ category: Network build-type: Simple cabal-version: >=1.10-tested-with:- GHC ==9.2.2 - || ==9.0.2- || ==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.4+tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 library exposed-modules:@@ -69,22 +55,15 @@ build-depends: base >= 3 && < 5, deepseq >= 1.1 && < 1.5,- parsec >= 3.1.12.0 && < 3.2,- th-compat >= 0.1.1 && < 1.0- build-depends: template-haskell+ parsec >= 3.0 && < 3.2+ if impl(ghc >= 8.0)+ build-depends: template-haskell default-extensions: CPP, DeriveDataTypeable- if impl(ghc < 7.6)- build-depends: ghc-prim- if impl(ghc >= 7.2)+ if impl(ghc >= 7.6) default-extensions: DeriveGeneric ghc-options: -Wall -fwarn-tabs default-language: Haskell98 - if impl(ghc >= 9.0)- -- these flags may abort compilation with GHC-8.10- -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295- ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode- test-suite uri hs-source-dirs: tests main-is: uri001.hs@@ -94,15 +73,14 @@ base < 5, HUnit, network-uri,- tasty,- tasty-hunit,- tasty-quickcheck,- QuickCheck+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2 ghc-options: -Wall -fwarn-tabs default-language: Haskell98 -benchmark uri-bench+test-suite uri-bench hs-source-dirs: tests main-is: uri-bench.hs type: exitcode-stdio-1.0
tests/uri-bench.hs view
@@ -53,7 +53,4 @@ bench "isReserved a" $ nf isReserved 'a' , bench "isReserved :" $ nf isReserved ':' ]- ,- bench "parseURI" $- nf parseURI "http://foo@bar.quix.gov/flip/flop?a=b&c=d" ]
tests/uri001.hs view
@@ -17,12 +17,20 @@ -- This Module contains test cases for module URI. -- -- To run this test without using Cabal to build the package--- (2013-01-05, instructions tested on macOS):+-- (2013-01-05, instructions tested on MacOS): -- 1. Install Haskell platform--- 2. cabal install tasty tasty-hunit tasty-quickcheck QuickCheck--- 3. ghc -XDeriveDataTypeable -XDeriveGeneric -package QuickCheck -package tasty -package HUnit ../Network/URI.hs uri001.hs+-- 2. cabal install test-framework+-- 3. cabal install test-framework-hunit+-- 4. ghc -XDeriveDataTypeable -D"MIN_VERSION_base(x,y,z)=1" ../Network/URI.hs uri001.hs -- 5. ./uri001 --+-- Previous build instructions:+-- Using GHC, I compile with this command line:+-- ghc --make -fglasgow-exts+-- -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec+-- -o URITest.exe URITest -main-is URITest.main+-- The -i line may need changing for alternative installations.+-- -------------------------------------------------------------------------------- module Main where@@ -46,16 +54,20 @@ import Test.HUnit -import Data.Bits ((.&.), (.|.))-import Data.Char (ord, chr) import Data.Maybe (fromJust) import Data.List (intercalate) import System.IO (openFile, IOMode(WriteMode), hClose)-import qualified Test.Tasty as TF-import qualified Test.Tasty.HUnit as TF-import qualified Test.Tasty.QuickCheck as TF-import Test.QuickCheck ((==>), Property)+import qualified Test.Framework as TF+import qualified Test.Framework.Providers.HUnit as TF+import qualified Test.Framework.Providers.QuickCheck2 as TF +-- Test supplied string for valid URI reference syntax+-- isValidURIRef :: String -> Bool+-- Test supplied string for valid absolute URI reference syntax+-- isAbsoluteURIRef :: String -> Bool+-- Test supplied string for valid absolute URI syntax+-- isAbsoluteURI :: String -> Bool+ data URIType = AbsId -- URI form (absolute, no fragment) | AbsRf -- Absolute URI reference | RelRf -- Relative URI reference@@ -87,7 +99,7 @@ , testEq ("test_isAbsoluteURI:"++u) (isAbsIdT t) (isAbsoluteURI u) ] -testURIRefComponents :: String -> Maybe URI -> String -> Assertion+testURIRefComponents :: String -> (Maybe URI) -> String -> Assertion testURIRefComponents _lab uv us = testEq ("testURIRefComponents:"++us) uv (parseURIReference us) @@ -226,12 +238,19 @@ testURIRef121 = testURIRef AbsId "http://[v9.123.abc;456.def]/" testURIRef122 = testEq "v.future authority" (Just (URIAuth "" "[v9.123.abc;456.def]" ":42"))- (maybe Nothing uriAuthority . parseURI $ "http://[v9.123.abc;456.def]:42/")--- URIs with non-ASCII characters (IRIs), are not supported by Network.URI, but--- captured here for possible future reference when IRI support may be added.+ ((maybe Nothing uriAuthority) . parseURI $ "http://[v9.123.abc;456.def]:42/")+-- URI with non-ASCII characters, fail with Network.HTTP escaping code (see below)+-- Currently not supported by Network.URI, but captured here for possible future reference+-- when IRI support may be added. testURIRef123 = testURIRef AbsId "http://example.com/test123/䡥汬漬⁗潲汤/index.html" testURIRef124 = testURIRef AbsId "http://example.com/test124/Москва/index.html" +-- From report by Alexander Ivanov:+-- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead+-- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤"+-- should return "Москва"+-- print $ urlDecode $ urlEncode "Москва"+ testURIRefSuite = TF.testGroup "Test URIrefs" testURIRefList testURIRefList = [ TF.testCase "testURIRef001" testURIRef001@@ -374,7 +393,15 @@ } ) "http://user:pass@example.org:99/aaa/bbb?qqq#fff" testComponent02 = testURIRefComponents "testComponent02"- Nothing+ ( const Nothing+ ( Just $ URI+ { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = "aaa/bbb"+ , uriQuery = ""+ , uriFragment = ""+ } )+ ) "http://user:pass@example.org:99aaa/bbb" testComponent03 = testURIRefComponents "testComponent03" ( Just $ URI@@ -385,7 +412,7 @@ , uriFragment = "" } ) "http://user:pass@example.org:99?aaa/bbb"-testComponent04 = testURIRefComponents "testComponent04"+testComponent04 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "http:" , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")@@ -394,35 +421,8 @@ , uriFragment = "#aaa/bbb" } ) "http://user:pass@example.org:99#aaa/bbb"-testComponent05 = testURIRefComponents "testComponent05"- ( Just $ URI- { uriScheme = "news:"- , uriAuthority = Nothing- , uriPath = "comp.infosystems.www.servers.unix"- , uriQuery = ""- , uriFragment = ""- } )- "news:comp.infosystems.www.servers.unix"-testComponent06 = testURIRefComponents "testComponent06"- ( Just $ URI- { uriScheme = "mailto:"- , uriAuthority = Nothing- , uriPath = "John.Doe@example.com"- , uriQuery = ""- , uriFragment = ""- } )- "mailto:John.Doe@example.com"-testComponent07 = testURIRefComponents "testComponent07"- ( Just $ URI- { uriScheme = "tel:"- , uriAuthority = Nothing- , uriPath = "+1-816-555-1212"- , uriQuery = ""- , uriFragment = ""- } )- "tel:+1-816-555-1212" -- These test cases contributed by Robert Buck (mathworks.com)-testComponent11 = testURIRefComponents "testComponent11"+testComponent11 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "about:" , uriAuthority = Nothing@@ -431,7 +431,7 @@ , uriFragment = "" } ) "about:"-testComponent12 = testURIRefComponents "testComponent12"+testComponent12 = testURIRefComponents "testComponent03" ( Just $ URI { uriScheme = "file:" , uriAuthority = Just (URIAuth "" "windowsauth" "")@@ -441,14 +441,11 @@ } ) "file://windowsauth/d$" -testComponentSuite = TF.testGroup "Test URIrefs"+testComponentSuite = TF.testGroup "Test URIrefs" $ [ TF.testCase "testComponent01" testComponent01 , TF.testCase "testComponent02" testComponent02 , TF.testCase "testComponent03" testComponent03 , TF.testCase "testComponent04" testComponent04- , TF.testCase "testComponent05" testComponent05- , TF.testCase "testComponent06" testComponent06- , TF.testCase "testComponent07" testComponent07 , TF.testCase "testComponent11" testComponent11 , TF.testCase "testComponent12" testComponent12 ]@@ -488,8 +485,8 @@ testRelative :: String -> String -> String -> String -> Assertion testRelative label base uabs urel = sequence_ [- testRelSplit (label++"(rel)") base uabs urel,- testRelJoin (label++"(abs)") base urel uabs+ (testRelSplit (label++"(rel)") base uabs urel),+ (testRelJoin (label++"(abs)") base urel uabs) ] testRelative01 = testRelative "testRelative01"@@ -627,7 +624,7 @@ "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" -- Apparently, TimBL prefers the following way to 41, 42 above -- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html--- He also notes that there may be different relative functions+-- He also notes that there may be different relative fuctions -- that satisfy the basic equivalence axiom: -- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html testRelative56 = testRelative "testRelative56"@@ -674,9 +671,9 @@ "foo:bar" "http://example/a/b#c/../d" "http://example/a/b#c/../d" {- These (78-81) are some awkward test cases thrown up by a question on the URI list: http://lists.w3.org/Archives/Public/uri/2005Jul/0013- Note that RFC 3986 discards path segments after the final '/' only when merging two- paths - otherwise the final segment in the base URI is maintained. This leads to- difficulty in constructing a reversible relativeTo/relativeFrom pair of functions.+ Mote that RFC 3986 discards path segents after the final '/' only when merging two+ paths - otherwise the final segment in the base URI is mnaintained. This leads to+ difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions. -} testRelative78 = testRelative "testRelative78" "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml"@@ -1074,7 +1071,7 @@ testShowURI01 = testEq "testShowURI01" "" (show nullURI) testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI)-testShowURI03 = testEq "testShowURI03" ts03str (uriToString id ts02URI "")+testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "") testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI) testShowURI = TF.testGroup "testShowURI"@@ -1111,40 +1108,12 @@ "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC" (escapeURIString isUnescapedInURIComponent "helloø©日本") --- From report by Alexander Ivanov:--- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead--- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤"-assertUnescapeEscapeInverse lab x = testEq lab x (unEscapeString $ escapeURIString isUnescapedInURIComponent x)-testUnescapeEscape01 = assertUnescapeEscapeInverse "testUnescapeEscape01" " 䡥汬漬⁗潲汤"--- should return "Москва"--- print $ urlDecode $ urlEncode "Москва"-testUnescapeEscape02 = assertUnescapeEscapeInverse "testUnescapeEscape02" "Москва"--validUnicodePoint :: Char -> Bool-validUnicodePoint c =- case ord c of- a | a >= 0xFDD0 && a <= 0xFDEF -> False- a | a .&. 0xFFFE == 0xFFFE -> False- _ -> True--propEscapeUnEscapeLoop :: String -> Property-propEscapeUnEscapeLoop s =- all validUnicodePoint s ==>- s == (unEscapeString $! escaped)+propEscapeUnEscapeLoop :: String -> Bool+propEscapeUnEscapeLoop s = s == (unEscapeString $! escaped) where escaped = escapeURIString (const False) s {-# NOINLINE escaped #-} --- Test some Unicode chars high in the Basic Multilingual Plane.-propEscapeUnEscapeLoopHiChars :: Char -> Property-propEscapeUnEscapeLoopHiChars c' =- let c = chr $ ord c' .|. 0xff00 in- validUnicodePoint c ==>- [c] == (unEscapeString $! escaped c)- where- escaped c = escapeURIString (const False) [c]- {-# NOINLINE escaped #-}- testEscapeURIString = TF.testGroup "testEscapeURIString" [ TF.testCase "testEscapeURIString01" testEscapeURIString01 , TF.testCase "testEscapeURIString02" testEscapeURIString02@@ -1152,10 +1121,7 @@ , TF.testCase "testEscapeURIString04" testEscapeURIString04 , TF.testCase "testEscapeURIString05" testEscapeURIString05 , TF.testCase "testEscapeURIString06" testEscapeURIString06- , TF.testCase "testUnescapeEscape01" testUnescapeEscape01- , TF.testCase "testUnescapeEscape02" testUnescapeEscape02 , TF.testProperty "propEscapeUnEscapeLoop" propEscapeUnEscapeLoop- , TF.testProperty "propEscapeUnEscapeLoopHiChars" propEscapeUnEscapeLoopHiChars ] -- URI string normalization tests@@ -1210,17 +1176,17 @@ testRelativeTo01 = testEq "testRelativeTo01" "http://bar.org/foo" (show $- fromJust (parseURIReference "foo") `relativeTo` trbase)+ (fromJust $ parseURIReference "foo") `relativeTo` trbase) testRelativeTo02 = testEq "testRelativeTo02" "http:foo" (show $- fromJust (parseURIReference "http:foo") `relativeTo` trbase)+ (fromJust $ parseURIReference "http:foo") `relativeTo` trbase) testRelativeTo03 = testEq "testRelativeTo03" "http://bar.org/foo" (show $- fromJust (parseURIReference "http:foo") `nonStrictRelativeTo` trbase)+ (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase) testRelativeTo = TF.testGroup "testRelativeTo" [ TF.testCase "testRelativeTo01" testRelativeTo01@@ -1364,7 +1330,7 @@ ] -- Full test suite-allTests = TF.testGroup "all"+allTests = [ testURIRefSuite , testComponentSuite , testRelativeSuite@@ -1444,3 +1410,94 @@ -------------------------------------------------------------------------------- -- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $ -- $Author: gklyne $+-- $Revision: 1.8 $+-- $Log: URITest.hs,v $+-- Revision 1.81 2012/08/01 aaronfriel+-- Added additional test case for the "xip.io" service style URLs and absolute URLs prefixed with ipv4 addresses.+--+-- Revision 1.8 2005/07/19 22:01:27 gklyne+-- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19. The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo.+--+-- Revision 1.7 2005/06/06 16:31:44 gklyne+-- Added two new test cases.+--+-- Revision 1.6 2005/05/31 17:18:36 gklyne+-- Added some additional test cases triggered by URI-list discussions.+--+-- Revision 1.5 2005/04/07 11:09:37 gklyne+-- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI')+--+-- Revision 1.4 2005/04/05 12:47:32 gklyne+-- Added test case.+-- Changed module name, now requires GHC -main-is to compile.+-- All tests run OK with GHC 6.4 on MS-Windows.+--+-- Revision 1.3 2004/11/05 17:29:09 gklyne+-- Changed password-obscuring logic to reflect late change in revised URI+-- specification (password "anonymous" is no longer a special case).+-- Updated URI test module to use function 'escapeURIString'.+-- (Should unEscapeString be similarly updated?)+--+-- Revision 1.2 2004/10/27 13:06:55 gklyne+-- Updated URI module function names per:+-- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html+-- Added test cases to give better covereage of module functions.+--+-- Revision 1.1 2004/10/14 16:11:30 gklyne+-- Add URI unit test to cvs.haskell.org repository+--+-- Revision 1.17 2004/10/14 11:51:09 graham+-- Confirm that URITest runs with GHC.+-- Fix up some comments and other minor details.+--+-- Revision 1.16 2004/10/14 11:45:30 graham+-- Use moduke name main for GHC 6.2+--+-- Revision 1.15 2004/08/11 11:07:39 graham+-- Add new test case.+--+-- Revision 1.14 2004/06/30 11:35:27 graham+-- Update URI code to use hierarchical libraries for Parsec and Network.+--+-- Revision 1.13 2004/06/22 16:19:16 graham+-- New URI test case added.+--+-- Revision 1.12 2004/04/21 15:13:29 graham+-- Add test case+--+-- Revision 1.11 2004/04/21 14:54:05 graham+-- Fix up some tests+--+-- Revision 1.10 2004/04/20 14:54:13 graham+-- Fix up test cases related to port number in authority,+-- and add some more URI decomposition tests.+--+-- Revision 1.9 2004/04/07 15:06:17 graham+-- Add extra test case+-- Revise syntax in line with changes to RFC2396bis+--+-- Revision 1.8 2004/03/17 14:34:58 graham+-- Add Network.HTTP files to CVS+--+-- Revision 1.7 2004/03/16 14:19:38 graham+-- Change licence to BSD style; add nullURI definition; new test cases.+--+-- Revision 1.6 2004/02/20 12:12:00 graham+-- Add URI normalization functions+--+-- Revision 1.5 2004/02/19 23:19:35 graham+-- Network.URI module passes all test cases+--+-- Revision 1.4 2004/02/17 20:06:02 graham+-- Revised URI parser to reflect latest RFC2396bis (-04)+--+-- Revision 1.3 2004/02/11 14:32:14 graham+-- Added work-in-progress notes.+--+-- Revision 1.2 2004/02/02 14:00:39 graham+-- Fix optional host name in URI. Add test cases.+--+-- Revision 1.1 2004/01/27 21:13:45 graham+-- New URI module and test suite added,+-- implementing the GHC Network.URI interface.+--