modern-uri 0.1.0.0 → 0.1.1.0
raw patch · 8 files changed
+313/−84 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +14/−0
- README.md +166/−0
- Text/URI.hs +1/−1
- Text/URI/Parser/Text.hs +7/−23
- Text/URI/Render.hs +109/−57
- Text/URI/Types.hs +13/−0
- modern-uri.cabal +1/−1
- tests/Text/URISpec.hs +2/−2
CHANGELOG.md view
@@ -1,3 +1,17 @@+## Modern URI 0.1.1.0++* Derived `NFData` for `ParseException`.++* Adjusted percent-encoding in renders so it's only used when absolutely+ necessary. Previously we percent-escaped a bit too much, which, strictly+ speaking, did not make the renders incorrect, but that didn't look nice+ either.++## Modern URI 0.1.0.1++* Updated the readme to include “Quick start” instructions and some+ examples.+ ## Modern URI 0.1.0.0 * Changed the type of `uriAuthority` from `Maybe Authority` to `Either Bool
README.md view
@@ -41,6 +41,172 @@ * Quasi-quoters for compile-time construction of the `URI` data type and refined text types (see `Text.URI.QQ`). +## Quick start++The `modern-uri` package serves three main purposes:++* Construction of the `URI` data type.+* Inspection and manipulation of the `URI` data type (in the sense of+ changing its parts).+* Rendering of `URI`s.++Let's walk through every operation quickly.++### Construction of `URI`s++There are four ways to create a `URI` value. First off, one could assemble+it manually like so:++```haskell+λ> :set -XOverloadedStrings+λ> import qualified Text.URI as URI+λ> scheme <- URI.mkScheme "https"+λ> scheme+"https"+λ> host <- URI.mkHost "markkarpov.com"+λ> host+"markkarpov.com"+λ> let uri = URI.URI (Just scheme) (Right (URI.Authority Nothing host Nothing)) [] [] Nothing+λ> uri+URI+ { uriScheme = Just "https"+ , uriAuthority = Right+ (Authority+ { authUserInfo = Nothing+ , authHost = "markkarpov.com"+ , authPort = Nothing })+ , uriPath = []+ , uriQuery = []+ , uriFragment = Nothing }+```++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.++There is a smart constructor that can make an entire `URI` too, it's called+(unsurprisingly) `mkURI`:++```haskell+λ> uri <- URI.mkURI "https://markkarpov.com"+λ> uri+URI+ { uriScheme = Just "https"+ , uriAuthority = Right+ (Authority+ { authUserInfo = Nothing+ , authHost = "markkarpov.com"+ , authPort = Nothing })+ , uriPath = []+ , uriQuery = []+ , 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 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+the `Text.URI.QQ` module and enable the `QuasiQuotes` language extension,+like so:++```haskell+λ> :set -XQuasiQuotes+λ> import qualified Text.URI.QQ as QQ+λ> let uri = [QQ.uri|https://markkarpov.com|]+λ> uri+URI+ { uriScheme = Just "https"+ , uriAuthority = Right+ (Authority+ { authUserInfo = Nothing+ , authHost = "markkarpov.com"+ , authPort = Nothing })+ , uriPath = []+ , uriQuery = []+ , uriFragment = Nothing }+```++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.++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).++### Inspection and manipulation++Although one could use record syntax directly, possibly with language+extensions like `RecordWildcards`, the best way to inspect and edit parts of+`URI` is with lenses. The lenses can be found in the `Text.URI.Lens` module.+If you have never used the+[`lens`](https://hackage.haskell.org/package/lens) library, you could+probably start by reading/watching materials suggested in the library+description on Hackage.++Here are some examples, just to show off what you can do:++```haskell+λ> import Text.URI.Lens+λ> uri <- URI.mkURI "https://example.com/some/path?foo=bar&baz=quux&foo=foo"+λ> uri ^. uriScheme+Just "https"+λ> uri ^? uriAuthority . _Right . authHost+Just "example.com"+λ> uri ^. isPathAbsolute+True+λ> uri ^. uriPath+["some","path"]+λ> k <- URI.mkQueryKey "foo"+λ> uri ^.. uriQuery . queryParam k+["bar","foo"]+-- etc.+```++### Rendering++Rendering turns a `URI` into a sequence of bytes or characters. Currently+the following options are available:++* `render` for rendering to strict `Text`.+* `render'` for rendering to text `Builder`. It's possible to turn that into+ lazy `Text` by using the `toLazyText` function from+ `Data.Text.Lazy.Builder`.+* `renderBs` for rendering to strict `ByteString`.+* `renderBs'` for rendering to byte string `Builder`. Similarly it's+ possible to get a lazy `ByteString` from that by using the+ `toLazyByteString` function from `Data.ByteString.Builder`.+* `renderStr` can be used to render to `String`. Sometimes it's handy. The+ render uses difference lists internally so it's not that slow, but in+ general I'd advise avoiding `String`s.+* `rederStr'` returns `ShowS`, which is just a synonym for `String ->+ String`—a function that prepends result of rendering to a given `String`.+ This is useful when the `URI` you want to render is a part of a bigger+ output, just like with the builders mentioned above.++Examples:++```haskell+λ> uri <- mkURI "https://markkarpov.com/posts.html"+λ> render uri+"https://markkarpov.com/posts.html"+λ> renderBs uri+"https://markkarpov.com/posts.html"+λ> renderStr uri+"https://markkarpov.com/posts.html"+-- etc.+```+ ## Contribution Issues, bugs, and questions may be reported in [the GitHub issue tracker for
Text/URI.hs view
@@ -7,7 +7,7 @@ -- Stability : experimental -- Portability : portable ----- This is modern library for working with URIs as per RFC 3986:+-- This is a modern library for working with URIs as per RFC 3986: -- -- <https://tools.ietf.org/html/rfc3986> --
Text/URI/Parser/Text.hs view
@@ -9,29 +9,23 @@ -- -- URI parser for strict 'Text', an internal module. -{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} module Text.URI.Parser.Text ( mkURI- , parser- , ParseException (..) )+ , parser ) where import Control.Applicative import Control.Monad-import Control.Monad.Catch (Exception (..), MonadThrow (..))-import Data.Data (Data)+import Control.Monad.Catch (MonadThrow (..)) import Data.Maybe (isJust, catMaybes) import Data.Text (Text)-import Data.Typeable (Typeable) import Data.Void-import GHC.Generics import Text.Megaparsec import Text.Megaparsec.Char import Text.URI.Parser.Text.Utils@@ -52,16 +46,6 @@ case runParser (parser <* eof :: Parsec Void Text URI) "" input of Left err -> throwM (ParseException input err) Right x -> return x---- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be--- parsed as a 'URI'.--data ParseException = ParseException Text (ParseError Char Void)- -- ^ Arguments are: original input and parse error- deriving (Show, Eq, Data, Typeable, Generic)--instance Exception ParseException where- displayException (ParseException s e) = parseErrorPretty' s e -- | This parser can be used to parse 'URI' from strict 'Text'. Remember to -- use a concrete non-polymorphic parser type for efficiency.
Text/URI/Render.hs view
@@ -9,12 +9,14 @@ -- -- URI renders, an internal module. -{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module Text.URI.Render ( render@@ -30,6 +32,7 @@ import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid+import Data.Proxy import Data.String (IsString (..)) import Data.Text (Text) import Data.Word (Word8)@@ -56,8 +59,8 @@ -- | Render a given 'URI' value as a 'TLB.Builder'. render' :: URI -> TLB.Builder-render' = genericRender TLB.decimal $ \e ->- TLB.fromText . percentEncode e . unRText+render' = genericRender TLB.decimal $+ TLB.fromText . percentEncode -- | Render a given 'URI' value as a strict 'ByteString'. @@ -67,8 +70,8 @@ -- | Render a given 'URI' value as a 'BLB.Builder'. renderBs' :: URI -> BLB.Builder-renderBs' = genericRender BLB.wordDec $ \e ->- BLB.byteString . TE.encodeUtf8 . percentEncode e . unRText+renderBs' = genericRender BLB.wordDec $+ BLB.byteString . TE.encodeUtf8 . percentEncode -- | Render a given 'URI' value as a 'String'. --@@ -82,22 +85,13 @@ -- @since 0.0.2.0 renderStr' :: URI -> ShowS-renderStr' = toShowS . genericRender (DString . showInt) (\e ->- fromString . T.unpack . percentEncode e . unRText)+renderStr' = toShowS . genericRender (DString . showInt)+ (fromString . T.unpack . percentEncode) ---------------------------------------------------------------------------- -- Generic render --- | Percent encoding options.--data Escaping- = N -- ^ No escaping- | P -- ^ Path-piece style, do not encode @:@ and @\@@- | PQ -- ^ Mixed style, encode @:@ but not @\@@- | Q -- ^ Query string style, encode @:@ and @\@@- deriving (Eq)--type Render a b = (forall l. Escaping -> RText l -> b) -> a -> b+type Render a b = (forall l. RLabel l => RText l -> b) -> a -> b type R b = (Monoid b, IsString b) genericRender :: R b => (Word -> b) -> Render URI b@@ -113,34 +107,29 @@ rJust = maybe mempty rScheme :: R b => Render (RText 'Scheme) b-rScheme r = (<> ":") . r Q+rScheme r = (<> ":") . r {-# INLINE rScheme #-} rAuthority :: R b => (Word -> b) -> Render Authority b rAuthority d r Authority {..} = mconcat [ "//" , rJust (rUserInfo r) authUserInfo- , if T.head (unRText authHost) == '['- then r N authHost- else r Q authHost+ , r authHost , rJust ((":" <>) . d) authPort ] {-# INLINE rAuthority #-} rUserInfo :: R b => Render UserInfo b rUserInfo r UserInfo {..} = mconcat- [ r Q uiUsername- , rJust ((":" <>) . r Q) uiPassword+ [ r uiUsername+ , rJust ((":" <>) . r) uiPassword , "@" ] {-# INLINE rUserInfo #-} rPath :: R b => Bool -> Render [RText 'PathPiece] b-rPath isAbsolute r ps' = leading <> other+rPath isAbsolute r ps = leading <> other where leading = if isAbsolute then "/" else mempty- other = mconcat . intersperse "/" $- case (isAbsolute, ps') of- (False, p:ps) -> r PQ p : fmap (r P) ps- _ -> r P <$> ps'+ other = mconcat . intersperse "/" $ r <$> ps {-# INLINE rPath #-} rQuery :: R b => Render [QueryParam] b@@ -151,12 +140,12 @@ rQueryParam :: R b => Render QueryParam b rQueryParam r = \case- QueryFlag flag -> r P flag- QueryParam k v -> r P k <> "=" <> r P v+ QueryFlag flag -> r flag+ QueryParam k v -> r k <> "=" <> r v {-# INLINE rQueryParam #-} rFragment :: R b => Render (RText 'Fragment) b-rFragment r = ("#" <>) . r P+rFragment r = ("#" <>) . r {-# INLINE rFragment #-} ----------------------------------------------------------------------------@@ -179,43 +168,106 @@ -- | Percent-encode a 'Text' value. -percentEncode- :: Escaping -- ^ Whether to leave @':'@ and @'@'@ unescaped- -> Text -- ^ Input text to encode+percentEncode :: forall l. RLabel l+ => RText l -- ^ Input text to encode -> Text -- ^ Percent-encoded text-percentEncode e txt = T.unfoldrN n f (bs, [])+percentEncode rtxt =+ if skipEscaping (Proxy :: Proxy l) txt+ then txt+ else T.unfoldr f (TE.encodeUtf8 txt, []) where f (bs', []) = case B.uncons bs' of Nothing -> Nothing Just (w, bs'') -> Just $- if isUnreserved e w+ if nne w then (chr (fromIntegral w), (bs'', [])) else let c:|cs = encodeByte w in (c, (bs'', cs)) f (bs', x:xs) = Just (x, (bs', xs))- bs = TE.encodeUtf8 txt- n = B.foldl' (\n' w -> g w + n') 0 bs- g x = if isUnreserved e x then 1 else 3 encodeByte x = '%' :| [intToDigit h, intToDigit l] where (h, l) = fromIntegral x `quotRem` 16+ nne = needsNoEscaping (Proxy :: Proxy l)+ txt = unRText rtxt --- | The predicate selects unreserved bytes.+-- | This type class attaches a predicate that tells which bytes should not+-- be percent-encoded to the type level label of kind 'RTextLabel'. -isUnreserved :: Escaping -> Word8 -> Bool-isUnreserved N _ = True-isUnreserved t x+class RLabel (l :: RTextLabel) where++ -- | The predicate selects bytes that do not to be percent-escaped in+ -- rendered URI.++ needsNoEscaping :: Proxy l -> Word8 -> Bool++ -- | Whether to skip percent-escaping altogether for this value.++ skipEscaping :: Proxy l -> Text -> Bool+ skipEscaping Proxy _ = False++instance RLabel 'Scheme where+ needsNoEscaping Proxy x = isAlphaNum x || x == 43 || x == 45 || x == 46++instance RLabel 'Host where+ needsNoEscaping Proxy x = isUnreserved x || isDelim x+ skipEscaping Proxy x = T.head x == '['++instance RLabel 'Username where+ needsNoEscaping Proxy x = isUnreserved x || isDelim x++instance RLabel 'Password where+ needsNoEscaping Proxy x = isUnreserved x || isDelim x || x == 58++instance RLabel 'PathPiece where+ needsNoEscaping Proxy x =+ isUnreserved x || isDelim x || x == 64++instance RLabel 'QueryKey where+ needsNoEscaping Proxy x =+ isPChar isDelim' x || x == 47 || x == 63++instance RLabel 'QueryValue where+ needsNoEscaping Proxy x =+ isPChar isDelim' x || x == 47 || x == 63++instance RLabel 'Fragment where+ needsNoEscaping Proxy x =+ isPChar isDelim x || x == 47 || x == 63++isPChar :: (Word8 -> Bool) -> Word8 -> Bool+isPChar f x = isUnreserved x || f x || x == 58 || x == 64++isUnreserved :: Word8 -> Bool+isUnreserved x = isAlphaNum x || other+ where+ other = case x of+ 45 -> True+ 46 -> True+ 95 -> True+ 126 -> True+ _ -> False++isAlphaNum :: Word8 -> Bool+isAlphaNum x | x >= 65 && x <= 90 = True -- 'A'..'Z' | x >= 97 && x <= 122 = True -- 'a'..'z' | x >= 48 && x <= 57 = True -- '0'..'9'- | x == 45 = True -- '-'- | x == 95 = True -- '_'- | x == 46 = True -- '.'- | x == 126 = True -- '~'- | colon && x == 58 = True -- ':'- | at && x == 64 = True -- '@' | otherwise = False- where- colon = t == P- at = t == P || t == PQ++isDelim :: Word8 -> Bool+isDelim x+ | x == 33 = True+ | x == 36 = True+ | x >= 38 && x <= 44 = True+ | x == 59 = True+ | x == 61 = True+ | otherwise = False++isDelim' :: Word8 -> Bool+isDelim' x+ | x == 33 = True+ | x == 36 = True+ | x >= 39 && x <= 44 = True+ | x == 59 = True+ | otherwise = False
Text/URI/Types.hs view
@@ -27,6 +27,7 @@ , Authority (..) , UserInfo (..) , QueryParam (..)+ , ParseException (..) -- * Refined text , RText , RTextLabel (..)@@ -167,6 +168,18 @@ , QueryParam <$> arbitrary <*> arbitrary ] instance NFData QueryParam++-- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be+-- parsed as a 'URI'.++data ParseException = ParseException Text (ParseError Char Void)+ -- ^ Arguments are: original input and parse error+ deriving (Show, Eq, Data, Typeable, Generic)++instance Exception ParseException where+ displayException (ParseException s e) = parseErrorPretty' s e++instance NFData ParseException ---------------------------------------------------------------------------- -- Refined text
modern-uri.cabal view
@@ -1,5 +1,5 @@ name: modern-uri-version: 0.1.0.0+version: 0.1.1.0 cabal-version: >= 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3
tests/Text/URISpec.hs view
@@ -177,7 +177,7 @@ context "when URI has absolute path" $ it "escapes colon properly in first path piece" $ (URI.render <$> URI.mkURI "/docu:ment.html")- `shouldReturn` "/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")@@ -219,7 +219,7 @@ -- | Polymorphic textual rendering of the 'URI' generated by 'mkTestURI'. testURI :: IsString a => a-testURI = "https://mark%3a%40:secret%3a%40@github.com:443/mrkkrp/modern-uri:@?foo:@=bar:@#fragment:@"+testURI = "https://mark%3a%40:secret:%40@github.com:443/mrkkrp/modern-uri%3a@?foo:@=bar:@#fragment:@" -- | A utility wrapper around 'URI.parser'.