module Network.URL
( URL(..), URLType(..), Host(..), Protocol(..)
, secure, secure_prot
, exportURL, importURL, exportHost
, add_param
, decString, encString
, ok_host, ok_url, ok_param, ok_path
, exportParams, importParams
) where
import Data.Char (isAlpha, isAscii, isDigit)
import Data.List (intersperse)
import Data.Word (Word8)
import Numeric (readHex, showHex)
import qualified Codec.Binary.UTF8.String as UTF8
data Host = Host { Host -> Protocol
protocol :: Protocol
, Host -> String
host :: String
, Host -> Maybe Integer
port :: Maybe Integer
} deriving (Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Eq,Eq Host
Eq Host
-> (Host -> Host -> Ordering)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Bool)
-> (Host -> Host -> Host)
-> (Host -> Host -> Host)
-> Ord Host
Host -> Host -> Bool
Host -> Host -> Ordering
Host -> Host -> Host
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 :: Host -> Host -> Host
$cmin :: Host -> Host -> Host
max :: Host -> Host -> Host
$cmax :: Host -> Host -> Host
>= :: Host -> Host -> Bool
$c>= :: Host -> Host -> Bool
> :: Host -> Host -> Bool
$c> :: Host -> Host -> Bool
<= :: Host -> Host -> Bool
$c<= :: Host -> Host -> Bool
< :: Host -> Host -> Bool
$c< :: Host -> Host -> Bool
compare :: Host -> Host -> Ordering
$ccompare :: Host -> Host -> Ordering
Ord,Int -> Host -> ShowS
[Host] -> ShowS
Host -> String
(Int -> Host -> ShowS)
-> (Host -> String) -> ([Host] -> ShowS) -> Show Host
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Host] -> ShowS
$cshowList :: [Host] -> ShowS
show :: Host -> String
$cshow :: Host -> String
showsPrec :: Int -> Host -> ShowS
$cshowsPrec :: Int -> Host -> ShowS
Show)
data Protocol = HTTP Bool | FTP Bool | RawProt String deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq,Eq Protocol
Eq Protocol
-> (Protocol -> Protocol -> Ordering)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Protocol)
-> (Protocol -> Protocol -> Protocol)
-> Ord Protocol
Protocol -> Protocol -> Bool
Protocol -> Protocol -> Ordering
Protocol -> Protocol -> Protocol
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 :: Protocol -> Protocol -> Protocol
$cmin :: Protocol -> Protocol -> Protocol
max :: Protocol -> Protocol -> Protocol
$cmax :: Protocol -> Protocol -> Protocol
>= :: Protocol -> Protocol -> Bool
$c>= :: Protocol -> Protocol -> Bool
> :: Protocol -> Protocol -> Bool
$c> :: Protocol -> Protocol -> Bool
<= :: Protocol -> Protocol -> Bool
$c<= :: Protocol -> Protocol -> Bool
< :: Protocol -> Protocol -> Bool
$c< :: Protocol -> Protocol -> Bool
compare :: Protocol -> Protocol -> Ordering
$ccompare :: Protocol -> Protocol -> Ordering
Ord,Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show)
secure_prot :: Protocol -> Bool
secure_prot :: Protocol -> Bool
secure_prot (HTTP Bool
s) = Bool
s
secure_prot (FTP Bool
s) = Bool
s
secure_prot (RawProt String
_) = Bool
False
secure :: Host -> Bool
secure :: Host -> Bool
secure = Protocol -> Bool
secure_prot (Protocol -> Bool) -> (Host -> Protocol) -> Host -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Protocol
protocol
data URLType = Absolute Host
| HostRelative
| PathRelative
deriving (URLType -> URLType -> Bool
(URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool) -> Eq URLType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URLType -> URLType -> Bool
$c/= :: URLType -> URLType -> Bool
== :: URLType -> URLType -> Bool
$c== :: URLType -> URLType -> Bool
Eq, Eq URLType
Eq URLType
-> (URLType -> URLType -> Ordering)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> Bool)
-> (URLType -> URLType -> URLType)
-> (URLType -> URLType -> URLType)
-> Ord URLType
URLType -> URLType -> Bool
URLType -> URLType -> Ordering
URLType -> URLType -> URLType
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 :: URLType -> URLType -> URLType
$cmin :: URLType -> URLType -> URLType
max :: URLType -> URLType -> URLType
$cmax :: URLType -> URLType -> URLType
>= :: URLType -> URLType -> Bool
$c>= :: URLType -> URLType -> Bool
> :: URLType -> URLType -> Bool
$c> :: URLType -> URLType -> Bool
<= :: URLType -> URLType -> Bool
$c<= :: URLType -> URLType -> Bool
< :: URLType -> URLType -> Bool
$c< :: URLType -> URLType -> Bool
compare :: URLType -> URLType -> Ordering
$ccompare :: URLType -> URLType -> Ordering
Ord, Int -> URLType -> ShowS
[URLType] -> ShowS
URLType -> String
(Int -> URLType -> ShowS)
-> (URLType -> String) -> ([URLType] -> ShowS) -> Show URLType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URLType] -> ShowS
$cshowList :: [URLType] -> ShowS
show :: URLType -> String
$cshow :: URLType -> String
showsPrec :: Int -> URLType -> ShowS
$cshowsPrec :: Int -> URLType -> ShowS
Show)
data URL = URL
{ URL -> URLType
url_type :: URLType
, URL -> String
url_path :: String
, URL -> [(String, String)]
url_params :: [(String,String)]
} deriving (URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq,Eq URL
Eq URL
-> (URL -> URL -> Ordering)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> URL)
-> (URL -> URL -> URL)
-> Ord URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
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 :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord,Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show)
add_param :: URL -> (String,String) -> URL
add_param :: URL -> (String, String) -> URL
add_param URL
url (String, String)
x = URL
url { url_params :: [(String, String)]
url_params = (String, String)
x (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: URL -> [(String, String)]
url_params URL
url }
importURL :: String -> Maybe URL
importURL :: String -> Maybe URL
importURL String
cs0 =
do (URLType
ho,String
cs5) <- String -> Maybe (URLType, String)
front String
cs0
(String
pa,String
cs6) <- String -> Maybe (String, String)
the_path String
cs5
[(String, String)]
as <- String -> Maybe [(String, String)]
the_args String
cs6
URL -> Maybe URL
forall (m :: * -> *) a. Monad m => a -> m a
return URL :: URLType -> String -> [(String, String)] -> URL
URL { url_type :: URLType
url_type = URLType
ho, url_path :: String
url_path = String
pa, url_params :: [(String, String)]
url_params = [(String, String)]
as }
where
front :: String -> Maybe (URLType, String)
front (Char
'/':String
cs) = (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (URLType
HostRelative,String
cs)
front String
cs =
case String -> Maybe (Protocol, String)
the_prot String
cs of
Just (Protocol
pr,String
cs1) ->
do let (String
ho,String
cs2) = String -> (String, String)
the_host String
cs1
(Maybe Integer
po,String
cs3) <- String -> Maybe (Maybe Integer, String)
forall {a}. Read a => String -> Maybe (Maybe a, String)
the_port String
cs2
String
cs4 <- case String
cs3 of
[] -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return []
Char
'/':String
cs5 -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs5
String
_ -> Maybe String
forall a. Maybe a
Nothing
(URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Host -> URLType
Absolute Host :: Protocol -> String -> Maybe Integer -> Host
Host { protocol :: Protocol
protocol = Protocol
pr
, host :: String
host = String
ho
, port :: Maybe Integer
port = Maybe Integer
po
}, String
cs4)
Maybe (Protocol, String)
_ -> (URLType, String) -> Maybe (URLType, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (URLType
PathRelative,String
cs)
the_prot :: String -> Maybe (Protocol, String)
the_prot :: String -> Maybe (Protocol, String)
the_prot String
urlStr = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
urlStr of
(as :: String
as@(Char
_:String
_), Char
':' : Char
'/' : Char
'/' : String
bs) -> (Protocol, String) -> Maybe (Protocol, String)
forall a. a -> Maybe a
Just (Protocol
prot, String
bs)
where prot :: Protocol
prot = case String
as of
String
"https" -> Bool -> Protocol
HTTP Bool
True
String
"http" -> Bool -> Protocol
HTTP Bool
False
String
"ftps" -> Bool -> Protocol
FTP Bool
True
String
"ftp" -> Bool -> Protocol
FTP Bool
False
String
_ -> String -> Protocol
RawProt String
as
(String, String)
_ -> Maybe (Protocol, String)
forall a. Maybe a
Nothing
the_host :: String -> (String, String)
the_host = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
ok_host
the_port :: String -> Maybe (Maybe a, String)
the_port (Char
':':String
cs) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
cs of
([],String
_) -> Maybe (Maybe a, String)
forall a. Maybe a
Nothing
(String
xs,String
ds) -> (Maybe a, String) -> Maybe (Maybe a, String)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just (String -> a
forall a. Read a => String -> a
read String
xs),String
ds)
the_port String
cs5 = (Maybe a, String) -> Maybe (Maybe a, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, String
cs5)
the_path :: String -> Maybe (String, String)
the_path String
cs = do let (String
as,String
bs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
end_path String
cs
String
s <- Bool -> String -> Maybe String
decString Bool
False String
as
(String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s,String
bs)
where end_path :: Char -> Bool
end_path Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
the_args :: String -> Maybe [(String, String)]
the_args (Char
'?' : String
cs) = String -> Maybe [(String, String)]
importParams String
cs
the_args String
_ = [(String, String)] -> Maybe [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
importParams :: String -> Maybe [(String,String)]
importParams :: String -> Maybe [(String, String)]
importParams [] = [(String, String)] -> Maybe [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
importParams String
ds = (String -> Maybe (String, String))
-> [String] -> Maybe [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Maybe (String, String)
a_param ((Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
breaks (Char
'&'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
ds)
where
a_param :: String -> Maybe (String, String)
a_param String
cs = do let (String
as,String
bs) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
'=' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
cs
String
k <- Bool -> String -> Maybe String
decString Bool
True String
as
String
v <- case String
bs of
String
"" -> String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Char
_:String
xs -> Bool -> String -> Maybe String
decString Bool
True String
xs
(String, String) -> Maybe (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
k,String
v)
exportHost :: Host -> String
exportHost :: Host -> String
exportHost Host
absol = String
the_prot String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Host -> String
host Host
absol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_port
where the_prot :: String
the_prot = Protocol -> String
exportProt (Host -> Protocol
protocol Host
absol)
the_port :: String
the_port = String -> (Integer -> String) -> Maybe Integer -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Integer
x -> Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
x) (Host -> Maybe Integer
port Host
absol)
exportProt :: Protocol -> String
exportProt :: Protocol -> String
exportProt Protocol
prot = case Protocol
prot of
HTTP Bool
True -> String
"https"
HTTP Bool
False -> String
"http"
FTP Bool
True -> String
"ftps"
FTP Bool
False -> String
"ftp"
RawProt String
s -> String
s
exportURL :: URL -> String
exportURL :: URL -> String
exportURL URL
url = String
absol String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
the_params
where
absol :: String
absol = case URL -> URLType
url_type URL
url of
Absolute Host
hst -> Host -> String
exportHost Host
hst String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
URLType
HostRelative -> String
"/"
URLType
PathRelative -> String
""
the_path :: String
the_path = Bool -> (Char -> Bool) -> ShowS
encString Bool
False Char -> Bool
ok_path (URL -> String
url_path URL
url)
the_params :: String
the_params = case URL -> [(String, String)]
url_params URL
url of
[] -> String
""
[(String, String)]
xs -> Char
'?' Char -> ShowS
forall a. a -> [a] -> [a]
: [(String, String)] -> String
exportParams [(String, String)]
xs
exportParams :: [(String,String)] -> String
exportParams :: [(String, String)] -> String
exportParams [(String, String)]
ps = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"&" ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
a_param [(String, String)]
ps)
where
a_param :: (String, String) -> String
a_param (String
k,String
mv) = Bool -> (Char -> Bool) -> ShowS
encString Bool
True Char -> Bool
ok_param String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++
case String
mv of
String
"" -> String
""
String
v -> Char
'=' Char -> ShowS
forall a. a -> [a] -> [a]
: Bool -> (Char -> Bool) -> ShowS
encString Bool
True Char -> Bool
ok_param String
v
encString :: Bool -> (Char -> Bool) -> String -> String
encString :: Bool -> (Char -> Bool) -> ShowS
encString Bool
pl Char -> Bool
p String
ys = (Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
enc1 [] String
ys
where enc1 :: Char -> ShowS
enc1 Char
' ' String
xs | Bool
pl = Char
'+' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
enc1 Char
x String
xs = if Char -> Bool
p Char
x then Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs else Char -> String
encChar Char
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs
encChar :: Char -> String
encChar :: Char -> String
encChar Char
c = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
encByte (String -> [Word8]
UTF8.encode [Char
c])
encByte :: Word8 -> String
encByte :: Word8 -> String
encByte Word8
b = Char
'%' Char -> ShowS
forall a. a -> [a] -> [a]
: case Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
b String
"" of
d :: String
d@[Char
_] -> Char
'0' Char -> ShowS
forall a. a -> [a] -> [a]
: String
d
String
d -> String
d
decString :: Bool -> String -> Maybe String
decString :: Bool -> String -> Maybe String
decString Bool
b = ([Word8] -> String) -> Maybe [Word8] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> String
UTF8.decode (Maybe [Word8] -> Maybe String)
-> (String -> Maybe [Word8]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> Maybe [Word8]
decStrBytes Bool
b
decStrBytes :: Bool -> String -> Maybe [Word8]
decStrBytes :: Bool -> String -> Maybe [Word8]
decStrBytes Bool
_ [] = [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just []
decStrBytes Bool
p (Char
'%' : String
cs) = do (Word8
n,String
cs1) <- String -> Maybe (Word8, String)
decByte String
cs
([Word8] -> [Word8]) -> Maybe [Word8] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8
nWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:) (Bool -> String -> Maybe [Word8]
decStrBytes Bool
p String
cs1)
decStrBytes Bool
p (Char
c : String
cs) = let b :: Word8
b = if Bool
p Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
then Word8
32
else Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c)
in (Word8
b Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:) ([Word8] -> [Word8]) -> Maybe [Word8] -> Maybe [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Bool -> String -> Maybe [Word8]
decStrBytes Bool
p String
cs
decByte :: String -> Maybe (Word8,String)
decByte :: String -> Maybe (Word8, String)
decByte (Char
x : Char
y : String
cs) = case ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
x,Char
y] of
[(Word8
n,String
"")] -> (Word8, String) -> Maybe (Word8, String)
forall a. a -> Maybe a
Just (Word8
n,String
cs)
[(Word8, String)]
_ -> Maybe (Word8, String)
forall a. Maybe a
Nothing
decByte String
_ = Maybe (Word8, String)
forall a. Maybe a
Nothing
ok_host :: Char -> Bool
ok_host :: Char -> Bool
ok_host Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaASCII Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
ok_param :: Char -> Bool
ok_param :: Char -> Bool
ok_param Char
c = Char -> Bool
ok_host Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"~;:@$_!*'(),"
ok_path :: Char -> Bool
ok_path :: Char -> Bool
ok_path Char
c = Char -> Bool
ok_param Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/=&"
ok_url :: Char -> Bool
ok_url :: Char -> Bool
ok_url Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaASCII Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
".-;:@$_!*'(),/=&?~+"
isAlphaASCII :: Char -> Bool
isAlphaASCII :: Char -> Bool
isAlphaASCII Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x
breaks :: (a -> Bool) -> [a] -> [[a]]
breaks :: forall a. (a -> Bool) -> [a] -> [[a]]
breaks a -> Bool
p [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs of
([a]
as,[]) -> [[a]
as]
([a]
as,a
_:[a]
bs) -> [a]
as [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
breaks a -> Bool
p [a]
bs