modern-uri 0.2.1.0 → 0.2.2.0
raw patch · 8 files changed
+80/−28 lines, 8 filesdep ~containersdep ~template-haskell
Dependency ranges changed: containers, template-haskell
Files
- CHANGELOG.md +8/−0
- README.md +0/−1
- Text/URI/Parser/ByteString.hs +8/−5
- Text/URI/Parser/Text/Utils.hs +8/−5
- Text/URI/Render.hs +6/−2
- Text/URI/Types.hs +3/−4
- modern-uri.cabal +13/−6
- tests/Text/URISpec.hs +34/−5
CHANGELOG.md view
@@ -1,3 +1,11 @@+## Modern URI 0.2.2.0++* Removed a potentially overlapping instance `Arbitrary (NonEmpty (RText+ 'PathPiece))`.++* Fixed a bug that made it impossible to have empty host names. This allows+ us to parse URIs like `file:///etc/hosts`.+ ## Modern URI 0.2.1.0 * Added `emptyURI`—`URI` value representing the empty URI.
README.md view
@@ -5,7 +5,6 @@ [](http://stackage.org/nightly/package/modern-uri) [](http://stackage.org/lts/package/modern-uri) [](https://travis-ci.org/mrkkrp/modern-uri)-[](https://coveralls.io/github/mrkkrp/modern-uri?branch=master) This is a modern library for working with URIs in Haskell as per RFC 3986:
Text/URI/Parser/ByteString.hs view
@@ -128,11 +128,14 @@ skipSome (unreservedChar <|> subDelimChar <|> char 58) regName = fmap (intercalate [46]) . flip sepBy1 (char 46) $ do let ch = percentEncChar <|> asciiAlphaNumChar- x <- ch- let r = ch <|> try- (char 45 <* (lookAhead . try) (ch <|> char 45))- xs <- many r- return (x:xs)+ mx <- optional ch+ case mx of+ Nothing -> return []+ Just x -> do+ let r = ch <|> try+ (char 45 <* (lookAhead . try) (ch <|> char 45))+ xs <- many r+ return (x:xs) pUserInfo :: MonadParsec e ByteString m => m UserInfo pUserInfo = try $ do
Text/URI/Parser/Text/Utils.hs view
@@ -90,11 +90,14 @@ if pe then percentEncChar <|> asciiAlphaNumChar else alphaNumChar- x <- ch- let r = ch <|> try- (char '-' <* (lookAhead . try) (ch <|> char '-'))- xs <- many r- return (x:xs)+ mx <- optional ch+ case mx of+ Nothing -> return ""+ Just x -> do+ let r = ch <|> try+ (char '-' <* (lookAhead . try) (ch <|> char '-'))+ xs <- many r+ return (x:xs) {-# INLINEABLE pHost #-} -- | Parse an ASCII alpha character.
Text/URI/Render.hs view
@@ -9,6 +9,7 @@ -- -- URI renders, an internal module. +{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -33,7 +34,6 @@ import Data.Char (chr, intToDigit) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid import Data.Proxy import Data.Reflection import Data.Semigroup (Semigroup)@@ -54,6 +54,10 @@ import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Builder.Int as TLB +#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+ ---------------------------------------------------------------------------- -- High-level wrappers @@ -264,7 +268,7 @@ instance RLabel 'Host where needsNoEscaping Proxy x = isUnreserved x || isDelim x- skipEscaping Proxy x = T.head x == '['+ skipEscaping Proxy x = T.take 1 x == "[" instance RLabel 'Username where needsNoEscaping Proxy x = isUnreserved x || isDelim x
Text/URI/Types.hs view
@@ -339,9 +339,6 @@ instance Arbitrary (RText 'PathPiece) where arbitrary = arbText' mkPathPiece -instance Arbitrary (NonEmpty (RText 'PathPiece)) where- arbitrary = (:|) <$> arbitrary <*> arbitrary- -- | Lift a 'Text' value into @'RText 'QueryKey'@. -- -- This smart constructor does not perform any sort of normalization.@@ -437,7 +434,9 @@ arbHost = fromJust . mkHost . T.pack <$> frequency [ (1, ipLiteral) , (2, ipv4Address)- , (4, regName) ]+ , (4, regName)+ , (1, return "")+ ] where ipLiteral = do xs <- oneof [ipv6Address, ipvFuture]
modern-uri.cabal view
@@ -1,7 +1,7 @@ name: modern-uri-version: 0.2.1.0-cabal-version: >= 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2+version: 0.2.2.0+cabal-version: 1.18+tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -31,13 +31,13 @@ , containers >= 0.5 && < 0.6 , contravariant >= 1.3 && < 2.0 , deepseq >= 1.3 && < 1.5- , exceptions >= 0.6 && < 0.9+ , exceptions >= 0.6 && < 0.11 , megaparsec >= 6.0 && < 7.0 , mtl >= 2.0 && < 3.0 , profunctors >= 5.2.1 && < 6.0 , reflection >= 2.0 && < 3.0 , tagged >= 0.8 && < 0.9- , template-haskell >= 2.10 && < 2.13+ , template-haskell >= 2.10 && < 2.14 , text >= 0.2 && < 1.3 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*@@ -53,6 +53,12 @@ ghc-options: -Wall -Werror else ghc-options: -O2 -Wall+ if flag(dev) && impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances default-language: Haskell2010 test-suite tests@@ -67,6 +73,7 @@ , megaparsec >= 6.0 && < 7.0 , modern-uri , text >= 0.2 && < 1.3+ build-tools: hspec-discover >= 2.0 && < 3.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* other-modules: Text.URISpec@@ -82,7 +89,7 @@ type: exitcode-stdio-1.0 build-depends: base >= 4.7 && < 5.0 , bytestring >= 0.2 && < 0.11- , criterion >= 0.6.2.1 && < 1.4+ , criterion >= 0.6.2.1 && < 1.6 , megaparsec >= 6.0 && < 7.0 , modern-uri , text >= 0.2 && < 1.3
tests/Text/URISpec.hs view
@@ -5,7 +5,7 @@ import Control.Monad import Data.ByteString (ByteString)-import Data.List.NonEmpty (fromList)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isNothing, isJust) import Data.Monoid ((<>)) import Data.String (IsString (..))@@ -16,6 +16,7 @@ import Test.QuickCheck import Text.Megaparsec import Text.URI (URI (..), RTextException (..), RTextLabel (..))+import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Text.URI as URI @@ -106,6 +107,7 @@ URI.mkHost "github.com" `shouldRText` "github.com" URI.mkHost "foo.example.com" `shouldRText` "foo.example.com" URI.mkHost "юникод.рф" `shouldRText` "юникод.рф"+ URI.mkHost "" `shouldRText` "" it "rejects invalid hosts" $ do URI.mkHost "_something" `shouldThrow` (== RTextException Host "_something")@@ -170,11 +172,19 @@ let s = "https://юникод.рф" parse urip "" s `shouldFailWith` err (posN 8 s) (mconcat [ utok 'ю'+ , etok '#' , etok '%'+ , etok '.'+ , etok '/'+ , etok ':'+ , etok '?' , etok '[' , elabel "ASCII alpha-numeric character" , elabel "integer"- , elabel "username" ] )+ , elabel "username"+ , elabel "path piece"+ , eeof+ ] ) it "rejects Unicode in path" $ do let s = "https://github.com/марк" parse urip "" s `shouldFailWith` err (posN 19 s) (mconcat@@ -184,6 +194,23 @@ , etok '?' , elabel "path piece" , eeof ] )+ it "parses URIs with empty authority" $ do+ scheme <- URI.mkScheme "file"+ ppetc <- URI.mkPathPiece "etc"+ pphosts <- URI.mkPathPiece "hosts"+ host <- URI.mkHost ""+ let s = "file:///etc/hosts"+ parse urip "" s `shouldParse` URI+ { uriScheme = Just scheme+ , uriAuthority = Right URI.Authority+ { URI.authUserInfo = Nothing+ , URI.authHost = host+ , URI.authPort = Nothing+ }+ , uriPath = Just (False, ppetc :| [pphosts])+ , uriQuery = []+ , uriFragment = Nothing+ } describe "render" $ do it "sort of works" $ fmap URI.render mkTestURI `shouldReturn` testURI@@ -250,10 +277,12 @@ { URI.uiUsername = username , URI.uiPassword = Just password } , URI.authHost = host- , URI.authPort = Just 443 }- , uriPath = Just (False, fromList path)+ , URI.authPort = Just 443+ }+ , uriPath = Just (False, NE.fromList path) , uriQuery = [URI.QueryParam k v]- , uriFragment = Just fragment }+ , uriFragment = Just fragment+ } -- | Polymorphic textual rendering of the 'URI' generated by 'mkTestURI'.