packages feed

hurl 0.1.0.0 → 1.0.0.0

raw patch · 5 files changed

+103/−16 lines, 5 files

Files

hurl.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.0+version:             1.0.0.0  -- A short (one-line) description of the package. synopsis:            Haskell URL resolver@@ -72,7 +72,7 @@   exposed-modules:     Network.URI.Charset, Network.URI.Fetch      -- Modules included in this library but not exported.-  -- other-modules:       +  other-modules:       Network.URI.Locale, Network.URI.Messages      -- LANGUAGE extensions used by modules in this package.   -- other-extensions:
src/Network/URI/Charset.hs view
@@ -1,27 +1,39 @@ {-# LANGUAGE OverloadedStrings #-}-module Network.URI.Charset(resolveCharset, convertCharset) where++-- | Handles server-specified text decoding.+module Network.URI.Charset(resolveCharset, convertCharset, charsets) where import           Data.Text (Text) import           Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as B import           Data.Text.Encoding+import           Debug.Trace (trace) -resolveCharset :: [String] -> ByteString -> (String, Either Text ByteString)+-- | If the MIMEtype specifies a charset parameter, apply it.+resolveCharset :: [String] -- ^ The MIMEtype, split by ';'+    -> ByteString -- ^ The bytes received from the server+    -> (String, Either Text ByteString) -- ^ The MIMEtype (minus parameters) & possibly decoded text, to be returned from protocol handlers. resolveCharset (mime:('c':'h':'a':'r':'s':'e':'t':'=':charset):_) response =     (mime, Left $ convertCharset charset $ B.toStrict response) resolveCharset (mime:_:params) response = resolveCharset (mime:params) response resolveCharset [mime] response = (mime, Right $ response) resolveCharset [] response = ("text/plain", Left "Filetype unspecified") +-- | Decodes bytes according to a charset identified by it's IANA-assigned name(s). convertCharset "iso-8859-1" = decodeLatin1 convertCharset "latin1" = decodeLatin1-convertCharset "us-ascii" = decodeUtf8-convertCharset "utf-8" = decodeUtf8-convertCharset "utf-16be" = decodeUtf16BE-convertCharset "utf-16le" = decodeUtf16LE-convertCharset "utf-16" = decodeUtf16LE-convertCharset "utf-32be" = decodeUtf32BE-convertCharset "utf-32le" = decodeUtf32LE-convertCharset "utf-32" = decodeUtf32LE-convertCharset _ = \_ -> "Unsupported text encoding!"+convertCharset "us-ascii" = decodeUtf8With replaceChar+convertCharset "utf-8" = decodeUtf8With replaceChar+convertCharset "utf-16be" = decodeUtf16BEWith replaceChar+convertCharset "utf-16le" = decodeUtf16LEWith replaceChar+convertCharset "utf-16" = decodeUtf16LEWith replaceChar+convertCharset "utf-32be" = decodeUtf32BEWith replaceChar+convertCharset "utf-32le" = decodeUtf32LEWith replaceChar+convertCharset "utf-32" = decodeUtf32LEWith replaceChar+convertCharset charset = -- FIXME Is this the best fallback for unsupported charsets?+    trace ("Unsupported text encoding" ++ charset) $ decodeUtf8With replaceChar++replaceChar error _ = trace error $ Just '�'++-- | Lists all charsets supported by convertCharset charsets :: [Text] charsets = ["iso-8859-1", "latin1", "us-ascii", "utf-8", "utf-16be", "utf-16le", "utf-16", "utf-32be", "utf-32le", "utf-32"]
src/Network/URI/Fetch.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-module Network.URI.Fetch(Session(..), newSession, fetchURL) where+-- | Retrieves documents for a URL, supporting multiple URL schemes that can be+-- disabled at build-time for reduced dependencies.+module Network.URI.Fetch(Session, locale, newSession, fetchURL) where+ import qualified Data.Text as Txt import           Data.Text (Text) import           Network.URI@@ -21,14 +24,19 @@ #endif  import Network.URI.Locale+import Network.URI.Messages +-- | Data shared accross multiple URI requests. data Session = Session {+    -- | The languages (RFC2616-encoded) to which responses should be localized.     locale :: [String], #ifdef WITH_HTTP_URI     managerHTTP :: HTTP.Manager #endif } +-- | Initializes a default Session object to support HTTPS & Accept-Language+-- if HTTP is enabled. newSession :: IO Session newSession = do     locale' <- rfc2616Locale@@ -42,7 +50,11 @@ #endif     } -fetchURL :: Session -> [String] -> URI -> IO (String, Either Text ByteString)+-- | Retrieves a URL-identified resource & it's MIMEtype, possibly decoding it's text.+fetchURL :: Session -- ^ The session of which this request is a part.+    -> [String] -- ^ The expected MIMEtypes in priority order.+    -> URI -- ^ The URL to retrieve+    -> IO (String, Either Text ByteString) -- ^ The MIMEtype & possibly text-decoded response. #ifdef WITH_HTTP_URI fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "https:"] = do     request <- HTTP.requestFromURI uri@@ -81,7 +93,8 @@         (mime, response) -> return (mime, Left $ Txt.pack response) #endif -fetchURL _ _ uri = return ("text/plain", Left $ Txt.concat ["Unsupported link type ", Txt.pack $ uriScheme uri])+fetchURL Session {locale = l} _ URI {uriScheme = scheme} =+    return ("text/plain", Left $ Txt.pack $ trans l $ UnsupportedScheme scheme)  #ifdef WITH_DATA_URI breakOn c (a:as) | c == a = ([], as)
+ src/Network/URI/Locale.hs view
@@ -0,0 +1,44 @@+-- | Internal module for retrieving languages to localize to.+module Network.URI.Locale(rfc2616Locale) where++import System.Environment (lookupEnv)+import Control.Monad (forM)+import Data.Maybe (mapMaybe)+import Data.Char (toLower)++--- This file is based on logic in GNOME's LibSoup & GLib.++-- | Returns the languages to which responses should be localized.+-- Retrieved from Gettext configuration & reformatted for use in the+-- HTTP Accept-Language request header.+rfc2616Locale :: IO [String]+rfc2616Locale = do+    locales <- forM ["LANGUAGE", "LC_ALL", "LC_MESSAGES", "LANG"] lookupEnv+    let locales' = mapMaybe toRFC2616Lang $ split ':' $ firstJust locales "en_US"+    return (locales' ++ [l | l <- extractLangs locales', l `notElem` locales'])++toRFC2616Lang "C" = Nothing+toRFC2616Lang ('C':'.':_) = Nothing+toRFC2616Lang ('C':'@':_) = Nothing+toRFC2616Lang lang = case toRFC2616Lang' lang of+    "" -> Nothing+    lang' -> Just lang'++toRFC2616Lang' ('_':cs) = '-' : toRFC2616Lang' cs+toRFC2616Lang' ('.':_) = []+toRFC2616Lang' ('@':_) = []+toRFC2616Lang' (c:cs) = toLower c : toRFC2616Lang' cs+toRFC2616Lang' [] = []++-- Makes sure to include the raw languages, and not just localized variants.+extractLangs (locale:locales) | (lang:_) <- split '-' locale = lang : extractLangs locales+extractLangs (_:locales) = extractLangs locales+extractLangs [] = []++firstJust (Just a:_) _ | a /= "" = a+firstJust (_:maybes) fallback = firstJust maybes fallback+firstJust [] fallback = fallback++split b (a:as) | a == b = [] : split b as+        | (head':tail') <- split b as = (a:head') : tail'+split _ [] = [[]]
+ src/Network/URI/Messages.hs view
@@ -0,0 +1,18 @@+-- | Module holding localized error messages to be presented as a response.+--+-- To localize error messages provided by HURL, provide your translations between+-- "BEGIN LOCALIZATION" & "END LOCALIZATION" in this file.+--+-- The lines are formatted:+--    trans ("LANG":_) (KEY) = "TRANSLATION"+-- with uppercase indicating the bits you fill in.+module Network.URI.Messages (trans, Errors(..)) where++--- BEGIN LOCALIZATION+trans ("en":_) (UnsupportedScheme scheme) = "Unsupported protocol " ++ scheme+--- END LOCALIZATION++trans (_:locales) err = trans locales err+trans [] err = trans ["en"] err++data Errors = UnsupportedScheme String