Copyright | © 2017–present Mark Karpov |
---|---|
License | BSD 3 clause |
Maintainer | Mark Karpov <markkarpov92@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This is a modern library for working with URIs as per RFC 3986:
https://tools.ietf.org/html/rfc3986
This module is intended to be imported qualified, e.g.:
import Text.URI (URI) import qualified Text.URI as URI
See also Text.URI.Lens for lens, prisms, and traversals; see Text.URI.QQ for quasi-quoters for compile-time validation of URIs and refined text components.
Synopsis
- data URI = URI {}
- mkURI :: MonadThrow m => Text -> m URI
- mkURIBs :: MonadThrow m => ByteString -> m URI
- emptyURI :: URI
- makeAbsolute :: RText 'Scheme -> URI -> URI
- isPathAbsolute :: URI -> Bool
- relativeTo :: URI -> URI -> Maybe URI
- data Authority = Authority {}
- data UserInfo = UserInfo {
- uiUsername :: RText 'Username
- uiPassword :: Maybe (RText 'Password)
- data QueryParam
- = QueryFlag (RText 'QueryKey)
- | QueryParam (RText 'QueryKey) (RText 'QueryValue)
- newtype ParseException = ParseException (ParseErrorBundle Text Void)
- newtype ParseExceptionBs = ParseExceptionBs (ParseErrorBundle ByteString Void)
- data RText (l :: RTextLabel)
- data RTextLabel
- mkScheme :: MonadThrow m => Text -> m (RText 'Scheme)
- mkHost :: MonadThrow m => Text -> m (RText 'Host)
- mkUsername :: MonadThrow m => Text -> m (RText 'Username)
- mkPassword :: MonadThrow m => Text -> m (RText 'Password)
- mkPathPiece :: MonadThrow m => Text -> m (RText 'PathPiece)
- mkQueryKey :: MonadThrow m => Text -> m (RText 'QueryKey)
- mkQueryValue :: MonadThrow m => Text -> m (RText 'QueryValue)
- mkFragment :: MonadThrow m => Text -> m (RText 'Fragment)
- unRText :: RText l -> Text
- data RTextException = RTextException RTextLabel Text
- parser :: MonadParsec e Text m => m URI
- parserBs :: MonadParsec e ByteString m => m URI
- render :: URI -> Text
- render' :: URI -> Builder
- renderBs :: URI -> ByteString
- renderBs' :: URI -> Builder
- renderStr :: URI -> String
- renderStr' :: URI -> ShowS
Data types
Uniform resource identifier (URI) reference. We use refined Text
(
) here because information is presented in human-readable
form, i.e. percent-decoded, and thus it may contain Unicode characters.RText
l
URI | |
|
Instances
Arbitrary URI Source # | |
Data URI Source # | |
Defined in Text.URI.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> URI -> c URI # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c URI # dataTypeOf :: URI -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c URI) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI) # gmapT :: (forall b. Data b => b -> b) -> URI -> URI # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r # gmapQ :: (forall d. Data d => d -> u) -> URI -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> URI -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> URI -> m URI # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> URI -> m URI # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> URI -> m URI # | |
Generic URI Source # | |
Show URI Source # | |
NFData URI Source # | |
Defined in Text.URI.Types | |
Eq URI Source # | |
Ord URI Source # | |
Hashable URI Source # | Since: 0.3.5.0 |
Defined in Text.URI.Types | |
Lift URI Source # | Since: 0.3.1.0 |
type Rep URI Source # | |
Defined in Text.URI.Types type Rep URI = D1 ('MetaData "URI" "Text.URI.Types" "modern-uri-0.3.6.1-GII9sgWJTzsJP2E4kYouDv" 'False) (C1 ('MetaCons "URI" 'PrefixI 'True) ((S1 ('MetaSel ('Just "uriScheme") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (RText 'Scheme))) :*: S1 ('MetaSel ('Just "uriAuthority") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either Bool Authority))) :*: (S1 ('MetaSel ('Just "uriPath") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Bool, NonEmpty (RText 'PathPiece)))) :*: (S1 ('MetaSel ('Just "uriQuery") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [QueryParam]) :*: S1 ('MetaSel ('Just "uriFragment") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (RText 'Fragment))))))) |
mkURI :: MonadThrow m => Text -> m URI Source #
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
percent-encoded where necessary. In case of parse failure
ParseException
is thrown.
This function uses the parser
parser under the hood, which you can also
use directly in a Megaparsec parser.
mkURIBs :: MonadThrow m => ByteString -> m URI Source #
Construct a URI
from ByteString
. The input you pass to mkURIBs
must be a valid URI as per RFC 3986, that is, its components should be
percent-encoded where necessary. In case of parse failure
ParseExceptionBs
is thrown.
This function uses the parserBs
parser under the hood, which you can also
use directly in a Megaparsec parser.
Since: 0.3.3.0
makes the relativeTo
reference basereference
URI
absolute
resolving it against the base
URI
.
If the base URI
is not absolute itself (that is, it has no scheme),
this function returns Nothing
.
See also: https://tools.ietf.org/html/rfc3986#section-5.2.
Since: 0.2.0.0
Authority component of URI
.
Instances
Arbitrary Authority Source # | |
Data Authority Source # | |
Defined in Text.URI.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Authority -> c Authority # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Authority # toConstr :: Authority -> Constr # dataTypeOf :: Authority -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Authority) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Authority) # gmapT :: (forall b. Data b => b -> b) -> Authority -> Authority # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Authority -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Authority -> r # gmapQ :: (forall d. Data d => d -> u) -> Authority -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Authority -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Authority -> m Authority # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Authority -> m Authority # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Authority -> m Authority # | |
Generic Authority Source # | |
Show Authority Source # | |
NFData Authority Source # | |
Defined in Text.URI.Types | |
Eq Authority Source # | |
Ord Authority Source # | |
Defined in Text.URI.Types | |
Hashable Authority Source # | Since: 0.3.5.0 |
Defined in Text.URI.Types | |
Lift Authority Source # | Since: 0.3.1.0 |
type Rep Authority Source # | |
Defined in Text.URI.Types type Rep Authority = D1 ('MetaData "Authority" "Text.URI.Types" "modern-uri-0.3.6.1-GII9sgWJTzsJP2E4kYouDv" 'False) (C1 ('MetaCons "Authority" 'PrefixI 'True) (S1 ('MetaSel ('Just "authUserInfo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe UserInfo)) :*: (S1 ('MetaSel ('Just "authHost") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RText 'Host)) :*: S1 ('MetaSel ('Just "authPort") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Word))))) |
User info as a combination of username and password.
UserInfo | |
|
Instances
Arbitrary UserInfo Source # | |
Data UserInfo Source # | |
Defined in Text.URI.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UserInfo -> c UserInfo # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UserInfo # toConstr :: UserInfo -> Constr # dataTypeOf :: UserInfo -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c UserInfo) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserInfo) # gmapT :: (forall b. Data b => b -> b) -> UserInfo -> UserInfo # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UserInfo -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UserInfo -> r # gmapQ :: (forall d. Data d => d -> u) -> UserInfo -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> UserInfo -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo # | |
Generic UserInfo Source # | |
Show UserInfo Source # | |
NFData UserInfo Source # | |
Defined in Text.URI.Types | |
Eq UserInfo Source # | |
Ord UserInfo Source # | |
Defined in Text.URI.Types | |
Hashable UserInfo Source # | Since: 0.3.5.0 |
Defined in Text.URI.Types | |
Lift UserInfo Source # | Since: 0.3.1.0 |
type Rep UserInfo Source # | |
Defined in Text.URI.Types type Rep UserInfo = D1 ('MetaData "UserInfo" "Text.URI.Types" "modern-uri-0.3.6.1-GII9sgWJTzsJP2E4kYouDv" 'False) (C1 ('MetaCons "UserInfo" 'PrefixI 'True) (S1 ('MetaSel ('Just "uiUsername") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (RText 'Username)) :*: S1 ('MetaSel ('Just "uiPassword") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (RText 'Password))))) |
data QueryParam Source #
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.
QueryFlag (RText 'QueryKey) | Flag parameter |
QueryParam (RText 'QueryKey) (RText 'QueryValue) | Key–value pair |
Instances
newtype ParseException Source #
ParseException (ParseErrorBundle Text Void) | Arguments are: original input and parse error |
Instances
newtype ParseExceptionBs Source #
Parse exception thrown by mkURIBs
when a given ByteString
value cannot be
parsed as a URI
.
Since: 0.3.3.0
ParseExceptionBs (ParseErrorBundle ByteString Void) | Arguments are: original input and parse error |
Instances
Refined text
Refined text values can only be created by using the smart constructors
listed below, such as mkScheme
. This eliminates the possibility of
having an invalid component in URI
which could invalidate the whole
URI
.
Note that the refined text RText
type is labelled at the type level
with RTextLabel
s, which see.
When an invalid Text
value is passed to a smart constructor,
it rejects it by throwing the RTextException
. Remember that the Maybe
datatype is also an instance of MonadThrow
, and so
one could as well use the smart constructors in the Maybe
monad.
data RText (l :: RTextLabel) Source #
Refined text labelled at the type level.
Instances
Typeable l => Lift (RText l :: TYPE LiftedRep) Source # | Since: 0.3.1.0 |
Arbitrary (RText 'Fragment) Source # | |
Arbitrary (RText 'Host) Source # | |
Arbitrary (RText 'Password) Source # | |
Arbitrary (RText 'PathPiece) Source # | |
Arbitrary (RText 'QueryKey) Source # | |
Arbitrary (RText 'QueryValue) Source # | |
Defined in Text.URI.Types arbitrary :: Gen (RText 'QueryValue) # shrink :: RText 'QueryValue -> [RText 'QueryValue] # | |
Arbitrary (RText 'Scheme) Source # | |
Arbitrary (RText 'Username) Source # | |
Typeable l => Data (RText l) Source # | |
Defined in Text.URI.Types gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> RText l -> c (RText l) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (RText l) # toConstr :: RText l -> Constr # dataTypeOf :: RText l -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (RText l)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l)) # gmapT :: (forall b. Data b => b -> b) -> RText l -> RText l # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> RText l -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> RText l -> r # gmapQ :: (forall d. Data d => d -> u) -> RText l -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> RText l -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> RText l -> m (RText l) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> RText l -> m (RText l) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> RText l -> m (RText l) # | |
Generic (RText l) Source # | |
Show (RText l) Source # | |
NFData (RText l) Source # | |
Defined in Text.URI.Types | |
Eq (RText l) Source # | |
Ord (RText l) Source # | |
Hashable (RText l) Source # | Since: 0.3.5.0 |
Defined in Text.URI.Types | |
type Rep (RText l) Source # | |
Defined in Text.URI.Types |
data RTextLabel Source #
Refined text labels.
Scheme | See |
Host | See |
Username | See |
Password | See |
PathPiece | See |
QueryKey | See |
QueryValue | See |
Fragment | See |
Instances
mkScheme :: MonadThrow m => Text -> m (RText 'Scheme) Source #
mkUsername :: MonadThrow m => Text -> m (RText 'Username) Source #
mkPassword :: MonadThrow m => Text -> m (RText 'Password) Source #
mkPathPiece :: MonadThrow m => Text -> m (RText 'PathPiece) Source #
mkQueryKey :: MonadThrow m => Text -> m (RText 'QueryKey) Source #
mkQueryValue :: MonadThrow m => Text -> m (RText 'QueryValue) Source #
Lift a Text
value into
.RText
QueryValue
This smart constructor does not perform any sort of normalization.
mkFragment :: MonadThrow m => Text -> m (RText 'Fragment) Source #
data RTextException Source #
The exception is thrown when a refined
value cannot be
constructed due to the fact that given RText
lText
value is not correct.
RTextException RTextLabel Text |
|
Instances
Parsing
The input you feed into the parsers must be a valid URI as per RFC 3986, that is, its components should be percent-encoded where necessary.
parserBs :: MonadParsec e ByteString m => m URI Source #
This parser can be used to parse URI
from strict ByteString
.
Remember to use a concrete non-polymorphic parser type for efficiency.
Since: 0.0.2.0
Rendering
Rendering functions take care of constructing correct URI
representation as per RFC 3986, that is, percent-encoding will be applied
when necessary automatically.
renderBs :: URI -> ByteString Source #
Render a given URI
value as a strict ByteString
.