{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings, PackageImports, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS -Wall -fno-warn-orphans #-}
module Debian.URI
( module Network.URI
#if 0
, _NodeElement
, _NodeContent
, eltAttrsLens
, eltChildrenLens
, eltNameLens
#endif
, URIError(..)
, uriSchemeLens
, uriAuthorityLens
, uriPathLens
, uriQueryLens
, uriFragmentLens
, URI'(..)
, fromURI'
, toURI'
, readURI'
, showURI
, parseURIReference'
, parseURI'
, parseAbsoluteURI'
, parseRelativeReference'
, parseURIUnsafe
, appendURI
, appendURIs
, parentURI
, uriToString'
, HasParseError(fromParseError)
, HasURIError(fromURIError)
, prop_print_parse
, prop_append_singleton
) where
import Control.Lens (makeLensesFor)
import Control.Monad.Except (MonadError, throwError)
import Data.Foldable (foldrM)
import Data.Maybe (fromJust, fromMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Network.URI (nullURI, parseURIReference, parseURI, parseAbsoluteURI, parseRelativeReference, URI(..), URIAuth(..), uriToString)
import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory)
import Text.Parsec (ParseError)
$(makeLensesFor [("uriScheme", "uriSchemeLens"),
("uriAuthority", "uriAuthorityLens"),
("uriPath", "uriPathLens"),
("uriQuery", "uriQueryLens"),
("uriFragment", "uriFragmentLens")] ''URI)
showURI :: URI -> String
showURI :: URI -> [Char]
showURI (URI {[Char]
Maybe URIAuth
uriScheme :: URI -> [Char]
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> [Char]
uriQuery :: URI -> [Char]
uriFragment :: URI -> [Char]
uriFragment :: [Char]
uriQuery :: [Char]
uriPath :: [Char]
uriAuthority :: Maybe URIAuth
uriScheme :: [Char]
..}) =
[Char]
"URI {uriScheme = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
uriScheme forall a. Semigroup a => a -> a -> a
<>
[Char]
", uriAuthority = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Maybe URIAuth
uriAuthority forall a. Semigroup a => a -> a -> a
<>
[Char]
", uriPath = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
uriPath forall a. Semigroup a => a -> a -> a
<>
[Char]
", uriQuery = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
uriQuery forall a. Semigroup a => a -> a -> a
<>
[Char]
", uriFragment = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show [Char]
uriFragment forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
parseURI' :: (HasURIError e, MonadError e m) => String -> m URI
parseURI' :: forall e (m :: * -> *).
(HasURIError e, MonadError e m) =>
[Char] -> m URI
parseURI' [Char]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. HasURIError e => URIError -> e
fromURIError forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> URIError
URIParseError [Char]
"parseURI" [Char]
s) forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe URI
parseURI [Char]
s)
parseURIReference' :: (HasURIError e, MonadError e m) => String -> m URI
parseURIReference' :: forall e (m :: * -> *).
(HasURIError e, MonadError e m) =>
[Char] -> m URI
parseURIReference' [Char]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. HasURIError e => URIError -> e
fromURIError forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> URIError
URIParseError [Char]
"parseURIReference" [Char]
s) forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe URI
parseURIReference [Char]
s)
parseAbsoluteURI' :: (HasURIError e, MonadError e m) => String -> m URI
parseAbsoluteURI' :: forall e (m :: * -> *).
(HasURIError e, MonadError e m) =>
[Char] -> m URI
parseAbsoluteURI' [Char]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. HasURIError e => URIError -> e
fromURIError forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> URIError
URIParseError [Char]
"parseAbsoluteURI" [Char]
s) forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe URI
parseAbsoluteURI [Char]
s)
parseRelativeReference' :: (HasURIError e, MonadError e m) => String -> m URI
parseRelativeReference' :: forall e (m :: * -> *).
(HasURIError e, MonadError e m) =>
[Char] -> m URI
parseRelativeReference' [Char]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall e. HasURIError e => URIError -> e
fromURIError forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> URIError
URIParseError [Char]
"parseRelativeReference" [Char]
s) forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe URI
parseRelativeReference [Char]
s)
parseURIUnsafe :: String -> URI
parseURIUnsafe :: [Char] -> URI
parseURIUnsafe [Char]
s = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error ([Char]
"parseURIUnsafe " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
s)) forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URI
parseURIReference [Char]
s
data URIError =
URIParseError String String
| URIAppendError URI URI
deriving (URIError -> URIError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIError -> URIError -> Bool
$c/= :: URIError -> URIError -> Bool
== :: URIError -> URIError -> Bool
$c== :: URIError -> URIError -> Bool
Eq, Eq URIError
URIError -> URIError -> Bool
URIError -> URIError -> Ordering
URIError -> URIError -> URIError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URIError -> URIError -> URIError
$cmin :: URIError -> URIError -> URIError
max :: URIError -> URIError -> URIError
$cmax :: URIError -> URIError -> URIError
>= :: URIError -> URIError -> Bool
$c>= :: URIError -> URIError -> Bool
> :: URIError -> URIError -> Bool
$c> :: URIError -> URIError -> Bool
<= :: URIError -> URIError -> Bool
$c<= :: URIError -> URIError -> Bool
< :: URIError -> URIError -> Bool
$c< :: URIError -> URIError -> Bool
compare :: URIError -> URIError -> Ordering
$ccompare :: URIError -> URIError -> Ordering
Ord, Int -> URIError -> ShowS
[URIError] -> ShowS
URIError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [URIError] -> ShowS
$cshowList :: [URIError] -> ShowS
show :: URIError -> [Char]
$cshow :: URIError -> [Char]
showsPrec :: Int -> URIError -> ShowS
$cshowsPrec :: Int -> URIError -> ShowS
Show)
appendURI :: MonadError URIError m => URI -> URI -> m URI
appendURI :: forall (m :: * -> *). MonadError URIError m => URI -> URI -> m URI
appendURI (URI [Char]
scheme Maybe URIAuth
auth [Char]
path1 [Char]
"" [Char]
"") (URI [Char]
"" Maybe URIAuth
Nothing [Char]
path2 [Char]
query [Char]
fragment) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI [Char]
scheme Maybe URIAuth
auth ([Char]
path1 [Char] -> ShowS
</> [Char]
path2) [Char]
query [Char]
fragment
appendURI URI
a URI
b = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (URI -> URI -> URIError
URIAppendError URI
a URI
b)
appendURIs :: (Foldable t, MonadError URIError m) => t URI -> m URI
appendURIs :: forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadError URIError m) =>
t URI -> m URI
appendURIs t URI
uris = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM forall (m :: * -> *). MonadError URIError m => URI -> URI -> m URI
appendURI URI
nullURI t URI
uris
parentURI :: URI -> URI
parentURI :: URI -> URI
parentURI URI
uri = URI
uri {uriPath :: [Char]
uriPath = ShowS
takeDirectory (ShowS
dropTrailingPathSeparator (URI -> [Char]
uriPath URI
uri))}
prop_append_singleton :: URI -> Bool
prop_append_singleton :: URI -> Bool
prop_append_singleton URI
uri = forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadError URIError m) =>
t URI -> m URI
appendURIs [URI
uri] forall a. Eq a => a -> a -> Bool
== forall a b. b -> Either a b
Right URI
uri
prop_print_parse :: URI -> Bool
prop_print_parse :: URI -> Bool
prop_print_parse URI
uri = [Char] -> Maybe URI
parseURIReference (forall a. Show a => a -> [Char]
show URI
uri) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just URI
uri
newtype URI' = URI' String deriving (ReadPrec [URI']
ReadPrec URI'
Int -> ReadS URI'
ReadS [URI']
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [URI']
$creadListPrec :: ReadPrec [URI']
readPrec :: ReadPrec URI'
$creadPrec :: ReadPrec URI'
readList :: ReadS [URI']
$creadList :: ReadS [URI']
readsPrec :: Int -> ReadS URI'
$creadsPrec :: Int -> ReadS URI'
Read, Int -> URI' -> ShowS
[URI'] -> ShowS
URI' -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [URI'] -> ShowS
$cshowList :: [URI'] -> ShowS
show :: URI' -> [Char]
$cshow :: URI' -> [Char]
showsPrec :: Int -> URI' -> ShowS
$cshowsPrec :: Int -> URI' -> ShowS
Show, URI' -> URI' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI' -> URI' -> Bool
$c/= :: URI' -> URI' -> Bool
== :: URI' -> URI' -> Bool
$c== :: URI' -> URI' -> Bool
Eq, Eq URI'
URI' -> URI' -> Bool
URI' -> URI' -> Ordering
URI' -> URI' -> URI'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URI' -> URI' -> URI'
$cmin :: URI' -> URI' -> URI'
max :: URI' -> URI' -> URI'
$cmax :: URI' -> URI' -> URI'
>= :: URI' -> URI' -> Bool
$c>= :: URI' -> URI' -> Bool
> :: URI' -> URI' -> Bool
$c> :: URI' -> URI' -> Bool
<= :: URI' -> URI' -> Bool
$c<= :: URI' -> URI' -> Bool
< :: URI' -> URI' -> Bool
$c< :: URI' -> URI' -> Bool
compare :: URI' -> URI' -> Ordering
$ccompare :: URI' -> URI' -> Ordering
Ord)
readURI' :: String -> Maybe URI'
readURI' :: [Char] -> Maybe URI'
readURI' [Char]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just ([Char] -> URI'
URI' [Char]
s))) ([Char] -> Maybe URI
parseURIReference [Char]
s)
fromURI' :: URI' -> URI
fromURI' :: URI' -> URI
fromURI' (URI' [Char]
s) = forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe URI
parseURI [Char]
s)
toURI' :: URI -> URI'
toURI' :: URI -> URI'
toURI' = [Char] -> URI'
URI' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
uriToString' :: URI -> String
uriToString' :: URI -> [Char]
uriToString' URI
uri = ShowS -> URI -> ShowS
uriToString forall a. a -> a
id URI
uri [Char]
""
class HasParseError e where fromParseError :: ParseError -> e
instance HasParseError ParseError where fromParseError :: ParseError -> ParseError
fromParseError = forall a. a -> a
id
class HasURIError e where fromURIError :: URIError -> e
instance HasURIError URIError where fromURIError :: URIError -> URIError
fromURIError = forall a. a -> a
id
instance Ord ParseError where
compare :: ParseError -> ParseError -> Ordering
compare ParseError
a ParseError
b = forall a. Ord a => a -> a -> Ordering
compare (forall a. Show a => a -> [Char]
show ParseError
a) (forall a. Show a => a -> [Char]
show ParseError
b)