packages feed

hurl 1.1.0.0 → 1.2.0.0

raw patch · 5 files changed

+64/−10 lines, 5 filesdep ~base

Dependency ranges changed: base

Files

hurl.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             1.1.0.0+version:             1.2.0.0  -- A short (one-line) description of the package. synopsis:            Haskell URL resolver@@ -83,7 +83,7 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base >=4.9 && <4.10, text >= 1.2 && <1.3,+  build-depends:       base >=4.9 && <=4.12, text >= 1.2 && <1.3,                        network-uri >=2.6 && <2.7, bytestring >= 0.10 && < 0.11      -- Directories containing source files.@@ -104,4 +104,4 @@   if flag(freedesktop)     CPP-options:   -DWITH_XDG     build-depends: filepath, directory, process >= 1.2 && <2.0-    other-modules: Network.URI.XDG.Ini, Network.URI.XDG.MimeApps, Network.URI.XDG.DesktopEntry+    other-modules: Network.URI.XDG.Ini, Network.URI.XDG.MimeApps, Network.URI.XDG.DesktopEntry, Network.URI.XDG
src/Network/URI/Fetch.hs view
@@ -9,6 +9,7 @@ import           Network.URI import           Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as B+import           Control.Exception  #ifdef WITH_HTTP_URI import qualified Network.HTTP.Client as HTTP@@ -87,12 +88,20 @@         (response, (mimetype:_)) -> let mime = Txt.toLower $ convertCharset "utf-8" mimetype             in resolveCharset (map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" $ mime) response         (response, []) -> (defaultMIME, Right response)+  `catches` [+    Handler $ \e -> do return ("text/plain", Left $ Txt.pack $ trans (locale session) $ Http e),+    Handler $ \(ErrorCall msg) -> do return ("text/plain", Left $ Txt.pack msg)+  ] #endif  #ifdef WITH_FILE_URI-fetchURL _ (defaultMIME:_) uri@URI {uriScheme = "file:"} = do+fetchURL Session {locale = l} (defaultMIME:_) uri@URI {uriScheme = "file:"} = do     response <- B.readFile $ uriPath uri     return (defaultMIME, Right response)+  `catch` \e -> do+    return (+        "text/plain",+        Left $ Txt.pack $ trans l $ ReadFailed $ displayException (e :: IOException)) #endif  #ifdef WITH_DATA_URI@@ -123,11 +132,10 @@  dispatchByMIME :: Session -> String -> URI -> IO (Maybe String) #if WITH_XDG-dispatchByMIME Session {locale = l, apps = a} mime uri-    | canDispatchMIME a mime = dispatchURIByMIME l a uri mime-#endif-+dispatchByMIME Session {locale = l, apps = a} mime uri = dispatchURIByMIME l a uri mime+#else dispatchByMIME _ _ _ = return Nothing+#endif  #ifdef WITH_DATA_URI breakOn c (a:as) | c == a = ([], as)
src/Network/URI/Messages.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | Module holding localized error messages to be presented as a response. -- -- To localize error messages provided by HURL, provide your translations between@@ -6,14 +7,33 @@ -- The lines are formatted: --    trans ("LANG":_) (KEY) = "TRANSLATION" -- with uppercase indicating the bits you fill in.+--+-- Translations between #if WITH_HTTP_URI & #endif are specific to HTTP error handling. module Network.URI.Messages (trans, Errors(..)) where +#if WITH_HTTP_URI+import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))+import Control.Exception (displayException)+#endif+ --- BEGIN LOCALIZATION trans ("en":_) (UnsupportedScheme scheme) = "Unsupported protocol " ++ scheme trans ("en":_) (OpenedWith app) = "Opened in " ++ app+trans ("en":_) (ReadFailed msg) = "Failed to read file: " ++ msg+#if WITH_HTTP_URI+trans ("en":_) (Http (InvalidUrlException url msg)) = "Invalid URL " ++ url ++ ": " ++ msg+trans ("en":_) (Http (HttpExceptionRequest _ (TooManyRedirects _))) = "Too many redirects!"+trans ("en":_) (Http (HttpExceptionRequest _ ResponseTimeout)) = "The site took too long to respond!"+trans ("en":_) (Http (HttpExceptionRequest _ ConnectionTimeout)) = "The site took too long to connect!"+trans ("en":_) (Http (HttpExceptionRequest _ (ConnectionFailure err))) = "Could not connect: " ++ displayException err+trans ("en":_) (Http (HttpExceptionRequest _ _)) = "The site doesn't appear to speak the same language as me!"+#endif --- END LOCALIZATION  trans (_:locales) err = trans locales err trans [] err = trans ["en"] err -data Errors = UnsupportedScheme String | OpenedWith String+data Errors = UnsupportedScheme String | OpenedWith String | ReadFailed String+#if WITH_HTTP_URI+    | Http HttpException+#endif
+ src/Network/URI/XDG.hs view
@@ -0,0 +1,20 @@+module Network.URI.XDG(HandlersConfig, loadHandlers, canDispatchMIME, dispatchURIByMIME) where++import Network.URI (URI(..))+import Network.URI.XDG.DesktopEntry+import Network.URI.XDG.MimeApps++canDispatchMIME :: HandlersConfig -> String -> Bool+canDispatchMIME config mime = not $ null $ queryHandlers config mime++dispatchURIByMIME :: [String] -> HandlersConfig -> URI -> String -> IO (Maybe String)+dispatchURIByMIME locales config uri mime =+    queryHandlers config mime `mapFirstM` launchApp locales uri++mapFirstM :: [a] -> (a -> IO (Maybe b)) -> IO (Maybe b)+mapFirstM (x:xs) cb = do+    item <- cb x+    case item of+        Just _ -> return item+        Nothing -> mapFirstM xs cb+mapFirstM [] _ = return Nothing
src/Network/URI/XDG/MimeApps.hs view
@@ -2,6 +2,7 @@  import System.Environment (lookupEnv) import Control.Monad (forM)+import Control.Exception (catch) import System.FilePath import Data.List (nub, (\\)) import System.Directory (getHomeDirectory)@@ -16,8 +17,13 @@     dir0 <- mimeAppsDirs "XDG_CONFIG" ".config" "/etc/xdg"     dir1 <- mimeAppsDirs "XDG_DATA" ".local/share" "/usr/local/share/:/usr/share/"     let filepaths = mimeAppsFiles (dir0 ++ map (</> "applications") dir1) desktop-    files <- forM filepaths readFile+    files <- forM filepaths tryReadFile     return $ map parseIni files++tryReadFile path = readFile path `catch` handler+  where+    handler :: IOError -> IO String+    handler e = return ""  mimeAppsDirs envPrefix defaultHome defaultDirs = do     home <- lookupEnv (envPrefix ++ "_HOME")