5 files changed, 88 insertions(+), 14 deletions(-)

M hurl.cabal
M src/Network/URI/Fetch.hs
A src/Network/URI/Types.hs
M src/Network/URI/XDG.hs
M src/Network/URI/XDG/DesktopEntry.hs

@@ 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:    

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

@@ 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
+}

@@ 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)

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