{-# 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 -> String
showURI (URI {String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriFragment :: String
uriQuery :: String
uriPath :: String
uriAuthority :: Maybe URIAuth
uriScheme :: String
..}) =
String
"URI {uriScheme = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
uriScheme String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
", uriAuthority = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe URIAuth -> String
forall a. Show a => a -> String
show Maybe URIAuth
uriAuthority String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
", uriPath = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
uriPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
", uriQuery = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
uriQuery String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
", uriFragment = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
uriFragment String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}"
parseURI' :: (HasURIError e, MonadError e m) => String -> m URI
parseURI' :: String -> m URI
parseURI' String
s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m URI
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m URI) -> e -> m URI
forall a b. (a -> b) -> a -> b
$ URIError -> e
forall e. HasURIError e => URIError -> e
fromURIError (URIError -> e) -> URIError -> e
forall a b. (a -> b) -> a -> b
$ String -> String -> URIError
URIParseError String
"parseURI" String
s) URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe URI
parseURI String
s)
parseURIReference' :: (HasURIError e, MonadError e m) => String -> m URI
parseURIReference' :: String -> m URI
parseURIReference' String
s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m URI
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m URI) -> e -> m URI
forall a b. (a -> b) -> a -> b
$ URIError -> e
forall e. HasURIError e => URIError -> e
fromURIError (URIError -> e) -> URIError -> e
forall a b. (a -> b) -> a -> b
$ String -> String -> URIError
URIParseError String
"parseURIReference" String
s) URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe URI
parseURIReference String
s)
parseAbsoluteURI' :: (HasURIError e, MonadError e m) => String -> m URI
parseAbsoluteURI' :: String -> m URI
parseAbsoluteURI' String
s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m URI
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m URI) -> e -> m URI
forall a b. (a -> b) -> a -> b
$ URIError -> e
forall e. HasURIError e => URIError -> e
fromURIError (URIError -> e) -> URIError -> e
forall a b. (a -> b) -> a -> b
$ String -> String -> URIError
URIParseError String
"parseAbsoluteURI" String
s) URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe URI
parseAbsoluteURI String
s)
parseRelativeReference' :: (HasURIError e, MonadError e m) => String -> m URI
parseRelativeReference' :: String -> m URI
parseRelativeReference' String
s = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m URI
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e -> m URI) -> e -> m URI
forall a b. (a -> b) -> a -> b
$ URIError -> e
forall e. HasURIError e => URIError -> e
fromURIError (URIError -> e) -> URIError -> e
forall a b. (a -> b) -> a -> b
$ String -> String -> URIError
URIParseError String
"parseRelativeReference" String
s) URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe URI
parseRelativeReference String
s)
parseURIUnsafe :: String -> URI
parseURIUnsafe :: String -> URI
parseURIUnsafe String
s = URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe (String -> URI
forall a. HasCallStack => String -> a
error (String
"parseURIUnsafe " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s)) (Maybe URI -> URI) -> Maybe URI -> URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URI
parseURIReference String
s
data URIError =
URIParseError String String
| URIAppendError URI URI
deriving (URIError -> URIError -> Bool
(URIError -> URIError -> Bool)
-> (URIError -> URIError -> Bool) -> Eq URIError
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
Eq URIError
-> (URIError -> URIError -> Ordering)
-> (URIError -> URIError -> Bool)
-> (URIError -> URIError -> Bool)
-> (URIError -> URIError -> Bool)
-> (URIError -> URIError -> Bool)
-> (URIError -> URIError -> URIError)
-> (URIError -> URIError -> URIError)
-> Ord 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
$cp1Ord :: Eq URIError
Ord, Int -> URIError -> String -> String
[URIError] -> String -> String
URIError -> String
(Int -> URIError -> String -> String)
-> (URIError -> String)
-> ([URIError] -> String -> String)
-> Show URIError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [URIError] -> String -> String
$cshowList :: [URIError] -> String -> String
show :: URIError -> String
$cshow :: URIError -> String
showsPrec :: Int -> URIError -> String -> String
$cshowsPrec :: Int -> URIError -> String -> String
Show)
appendURI :: MonadError URIError m => URI -> URI -> m URI
appendURI :: URI -> URI -> m URI
appendURI (URI String
scheme Maybe URIAuth
auth String
path1 String
"" String
"") (URI String
"" Maybe URIAuth
Nothing String
path2 String
query String
fragment) = URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return (URI -> m URI) -> URI -> m URI
forall a b. (a -> b) -> a -> b
$ String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
scheme Maybe URIAuth
auth (String
path1 String -> String -> String
</> String
path2) String
query String
fragment
appendURI URI
a URI
b = URIError -> m URI
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 :: t URI -> m URI
appendURIs t URI
uris = (URI -> URI -> m URI) -> URI -> t URI -> m URI
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM URI -> URI -> m URI
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 :: String
uriPath = String -> String
takeDirectory (String -> String
dropTrailingPathSeparator (URI -> String
uriPath URI
uri))}
prop_append_singleton :: URI -> Bool
prop_append_singleton :: URI -> Bool
prop_append_singleton URI
uri = [URI] -> Either URIError URI
forall (t :: * -> *) (m :: * -> *).
(Foldable t, MonadError URIError m) =>
t URI -> m URI
appendURIs [URI
uri] Either URIError URI -> Either URIError URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI -> Either URIError URI
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 = String -> Maybe URI
parseURIReference (URI -> String
forall a. Show a => a -> String
show URI
uri) Maybe URI -> Maybe URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI -> Maybe URI
forall a. a -> Maybe a
Just URI
uri
newtype URI' = URI' String deriving (ReadPrec [URI']
ReadPrec URI'
Int -> ReadS URI'
ReadS [URI']
(Int -> ReadS URI')
-> ReadS [URI'] -> ReadPrec URI' -> ReadPrec [URI'] -> Read 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' -> String -> String
[URI'] -> String -> String
URI' -> String
(Int -> URI' -> String -> String)
-> (URI' -> String) -> ([URI'] -> String -> String) -> Show URI'
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [URI'] -> String -> String
$cshowList :: [URI'] -> String -> String
show :: URI' -> String
$cshow :: URI' -> String
showsPrec :: Int -> URI' -> String -> String
$cshowsPrec :: Int -> URI' -> String -> String
Show, URI' -> URI' -> Bool
(URI' -> URI' -> Bool) -> (URI' -> URI' -> Bool) -> Eq URI'
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'
Eq URI'
-> (URI' -> URI' -> Ordering)
-> (URI' -> URI' -> Bool)
-> (URI' -> URI' -> Bool)
-> (URI' -> URI' -> Bool)
-> (URI' -> URI' -> Bool)
-> (URI' -> URI' -> URI')
-> (URI' -> URI' -> URI')
-> Ord 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
$cp1Ord :: Eq URI'
Ord)
readURI' :: String -> Maybe URI'
readURI' :: String -> Maybe URI'
readURI' String
s = Maybe URI' -> (URI -> Maybe URI') -> Maybe URI -> Maybe URI'
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe URI'
forall a. Maybe a
Nothing (Maybe URI' -> URI -> Maybe URI'
forall a b. a -> b -> a
const (URI' -> Maybe URI'
forall a. a -> Maybe a
Just (String -> URI'
URI' String
s))) (String -> Maybe URI
parseURIReference String
s)
fromURI' :: URI' -> URI
fromURI' :: URI' -> URI
fromURI' (URI' String
s) = Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
parseURI String
s)
toURI' :: URI -> URI'
toURI' :: URI -> URI'
toURI' = String -> URI'
URI' (String -> URI') -> (URI -> String) -> URI -> URI'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
forall a. Show a => a -> String
show
uriToString' :: URI -> String
uriToString' :: URI -> String
uriToString' URI
uri = (String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
uri String
""
class HasParseError e where fromParseError :: ParseError -> e
instance HasParseError ParseError where fromParseError :: ParseError -> ParseError
fromParseError = ParseError -> ParseError
forall a. a -> a
id
class HasURIError e where fromURIError :: URIError -> e
instance HasURIError URIError where fromURIError :: URIError -> URIError
fromURIError = URIError -> URIError
forall a. a -> a
id
instance Ord ParseError where
compare :: ParseError -> ParseError -> Ordering
compare ParseError
a ParseError
b = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ParseError -> String
forall a. Show a => a -> String
show ParseError
a) (ParseError -> String
forall a. Show a => a -> String
show ParseError
b)