~alcinnz/hurl

ref: 8d239eb61f8448f5b0158e97a738d87aeed42313 hurl/src/Network/URI/XDG/DesktopEntry.hs -rw-r--r-- 2.9 KiB
8d239eb6 — Adrian Cochrane Dispatch unsupported URIs to native apps on FreeDesktop.Org-compliant desktops 4 years ago
                                                                                
8d239eb6 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
module Network.URI.XDG.DesktopEntry(launchApp) where

import Data.Maybe (fromMaybe, catMaybes)
import Control.Exception (catch)
import System.Environment (lookupEnv)
import Control.Monad (forM)
import System.Directory (doesFileExist)
import System.FilePath

import Network.URI
import System.Process (spawnCommand)

import Network.URI.XDG.Ini
import Network.URI.XDG.MimeApps (split, fromMaybe')

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
    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) ->
            catch (execApp uri exec name app) execFailed
        _ -> return Nothing

readDesktopID desktopID = do
    dirs <- lookupEnv "XDG_DATA_DIRS"
    let dirs' = split ':' $ fromMaybe' "/usr/local/share/:/usr/share/" dirs
    filepaths <- forM (filter (/= "") dirs') $ \dir -> do
        exists <- doesFileExist (dir </> "applications" </> desktopID)
        if exists then
            return $ Just (dir </> "applications" </> desktopID)
        else
            return Nothing -- TODO? Handle cases where - = subdirectory path?
    case catMaybes filepaths of
        (filepath:_) -> do
            source <- readFile filepath
            let metadata = (" ", ["filename", filepath]) -- Used by %k macro
            return (parseIni source)
        [] -> return []

-- Capitals usually means supports multiple arguments,
-- but HURL doesn't support making use of that.
macros uri@URI {uriScheme="file:", uriPath=f} ('%':'f':cmd) x = esc f ++ macros uri cmd x
macros uri@URI {uriScheme="file:", uriPath=f} ('%':'F':cmd) x = esc f ++ macros uri cmd x
macros uri ('%':'u':cmd) x = esc uri ++ macros uri cmd x
macros uri ('%':'U':cmd) x = esc uri ++ macros uri cmd x
macros uri ('%':'i':cmd) (app, name)
    | Just icon <- iniLookup "desktop entry" "icon" app =
        "--icon " ++ esc icon ++ macros uri cmd (app, name)
    | otherwise = macros uri cmd (app, name)
macros uri ('%':'c':cmd) (app, name) = esc name ++ macros uri cmd (app, name)
macros uri ('%':'k':cmd) (app, name)
    | Just file <- iniLookup " " "filename" app = esc file ++ macros uri cmd (app, name)
    | otherwise = macros uri cmd (app, name)
macros uri ('%':'%':cmd) x = '%' : macros uri cmd x
macros uri (c:cmd) x = c : macros uri cmd x
macros _ [] _ = []

esc txt = '\'' : esc' (show txt)
esc' ('\'':cs) = '\\' : '\'' : esc' cs
esc' (c:cs) = c : esc' cs
esc' [] = "'"

execApp :: URI -> String -> String -> INI -> IO (Maybe String)
execApp uri exec name app = do
    spawnCommand $ macros uri exec (app, name)
    return $ Just name

execFailed :: IOError -> IO (Maybe String)
execFailed _ = return Nothing