    --------------------------------------------------------------------------------
    -- |
    -- Module      : Network.URL
    -- Copyright   : (c) Galois, Inc. 2007, 2008
    -- License     : BSD3
    --
    -- Maintainer  : Iavor S. Diatchki
    -- Stability   : Provisional
    -- Portability : Portable
    --
    -- Provides a convenient way for working with HTTP URLs.
    -- Based on RFC 1738.
    -- See also: RFC 3986

    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

    -- | Contains information about the connection to the host.
    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
    $c== :: Host -> Host -> Bool
    == :: Host -> Host -> Bool
    $c/= :: Host -> Host -> Bool
    /= :: 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
    $ccompare :: Host -> Host -> Ordering
    compare :: Host -> Host -> Ordering
    $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
    >= :: Host -> Host -> Bool
    $cmax :: Host -> Host -> Host
    max :: Host -> Host -> Host
    $cmin :: Host -> Host -> Host
    min :: Host -> Host -> Host
    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
    $cshowsPrec :: Int -> Host -> ShowS
    showsPrec :: Int -> Host -> ShowS
    $cshow :: Host -> String
    show :: Host -> String
    $cshowList :: [Host] -> ShowS
    showList :: [Host] -> ShowS
    Show)

    -- | The type of known protocols.
    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
    $c== :: Protocol -> Protocol -> Bool
    == :: Protocol -> Protocol -> Bool
    $c/= :: Protocol -> Protocol -> Bool
    /= :: 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
    $ccompare :: Protocol -> Protocol -> Ordering
    compare :: Protocol -> Protocol -> Ordering
    $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
    >= :: Protocol -> Protocol -> Bool
    $cmax :: Protocol -> Protocol -> Protocol
    max :: Protocol -> Protocol -> Protocol
    $cmin :: Protocol -> Protocol -> Protocol
    min :: Protocol -> Protocol -> Protocol
    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
    $cshowsPrec :: Int -> Protocol -> ShowS
    showsPrec :: Int -> Protocol -> ShowS
    $cshow :: Protocol -> String
    show :: Protocol -> String
    $cshowList :: [Protocol] -> ShowS
    showList :: [Protocol] -> ShowS
    Show)

    -- | Is this a \"secure\" protocol.  This works only for known protocols,
    -- for 'RawProt' values we return 'False'.
    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

    -- | Does this host use a \"secure\" protocol (e.g., https).
    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

    -- | Different types of URL.
    data URLType  = Absolute Host       -- ^ Has a host
                  | HostRelative        -- ^ Does not have a host
                  | PathRelative        -- ^ Relative to another URL
                    deriving (URLType -> URLType -> Bool
    (URLType -> URLType -> Bool)
    -> (URLType -> URLType -> Bool) -> Eq URLType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: URLType -> URLType -> Bool
    == :: URLType -> URLType -> Bool
    $c/= :: URLType -> URLType -> Bool
    /= :: 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
    $ccompare :: URLType -> URLType -> Ordering
    compare :: URLType -> URLType -> Ordering
    $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
    >= :: URLType -> URLType -> Bool
    $cmax :: URLType -> URLType -> URLType
    max :: URLType -> URLType -> URLType
    $cmin :: URLType -> URLType -> URLType
    min :: URLType -> URLType -> URLType
    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
    $cshowsPrec :: Int -> URLType -> ShowS
    showsPrec :: Int -> URLType -> ShowS
    $cshow :: URLType -> String
    show :: URLType -> String
    $cshowList :: [URLType] -> ShowS
    showList :: [URLType] -> ShowS
    Show)

    -- | A type for working with URL.
    -- The parameters are in @application\/x-www-form-urlencoded@ format:
    -- <http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1>
    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
    $c== :: URL -> URL -> Bool
    == :: URL -> URL -> Bool
    $c/= :: URL -> URL -> Bool
    /= :: 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
    $ccompare :: URL -> URL -> Ordering
    compare :: URL -> URL -> Ordering
    $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
    >= :: URL -> URL -> Bool
    $cmax :: URL -> URL -> URL
    max :: URL -> URL -> URL
    $cmin :: URL -> URL -> URL
    min :: URL -> URL -> URL
    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
    $cshowsPrec :: Int -> URL -> ShowS
    showsPrec :: Int -> URL -> ShowS
    $cshow :: URL -> String
    show :: URL -> String
    $cshowList :: [URL] -> ShowS
    showList :: [URL] -> ShowS
    Show)

    -- | Add a (key,value) parameter to a URL.
    add_param :: URL -> (String,String) -> URL
    add_param :: URL -> (String, String) -> URL
    add_param URL
    url (String, String)
    x = URL
    url { url_params = x : url_params url }

    -- | Convert a list of \"bytes\" to a URL.
    importURL :: String -> Maybe URL
    importURL :: String -> Maybe URL
    importURL String
    cs0 =
      do (ho,cs5) <- String -> Maybe (URLType, String)
    front String
    cs0
         (pa,cs6) <- the_path cs5
         as       <- the_args cs6
         return URL { url_type = ho, url_path = pa, url_params = as }

      where
      front :: String -> Maybe (URLType, String)
    front (Char
    '/':String
    cs)  = (URLType, String) -> Maybe (URLType, String)
    forall a. a -> Maybe a
    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
               (po,cs3) <- String -> Maybe (Maybe Integer, String)
    forall {a}. Read a => String -> Maybe (Maybe a, String)
    the_port String
    cs2
               cs4 <- case cs3 of
                        [] -> String -> Maybe String
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                        Char
    '/':String
    cs5 -> String -> Maybe String
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    cs5
                        String
    _ -> Maybe String
    forall a. Maybe a
    Nothing
               return (Absolute Host { protocol = pr
                                     , host = ho
                                     , port = po
                                     }, cs4)
          Maybe (Protocol, String)
    _ -> (URLType, String) -> Maybe (URLType, String)
    forall a. a -> Maybe a
    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 a. a -> Maybe a
    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
                       s <- Bool -> String -> Maybe String
    decString Bool
    False String
    as
                       return (s,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 a. a -> Maybe a
    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 a. a -> Maybe a
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
                      k <- Bool -> String -> Maybe String
    decString Bool
    True String
    as
                      v <- case bs of
                             String
    "" -> String -> Maybe String
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
                             Char
    _:String
    xs -> Bool -> String -> Maybe String
    decString Bool
    True String
    xs
                      return (k,v)

    -- | Convert the host part of a URL to a list of \"bytes\".
    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)

    -- | Convert the host part of a URL to a list of \"bytes\".
    -- WARNING: We output \"raw\" protocols as they are.
    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

    -- | Convert a URL to a list of \"bytes\".
    -- We represent non-ASCII characters using UTF8.
    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

    -- | Convert a string to bytes by escaping the characters that
    -- do not satisfy the input predicate.  The first argument specifies
    -- if we should replace spaces with +.
    encString :: Bool -> (Char -> Bool) -> String -> String
    encString :: Bool -> (Char -> Bool) -> ShowS
    encString Bool
    pl Char -> Bool
    p String
    ys = (Char -> ShowS) -> String -> ShowS
    forall a b. (a -> b -> b) -> b -> [a] -> b
    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

    -- | %-encode a character. Uses UTF8 to represent characters as bytes.
    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])

    -- | %-encode a byte.
    encByte :: Word8 -> String
    encByte :: Word8 -> String
    encByte Word8
    b = Char
    '%' Char -> ShowS
    forall a. a -> [a] -> [a]
    : case Word8 -> ShowS
    forall a. Integral 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

    -- | Decode a list of \"bytes\" to a string.
    -- Performs % and UTF8 decoding.
    decString :: Bool -> String -> Maybe String
    decString :: Bool -> String -> Maybe String
    decString Bool
    b = ([Word8] -> String) -> Maybe [Word8] -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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

    -- Convert a list of \"bytes\" to actual bytes.
    -- Performs %-decoding.  The boolean specifies if we should turn pluses into
    -- spaces.
    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 (n,cs1) <- String -> Maybe (Word8, String)
    decByte String
    cs
                                   fmap (n:) (decStrBytes p 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    -- space
                                           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 a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Bool -> String -> Maybe [Word8]
    decStrBytes Bool
    p String
    cs
                                -- truncates "large bytes".

    -- | Parse a percent-encoded byte.
    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

    -- Classification of characters.
    -- Note that these only return True for ASCII characters; this is important.
    --------------------------------------------------------------------------------
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "~;:@$_!*'(),"

    -- | Characters that can appear non % encoded in the path part of the URL
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "/=&"

    -- XXX: others? check RFC
    -- | Characters that do not need to be encoded in URL
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    ".-;:@$_!*'(),/=&?~+"

    -- Misc
    --------------------------------------------------------------------------------
    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