modern-uri 0.3.1.0 → 0.3.2.0
raw patch · 8 files changed
+167/−78 lines, 8 filesdep ~basedep ~megaparsecdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, megaparsec, template-haskell
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- README.md +14/−18
- Text/URI.hs +5/−1
- Text/URI/QQ.hs +13/−2
- Text/URI/Render.hs +3/−8
- modern-uri.cabal +11/−12
- tests/Text/QQSpec.hs +109/−36
- tests/Text/URISpec.hs +5/−1
CHANGELOG.md view
@@ -1,3 +1,10 @@+## Modern URI 0.3.2.0++* Quasi-quoters from `Text.URI.QQ` now can be used in pattern context when+ the `ViewPatterns` extension is enabled.++* Dropped support for GHC 8.2.x.+ ## Modern URI 0.3.1.0 * Dropped support for GHC 8.0 and 7.10.
README.md view
@@ -14,11 +14,11 @@ The `modern-uri` package features: -* Correct by construction `URI` data type. Correctness is ensured by- guaranteeing that every sub-component of the `URI` record is by itself+* Correct by construction `URI` data type. The correctness is ensured by+ making sure that every sub-component of the `URI` record is by itself cannot be invalid. This boils down to careful use of types and a set of- smart constructors for things like scheme, host, etc.-* Textual components in the `URI` data type represented as `Text` rather+ smart constructors.+* Textual components in the `URI` data type are represented as `Text` rather than `ByteString`, because they are percent-decoded and so they can contain characters outside of ASCII range (i.e. Unicode). This allows for easier manipulation of `URI`s, while encoding and decoding headaches are@@ -82,10 +82,9 @@ In this library we use quite a few refined text values. They only can be constructed by using smart constructors like `mkScheme :: MonadThrow m => Text -> m (RText 'Scheme)`. For example, if argument to `mkScheme` is not a-valid scheme, an exception will be thrown. Actually this is not necessarily-so because there are pure monads that are instances of the `MonadThrow` type-class, and so the smart constructors may be used in e.g. the `Maybe` monad-as well.+valid scheme, an exception will be thrown. Note that monads such as `Maybe`+are also instances of the `MonadThrow` type class, and so the smart+constructors may be used in pure setting as well. There is a smart constructor that can make an entire `URI` too, it's called (unsurprisingly) `mkURI`:@@ -105,8 +104,8 @@ , uriFragment = Nothing } ``` -If argument of `mkURI` is not a valid URI, then an exception will be thrown.-The exception will contain full context and the actual parse error.+If the argument of `mkURI` is not a valid URI, then an exception will be+thrown. The exception will contain full context and the actual parse error. If some refined text value or `URI` is known statically at compile time, we can use Template Haskell, namely the “quasi quotes” feature. To do so import@@ -132,16 +131,13 @@ Note how the value returned by the `url` quasi quote is pure, its construction cannot fail because when there is an invalid URI inside the-quote it's a compilation error.--The `Text.URI.QQ` module has quasi quoters for scheme, host, and other-things, check it out.+quote it's a compilation error. The `Text.URI.QQ` module has quasi-quoters+for scheme, host, and other components. -Finally the package provides two Megaparsec parsers: `parser` and+Finally, the package provides two Megaparsec parsers: `parser` and `parserBs`. The first works on strict `Text`, while other one works on strict `ByteString`s. You can use the parsers in a bigger Megaparsec parser-to parse `URI`s. To get started with Megaparsec, see [its Hackage-page](https://hackage.haskell.org/package/megaparsec).+to parse `URI`s. ### Inspection and manipulation @@ -211,7 +207,7 @@ Issues, bugs, and questions may be reported in [the GitHub issue tracker for this project](https://github.com/mrkkrp/modern-uri/issues). -Pull requests are also welcome and will be reviewed quickly.+Pull requests are also welcome. ## License
Text/URI.hs view
@@ -20,6 +20,7 @@ -- "Text.URI.QQ" for quasi-quoters for compile-time validation of URIs and -- refined text components. +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}@@ -67,12 +68,15 @@ import Data.Either (isLeft) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isJust, isNothing)-import Data.Semigroup ((<>)) import Text.URI.Parser.ByteString import Text.URI.Parser.Text import Text.URI.Render import Text.URI.Types import qualified Data.List.NonEmpty as NE++#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif -- | The empty 'URI'. --
Text/URI/QQ.hs view
@@ -9,6 +9,10 @@ -- -- Quasi-quoters for compile-time construction of URIs and refined text -- values.+--+-- All of the quasi-quoters in this module can be used in an expression+-- context. With the @ViewPatterns@ language extension enabled, they may+-- also be used in a pattern context (since /0.3.2.0/). {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}@@ -27,6 +31,7 @@ import Control.Exception (SomeException, Exception (..)) import Data.Text (Text)+import Language.Haskell.TH.Lib (appE, viewP) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax (Lift (..)) import Text.URI.Parser.Text@@ -82,13 +87,19 @@ -- Helpers -- | Lift a smart constructor for refined text into a 'QuasiQuoter'.+--+-- The 'Eq' constraint is technically unnecessary here, but the pattern+-- generated by 'quotePat' will only work if the type has an 'Eq' instance. -liftToQQ :: Lift a => (Text -> Either SomeException a) -> QuasiQuoter+liftToQQ :: (Eq a, Lift a) => (Text -> Either SomeException a) -> QuasiQuoter liftToQQ f = QuasiQuoter { quoteExp = \str -> case f (T.pack str) of Left err -> fail (displayException err) Right x -> lift x- , quotePat = error "This usage is not supported"+ , quotePat = \str ->+ case f (T.pack str) of+ Left err -> fail (displayException err)+ Right x -> appE [|(==)|] (lift x) `viewP` [p|True|] , quoteType = error "This usage is not supported" , quoteDec = error "This usage is not supported" }
Text/URI/Render.hs view
@@ -9,7 +9,6 @@ -- -- URI renders, an internal module. -{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}@@ -32,11 +31,11 @@ import Data.ByteString (ByteString) import Data.Char (chr, intToDigit)+import Data.Kind (Type) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..)) import Data.Proxy import Data.Reflection-import Data.Semigroup (Semigroup) import Data.String (IsString (..)) import Data.Tagged import Data.Text (Text)@@ -54,10 +53,6 @@ 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 @@ -115,7 +110,7 @@ equip :: forall b. (Word -> b) -> (forall l. RLabel l => RText l -> b)- -> (forall (s :: *). Reifies s (Renders b) => Tagged s b)+ -> (forall (s :: Type). Reifies s (Renders b) => Tagged s b) -> b equip rWord rText f = reify Renders {..} $ \(Proxy :: Proxy s') -> unTagged (f :: Tagged s' b)@@ -133,7 +128,7 @@ ---------------------------------------------------------------------------- -- Generic render -type Render a b = forall (s :: *).+type Render a b = forall (s :: Type). (Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) => a -> Tagged s b
modern-uri.cabal view
@@ -1,7 +1,7 @@ name: modern-uri-version: 0.3.1.0+version: 0.3.2.0 cabal-version: 1.18-tested-with: GHC==8.2.2, GHC==8.4.4, GHC==8.6.5+tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -26,18 +26,18 @@ library build-depends: QuickCheck >= 2.4 && < 3.0- , base >= 4.10 && < 5.0+ , base >= 4.11 && < 5.0 , bytestring >= 0.2 && < 0.11 , containers >= 0.5 && < 0.7 , contravariant >= 1.3 && < 2.0 , deepseq >= 1.3 && < 1.5 , exceptions >= 0.6 && < 0.11- , megaparsec >= 7.0 && < 8.0+ , megaparsec >= 7.0 && < 9.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.15+ , template-haskell >= 2.10 && < 2.16 , text >= 0.2 && < 1.3 exposed-modules: Text.URI , Text.URI.Lens@@ -56,7 +56,6 @@ -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances- -Wnoncanonical-monadfail-instances default-language: Haskell2010 test-suite tests@@ -64,11 +63,11 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.4 && < 3.0- , base >= 4.10 && < 5.0+ , base >= 4.11 && < 5.0 , bytestring >= 0.2 && < 0.11 , hspec >= 2.0 && < 3.0 , hspec-megaparsec >= 2.0 && < 3.0- , megaparsec >= 7.0 && < 8.0+ , megaparsec >= 7.0 && < 9.0 , modern-uri , text >= 0.2 && < 1.3 build-tools: hspec-discover >= 2.0 && < 3.0@@ -84,10 +83,10 @@ main-is: Main.hs hs-source-dirs: bench/speed type: exitcode-stdio-1.0- build-depends: base >= 4.10 && < 5.0+ build-depends: base >= 4.11 && < 5.0 , bytestring >= 0.2 && < 0.11 , criterion >= 0.6.2.1 && < 1.6- , megaparsec >= 7.0 && < 8.0+ , megaparsec >= 7.0 && < 9.0 , modern-uri , text >= 0.2 && < 1.3 if flag(dev)@@ -100,10 +99,10 @@ main-is: Main.hs hs-source-dirs: bench/memory type: exitcode-stdio-1.0- build-depends: base >= 4.10 && < 5.0+ build-depends: base >= 4.11 && < 5.0 , bytestring >= 0.2 && < 0.11 , deepseq >= 1.3 && < 1.5- , megaparsec >= 7.0 && < 8.0+ , megaparsec >= 7.0 && < 9.0 , modern-uri , text >= 0.2 && < 1.3 , weigh >= 0.0.4
tests/Text/QQSpec.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-} module Text.QQSpec (spec) where @@ -10,39 +12,110 @@ spec :: Spec spec = do- describe "uri" . it "works" $ do- let uriQQ = [QQ.uri|https://markkarpov.com|]- uri <- mkURI "https://markkarpov.com"- uriQQ `shouldBe` uri- describe "scheme" . it "works" $ do- let schemeQQ = [QQ.scheme|https|]- scheme <- mkScheme "https"- schemeQQ `shouldBe` scheme- describe "host" . it "works" $ do- let hostQQ = [QQ.host|markkarpov.com|]- host <- mkHost "markkarpov.com"- hostQQ `shouldBe` host- describe "username" . it "works" $ do- let usernameQQ = [QQ.username|mark|]- username <- mkUsername "mark"- usernameQQ `shouldBe` username- describe "password" . it "works" $ do- let passwordQQ = [QQ.password|secret123|]- password <- mkPassword "secret123"- passwordQQ `shouldBe` password- describe "pathPiece" . it "works" $ do- let pathPieceQQ = [QQ.pathPiece|foo|]- pathPiece <- mkPathPiece "foo"- pathPieceQQ `shouldBe` pathPiece- describe "queryKey" . it "works" $ do- let queryKeyQQ = [QQ.queryKey|foo|]- queryKey <- mkQueryKey "foo"- queryKeyQQ `shouldBe` queryKey- describe "queryValue" . it "works" $ do- let queryValueQQ = [QQ.queryValue|bar|]- queryValue <- mkQueryKey "bar"- queryValueQQ `shouldBe` queryValue- describe "fragment" . it "works" $ do- let fragmentQQ = [QQ.fragment|frag|]- fragment <- mkQueryKey "frag"- fragmentQQ `shouldBe` fragment++ describe "uri" $ do+ it "works as an expression" $ do+ let uriQQ = [QQ.uri|https://markkarpov.com|]+ uri <- mkURI "https://markkarpov.com"+ uriQQ `shouldBe` uri+ it "works as a pattern" $+ mkURI "https://markkarpov.com" >>= \case+ [QQ.uri|https://haskell.org|] -> shouldNotMatch+ [QQ.uri|https://markkarpov.com|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "scheme" $ do+ it "works as an expression" $ do+ let schemeQQ = [QQ.scheme|https|]+ scheme <- mkScheme "https"+ schemeQQ `shouldBe` scheme+ it "works as a pattern" $+ mkScheme "https" >>= \case+ [QQ.scheme|ftp|] -> shouldNotMatch+ [QQ.scheme|https|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "host" $ do+ it "works as an expression" $ do+ let hostQQ = [QQ.host|markkarpov.com|]+ host <- mkHost "markkarpov.com"+ hostQQ `shouldBe` host+ it "works as a pattern" $ do+ mkHost "markkarpov.com" >>= \case+ [QQ.host|haskell.org|] -> shouldNotMatch+ [QQ.host|markkarpov.com|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "username" $ do+ it "works as an expression" $ do+ let usernameQQ = [QQ.username|mark|]+ username <- mkUsername "mark"+ usernameQQ `shouldBe` username+ it "works as a pattern" $ do+ mkUsername "mark" >>= \case+ [QQ.username|chris|] -> shouldNotMatch+ [QQ.username|mark|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "password" $ do+ it "works as an expression" $ do+ let passwordQQ = [QQ.password|secret123|]+ password <- mkPassword "secret123"+ passwordQQ `shouldBe` password+ it "works as a pattern" $ do+ mkPassword "secret123" >>= \case+ [QQ.password|secretXYZ|] -> shouldNotMatch+ [QQ.password|secret123|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "pathPiece" $ do+ it "works as an expression" $ do+ let pathPieceQQ = [QQ.pathPiece|foo|]+ pathPiece <- mkPathPiece "foo"+ pathPieceQQ `shouldBe` pathPiece+ it "works as a pattern" $ do+ mkPathPiece "foo" >>= \case+ [QQ.pathPiece|bar|] -> shouldNotMatch+ [QQ.pathPiece|foo|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "queryKey" $ do+ it "works as an expression" $ do+ let queryKeyQQ = [QQ.queryKey|foo|]+ queryKey <- mkQueryKey "foo"+ queryKeyQQ `shouldBe` queryKey+ it "works as a pattern" $ do+ mkQueryKey "foo" >>= \case+ [QQ.queryKey|xyz|] -> shouldNotMatch+ [QQ.queryKey|foo|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "queryValue" $ do+ it "works as an expression" $ do+ let queryValueQQ = [QQ.queryValue|bar|]+ queryValue <- mkQueryValue "bar"+ queryValueQQ `shouldBe` queryValue+ it "works as a pattern" $ do+ mkQueryValue "bar" >>= \case+ [QQ.queryValue|xyz|] -> shouldNotMatch+ [QQ.queryValue|bar|] -> return ()+ _ -> shouldHaveMatchedAlready++ describe "fragment" $ do+ it "works as an expression" $ do+ let fragmentQQ = [QQ.fragment|frag|]+ fragment <- mkFragment "frag"+ fragmentQQ `shouldBe` fragment+ it "works as a pattern" $ do+ mkFragment "frag" >>= \case+ [QQ.fragment|xyz|] -> shouldNotMatch+ [QQ.fragment|frag|] -> return ()+ _ -> shouldHaveMatchedAlready++shouldNotMatch :: Expectation+shouldNotMatch = expectationFailure+ "First case should not have matched, but did"++shouldHaveMatchedAlready :: Expectation+shouldHaveMatchedAlready = expectationFailure+ "Second case should have matched, but didn't"
tests/Text/URISpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -7,7 +8,6 @@ import Data.ByteString (ByteString) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isNothing, isJust)-import Data.Monoid ((<>)) import Data.String (IsString (..)) import Data.Text (Text) import Data.Void@@ -19,6 +19,10 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Text.URI as URI++#if !MIN_VERSION_base(4,13,0)+import Data.Semigroup ((<>))+#endif instance Arbitrary Text where arbitrary = T.pack <$> arbitrary