modern-uri 0.3.0.1 → 0.3.1.0
raw patch · 14 files changed
+131/−62 lines, 14 filesdep −semigroupsdep ~basedep ~megaparsec
Dependencies removed: semigroups
Dependency ranges changed: base, megaparsec
Files
- CHANGELOG.md +7/−0
- LICENSE.md +1/−1
- README.md +1/−1
- Text/URI.hs +1/−1
- Text/URI/Lens.hs +1/−1
- Text/URI/Parser/ByteString.hs +1/−6
- Text/URI/Parser/Text.hs +1/−6
- Text/URI/Parser/Text/Utils.hs +1/−1
- Text/URI/QQ.hs +4/−20
- Text/URI/Render.hs +1/−1
- Text/URI/Types.hs +38/−2
- modern-uri.cabal +10/−13
- tests/Text/QQSpec.hs +48/−0
- tests/Text/URISpec.hs +16/−9
CHANGELOG.md view
@@ -1,3 +1,10 @@+## Modern URI 0.3.1.0++* Dropped support for GHC 8.0 and 7.10.++* Added Template Haskell `Lift` instance for the `URI` type and its+ sub-components.+ ## Modern URI 0.3.0.1 * Allow superfluous `&` right after question sign in query parameters.
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2017–2018 Mark Karpov+Copyright © 2017–present Mark Karpov All rights reserved.
README.md view
@@ -215,6 +215,6 @@ ## License -Copyright © 2017–2018 Mark Karpov+Copyright © 2017–present Mark Karpov Distributed under BSD 3 clause license.
Text/URI.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/URI/Lens.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Lens--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/URI/Parser/ByteString.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Parser.ByteString--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -9,7 +9,6 @@ -- -- URI parser for string 'ByteString', an internal module. -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}@@ -39,10 +38,6 @@ import qualified Data.Set as E import qualified Data.Text.Encoding as TE import qualified Text.Megaparsec.Byte.Lexer as L--#if !MIN_VERSION_megaparsec(6,4,0)-import Control.Applicative (empty)-#endif -- | This parser can be used to parse 'URI' from strict 'ByteString'. -- Remember to use a concrete non-polymorphic parser type for efficiency.
Text/URI/Parser/Text.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Parser.Text--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -9,7 +9,6 @@ -- -- URI parser for strict 'Text', an internal module. -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}@@ -36,10 +35,6 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text.Encoding as TE import qualified Text.Megaparsec.Char.Lexer as L--#if !MIN_VERSION_megaparsec(6,4,0)-import Control.Applicative (empty)-#endif -- | Construct a 'URI' from 'Text'. The input you pass to 'mkURI' must be a -- valid URI as per RFC 3986, that is, its components should be
Text/URI/Parser/Text/Utils.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Parser.Text.Utils--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/URI/QQ.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.QQ--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -10,7 +10,6 @@ -- Quasi-quoters for compile-time construction of URIs and refined text -- values. -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -27,23 +26,13 @@ where import Control.Exception (SomeException, Exception (..))-import Data.Data (Data) import Data.Text (Text)-import Data.Typeable (cast)-import Language.Haskell.TH import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax (lift)+import Language.Haskell.TH.Syntax (Lift (..)) import Text.URI.Parser.Text import Text.URI.Types import qualified Data.Text as T -#if MIN_VERSION_template_haskell(2,11,0)-import Language.Haskell.TH.Syntax (dataToExpQ)-#else-dataToExpQ :: Data a => (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp-dataToExpQ _ _ = fail "The feature requires at least GHC 8 to work"-#endif- -- | Construct a 'URI' value at compile time. uri :: QuasiQuoter@@ -94,17 +83,12 @@ -- | Lift a smart constructor for refined text into a 'QuasiQuoter'. -liftToQQ :: Data a => (Text -> Either SomeException a) -> QuasiQuoter+liftToQQ :: 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 -> dataToExpQ (fmap liftText . cast) x+ Right x -> lift x , quotePat = error "This usage is not supported" , quoteType = error "This usage is not supported" , quoteDec = error "This usage is not supported" }---- | Lift strict 'T.Text' to @'Q' 'Exp'@.--liftText :: Text -> Q Exp-liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt)
Text/URI/Render.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Render--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Text/URI/Types.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Text.URI.Types--- Copyright : © 2017–2018 Mark Karpov+-- Copyright : © 2017–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -18,6 +18,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} module Text.URI.Types@@ -56,7 +57,7 @@ import Data.Maybe (fromMaybe, isJust, fromJust) import Data.Proxy import Data.Text (Text)-import Data.Typeable (Typeable)+import Data.Typeable (Typeable, cast) import Data.Void import Data.Word (Word8, Word16) import GHC.Generics@@ -66,6 +67,7 @@ import Text.URI.Parser.Text.Utils (pHost) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T+import qualified Language.Haskell.TH.Syntax as TH ---------------------------------------------------------------------------- -- Data types@@ -111,6 +113,11 @@ instance NFData URI +-- | @since 0.3.1.0++instance TH.Lift URI where+ lift = liftData+ -- | Make a given 'URI' reference absolute using the supplied @'RText' -- 'Scheme'@ if necessary. @@ -145,6 +152,11 @@ instance NFData Authority +-- | @since 0.3.1.0++instance TH.Lift Authority where+ lift = liftData+ -- | User info as a combination of username and password. data UserInfo = UserInfo@@ -162,6 +174,11 @@ instance NFData UserInfo +-- | @since 0.3.1.0++instance TH.Lift UserInfo where+ lift = liftData+ -- | Query parameter either in the form of flag or as a pair of key and -- value. A key cannot be empty, while a value can. @@ -179,6 +196,11 @@ instance NFData QueryParam +-- | @since 0.3.1.0++instance TH.Lift QueryParam where+ lift = liftData+ -- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be -- parsed as a 'URI'. @@ -204,6 +226,11 @@ instance NFData (RText l) where +-- | @since 0.3.1.0++instance Typeable l => TH.Lift (RText l) where+ lift = liftData+ -- | Refined text labels. data RTextLabel@@ -476,3 +503,12 @@ arbText' :: (Text -> Maybe (RText l)) -> Gen (RText l) arbText' f = fromJust . f . T.pack <$> listOf1 arbitrary++----------------------------------------------------------------------------+-- TH lifting helpers++liftData :: Data a => a -> TH.Q TH.Exp+liftData = TH.dataToExpQ (fmap liftText . cast)++liftText :: Text -> TH.Q TH.Exp+liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
modern-uri.cabal view
@@ -1,7 +1,7 @@ name: modern-uri-version: 0.3.0.1+version: 0.3.1.0 cabal-version: 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1+tested-with: GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -26,9 +26,9 @@ library build-depends: QuickCheck >= 2.4 && < 3.0- , base >= 4.7 && < 5.0+ , base >= 4.10 && < 5.0 , bytestring >= 0.2 && < 0.11- , containers >= 0.5 && < 0.6+ , containers >= 0.5 && < 0.7 , contravariant >= 1.3 && < 2.0 , deepseq >= 1.3 && < 1.5 , exceptions >= 0.6 && < 0.11@@ -39,8 +39,6 @@ , tagged >= 0.8 && < 0.9 , template-haskell >= 2.10 && < 2.15 , text >= 0.2 && < 1.3- if !impl(ghc >= 8.0)- build-depends: semigroups == 0.18.* exposed-modules: Text.URI , Text.URI.Lens , Text.URI.QQ@@ -53,7 +51,7 @@ ghc-options: -Wall -Werror else ghc-options: -O2 -Wall- if flag(dev) && impl(ghc >= 8.0)+ if flag(dev) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns@@ -66,7 +64,7 @@ hs-source-dirs: tests type: exitcode-stdio-1.0 build-depends: QuickCheck >= 2.4 && < 3.0- , base >= 4.7 && < 5.0+ , base >= 4.10 && < 5.0 , bytestring >= 0.2 && < 0.11 , hspec >= 2.0 && < 3.0 , hspec-megaparsec >= 2.0 && < 3.0@@ -74,9 +72,8 @@ , 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+ other-modules: Text.QQSpec+ , Text.URISpec if flag(dev) ghc-options: -Wall -Werror else@@ -87,7 +84,7 @@ main-is: Main.hs hs-source-dirs: bench/speed type: exitcode-stdio-1.0- build-depends: base >= 4.7 && < 5.0+ build-depends: base >= 4.10 && < 5.0 , bytestring >= 0.2 && < 0.11 , criterion >= 0.6.2.1 && < 1.6 , megaparsec >= 7.0 && < 8.0@@ -103,7 +100,7 @@ main-is: Main.hs hs-source-dirs: bench/memory type: exitcode-stdio-1.0- build-depends: base >= 4.7 && < 5.0+ build-depends: base >= 4.10 && < 5.0 , bytestring >= 0.2 && < 0.11 , deepseq >= 1.3 && < 1.5 , megaparsec >= 7.0 && < 8.0
+ tests/Text/QQSpec.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Text.QQSpec (spec) where++import Test.Hspec+import Text.URI+import qualified Text.URI.QQ as QQ++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
tests/Text/URISpec.hs view
@@ -220,18 +220,25 @@ uri <- mkTestURI let s = "https://mark%3a%40:secret:%40@github.com:443/mrkkrp/modern-uri+%3a@?&foo:@=bar+:@#fragment:@" parse urip "" s `shouldParse` uri- describe "render" $ do it "sort of works" $ fmap URI.render mkTestURI `shouldReturn` testURI- context "when URI has absolute path" $- it "escapes colon properly in first path piece" $- (URI.render <$> URI.mkURI "/docu:ment.html")- `shouldReturn` "/docu%3ament.html"- context "when URI has relative path" $- it "escapes colon properly in first path piece" $- (URI.render <$> URI.mkURI "docu%3ament.html")- `shouldReturn` "docu%3ament.html"+ context "when URI has scheme" $+ it "escapes colon in path components" $+ (URI.render <$> URI.mkURI "https:/fir:st/se:cond")+ `shouldReturn` "https:/fir%3ast/se%3acond"+ context "when URI is a network-path reference" $+ it "does not escape colon in path components" $+ (URI.render <$> URI.mkURI "//host/fir:st/se:cond")+ `shouldReturn` "//host/fir%3ast/se%3acond"+ context "when URI is a relative-path reference" $+ it "escapes colon but only in the first path segment" $ do+ firstSeg <- URI.mkPathPiece "fir:st"+ secondSeg <- URI.mkPathPiece "se:cond"+ let uri = URI.emptyURI+ { uriPath = Just (False, firstSeg :| [secondSeg])+ }+ URI.render uri `shouldBe` "fir%3ast/se%3acond" describe "renderBs" $ it "sort of works" $ fmap URI.renderBs mkTestURI `shouldReturn` testURI