From 915d7f98cdf72cb08513f69e8e58b70aab058f84 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 23 Dec 2020 20:22:19 +1300 Subject: [PATCH] Expose APIs to open downloads with other apps. --- hurl.cabal | 2 +- src/Network/URI/Fetch.hs | 32 ++++++++++++++++-- src/Network/URI/Types.hs | 10 ++++++ src/Network/URI/XDG.hs | 8 ++++- src/Network/URI/XDG/DesktopEntry.hs | 50 +++++++++++++++++++++++------ 5 files changed, 88 insertions(+), 14 deletions(-) create mode 100644 src/Network/URI/Types.hs diff --git a/hurl.cabal b/hurl.cabal index e597ad9..0aa8c61 100644 --- a/hurl.cabal +++ b/hurl.cabal @@ -92,7 +92,7 @@ library exposed-modules: Network.URI.Charset, Network.URI.Fetch -- Modules included in this library but not exported. - other-modules: Network.URI.Locale, Network.URI.Messages + other-modules: Network.URI.Locale, Network.URI.Messages, Network.URI.Types -- LANGUAGE extensions used by modules in this package. -- other-extensions: diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs index b643b61..6f67d2e 100644 --- a/src/Network/URI/Fetch.hs +++ b/src/Network/URI/Fetch.hs @@ -4,10 +4,13 @@ -- disabled at build-time for reduced dependencies. module Network.URI.Fetch(Session(locale, aboutPages, redirectCount, cachingEnabled), newSession, fetchURL, fetchURL', fetchURLs, mimeERR, htmlERR, - dispatchByMIME, saveDownload, downloadToURI, + dispatchByMIME, appsForMIME, Application(..), dispatchByApp, + saveDownload, downloadToURI, -- logging API LogRecord(..), enableLogging, retrieveLog, writeLog) where +import Network.URI.Types + import qualified Data.Text as Txt import Data.Text (Text) import Network.URI @@ -21,7 +24,8 @@ import System.IO.Error (isEOFError) import Control.Concurrent.Async (forConcurrently) -- for about: URIs & port parsing, all standard lib -import Data.Maybe (fromMaybe, listToMaybe) +import Data.Maybe (fromMaybe, listToMaybe, isJust) +import Data.Either (isLeft) import Text.Read (readMaybe) -- for executable extensions, all standard lib import Data.Char (isSpace) @@ -359,6 +363,30 @@ dispatchByMIME Session {locale = l, apps = a} mime uri = do dispatchByMIME _ _ _ = return Nothing #endif +appsForMIME :: Session -> String -> IO [Application] +#if WITH_XDG +appsForMIME Session { apps = a, locale = l } = queryHandlers' a l +#else +appsForMIME _ _ = [] +#endif + +dispatchByApp :: Session -> Application -> String -> URI -> IO Bool +#if WITH_XDG +dispatchByApp session@Session { locale = l } Application { appId = app} mime uri = do + try1 <- launchApp' l uri app -- First try handing off the URL, feedreaders need this! + case try1 of + Left app -> return True + Right False -> return False + Right True -> do + -- Download as temp file to open locally, the app requires it... + temp <- canonicalizePath =<< getTemporaryDirectory + resp <- fetchURL' session [mime] uri + uri' <- saveDownload (URI "file:" Nothing "" "" "") temp resp + isLeft <$> launchApp' l uri' app +#else +dispatchByApp _ _ _ _ = return False +#endif + -- Downloads utilities -- | write download to a file in the given directory. saveDownload :: URI -> FilePath -> (URI, String, Either Text ByteString) -> IO URI diff --git a/src/Network/URI/Types.hs b/src/Network/URI/Types.hs new file mode 100644 index 0000000..ed61325 --- /dev/null +++ b/src/Network/URI/Types.hs @@ -0,0 +1,10 @@ +module Network.URI.Types(Application(..)) where + +import Network.URI + +data Application = Application { + name :: String, + icon :: URI, + description :: String, + appId :: String -- internal +} diff --git a/src/Network/URI/XDG.hs b/src/Network/URI/XDG.hs index c5da184..0de6652 100644 --- a/src/Network/URI/XDG.hs +++ b/src/Network/URI/XDG.hs @@ -1,12 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -module Network.URI.XDG(XDGConfig, loadXDGConfig, dispatchURIByMIME) where +module Network.URI.XDG(XDGConfig, loadXDGConfig, dispatchURIByMIME, queryHandlers', launchApp') where import Network.URI (URI(..)) +import Network.URI.Types import Network.URI.Messages (Errors(..)) import Network.URI.XDG.DesktopEntry import Network.URI.XDG.MimeApps import Data.List (stripPrefix) +import Data.Maybe (catMaybes) #if WITH_APPSTREAM import qualified Text.XML as XML @@ -73,3 +75,7 @@ mapFirstM (x:xs) cb = do Just _ -> return item Nothing -> mapFirstM xs cb mapFirstM [] _ = return Nothing + +queryHandlers' :: XDGConfig -> [String] -> String -> IO [Application] +queryHandlers' XDGConfig { handlers = config } locales mime = + catMaybes <$> mapM (desktop2app locales) (queryHandlers config mime) diff --git a/src/Network/URI/XDG/DesktopEntry.hs b/src/Network/URI/XDG/DesktopEntry.hs index 5217395..1ac28ac 100644 --- a/src/Network/URI/XDG/DesktopEntry.hs +++ b/src/Network/URI/XDG/DesktopEntry.hs @@ -1,6 +1,7 @@ -module Network.URI.XDG.DesktopEntry(launchApp) where +module Network.URI.XDG.DesktopEntry(launchApp, launchApp', desktop2app) where -import Data.Maybe (fromMaybe, catMaybes) +import Data.Maybe (fromMaybe, catMaybes, isJust) +import Data.List (isInfixOf) import Control.Exception (catch) import System.Environment (lookupEnv) import Control.Monad (forM) @@ -12,19 +13,28 @@ import System.Process (spawnCommand) import Network.URI.XDG.Ini import Network.URI.XDG.MimeApps (split, fromMaybe') +import Network.URI.Types (Application(..)) -launchApp :: [String] -- ^ The locale to use +launchApp' :: [String] -- ^ The locale to use -> URI -- ^ The URI to have it open. -> String -- ^ The .desktop ID - -> IO (Maybe String) -- ^ The localized name of the application -launchApp locales uri desktopID = do + -> IO (Either String Bool) -- ^ The localized name of the application or whether it expects a local path. +launchApp' locales uri desktopID = do app <- readDesktopID desktopID let grp = "desktop entry" let name = fromMaybe desktopID $ iniLookupLocalized locales grp "name" app case (iniLookup grp "type" app, iniLookup grp "exec" app) of + (Just "Application", Just exec) | uriScheme uri /= "file:" && (isInfixOf "%f" exec || isInfixOf "%F" exec) -> + return $ Right True (Just "Application", Just exec) -> catch (execApp uri exec name app) execFailed - _ -> return Nothing + _ -> return $ Right False + +launchApp :: [String] -- ^ The locale to use + -> URI -- ^ The URI to have it open. + -> String -- ^ The .desktop ID + -> IO (Maybe String) -- ^ The localized name of the application +launchApp a b c = leftToMaybe <$> launchApp' a b c readDesktopID desktopID = do dirs <- lookupEnv "XDG_DATA_DIRS" @@ -65,10 +75,30 @@ esc' ('\'':cs) = '\\' : '\'' : esc' cs esc' (c:cs) = c : esc' cs esc' [] = "'" -execApp :: URI -> String -> String -> INI -> IO (Maybe String) +execApp :: URI -> String -> String -> INI -> IO (Either String a) execApp uri exec name app = do spawnCommand $ macros uri exec (app, name) - return $ Just name + return $ Left name + +execFailed :: IOError -> IO (Either a Bool) +execFailed _ = return $ Right False + +desktop2app :: [String] -> String -> IO (Maybe Application) +desktop2app locales desktopId = do + app <- readDesktopID desktopId + let grp = "desktop entry" + let localized key = iniLookupLocalized locales grp key app + let isApp = iniLookup grp "type" app == Just "Application" && isJust (iniLookup grp "exec" app) + return $ if isApp then Just $ Application { + name = fromMaybe desktopId $ localized "name", + description = fromMaybe "" $ localized "comment", + icon = case localized "icon" of + Just icon -> URI "xdg-icon:" Nothing icon "" "" + Nothing -> URI "about:" Nothing "blank" "" "", + appId = desktopId + } else Nothing + +--- Utils -execFailed :: IOError -> IO (Maybe String) -execFailed _ = return Nothing +leftToMaybe (Left a) = Just a +leftToMaybe (Right _) = Nothing -- 2.30.2