module Network.URI.XDG.DesktopEntry(launchApp, launchApp', desktop2app) where
import Data.Maybe (fromMaybe, catMaybes, isJust)
import Data.List (isInfixOf)
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')
import Network.URI.Types (Application(..))
launchApp' :: [String]
-> URI
-> String
-> IO (Either String Bool)
launchApp' :: [String] -> URI -> String -> IO (Either String Bool)
launchApp' [String]
locales URI
uri String
desktopID = do
INI
app <- String -> IO INI
readDesktopID String
desktopID
let grp :: String
grp = String
"desktop entry"
let name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
desktopID (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String -> String -> INI -> Maybe String
iniLookupLocalized [String]
locales String
grp String
"name" INI
app
case (String -> String -> INI -> Maybe String
iniLookup String
grp String
"type" INI
app, String -> String -> INI -> Maybe String
iniLookup String
grp String
"exec" INI
app) of
(Just String
"Application", Just String
exec) | URI -> String
uriScheme URI
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"file:" Bool -> Bool -> Bool
&& (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"%f" String
exec Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"%F" String
exec) ->
Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
(Just String
"Application", Just String
exec) ->
IO (Either String Bool)
-> (IOError -> IO (Either String Bool)) -> IO (Either String Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (URI -> String -> String -> INI -> IO (Either String Bool)
forall a. URI -> String -> String -> INI -> IO (Either String a)
execApp URI
uri String
exec String
name INI
app) IOError -> IO (Either String Bool)
forall a. IOError -> IO (Either a Bool)
execFailed
(Maybe String, Maybe String)
_ -> Either String Bool -> IO (Either String Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Bool -> IO (Either String Bool))
-> Either String Bool -> IO (Either String Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
launchApp :: [String]
-> URI
-> String
-> IO (Maybe String)
launchApp :: [String] -> URI -> String -> IO (Maybe String)
launchApp [String]
a URI
b String
c = Either String Bool -> Maybe String
forall a b. Either a b -> Maybe a
leftToMaybe (Either String Bool -> Maybe String)
-> IO (Either String Bool) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> URI -> String -> IO (Either String Bool)
launchApp' [String]
a URI
b String
c
readDesktopID :: String -> IO INI
readDesktopID String
desktopID = do
Maybe String
dirs <- String -> IO (Maybe String)
lookupEnv String
"XDG_DATA_DIRS"
let dirs' :: [String]
dirs' = Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
split Char
':' (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
fromMaybe' String
"/usr/local/share/:/usr/share/" Maybe String
dirs
[Maybe String]
filepaths <- [String] -> (String -> IO (Maybe String)) -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") [String]
dirs') ((String -> IO (Maybe String)) -> IO [Maybe String])
-> (String -> IO (Maybe String)) -> IO [Maybe String]
forall a b. (a -> b) -> a -> b
$ \String
dir -> do
Bool
exists <- String -> IO Bool
doesFileExist (String
dir String -> String -> String
</> String
"applications" String -> String -> String
</> String
desktopID)
if Bool
exists then
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String
dir String -> String -> String
</> String
"applications" String -> String -> String
</> String
desktopID)
else
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
case [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
filepaths of
(String
filepath:[String]
_) -> do
String
source <- String -> IO String
readFile String
filepath
let metadata :: (String, [String])
metadata = (String
" ", [String
"filename", String
filepath])
INI -> IO INI
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> INI
parseIni String
source)
[] -> INI -> IO INI
forall (m :: * -> *) a. Monad m => a -> m a
return []
macros :: URI -> String -> (INI, a) -> String
macros uri :: URI
uri@URI {uriScheme :: URI -> String
uriScheme=String
"file:", uriPath :: URI -> String
uriPath=String
f} (Char
'%':Char
'f':String
cmd) (INI, a)
x = String -> String
forall a. Show a => a -> String
esc String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros uri :: URI
uri@URI {uriScheme :: URI -> String
uriScheme=String
"file:", uriPath :: URI -> String
uriPath=String
f} (Char
'%':Char
'F':String
cmd) (INI, a)
x = String -> String
forall a. Show a => a -> String
esc String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros URI
uri (Char
'%':Char
'u':String
cmd) (INI, a)
x = URI -> String
forall a. Show a => a -> String
esc URI
uri String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros URI
uri (Char
'%':Char
'U':String
cmd) (INI, a)
x = URI -> String
forall a. Show a => a -> String
esc URI
uri String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros URI
uri (Char
'%':Char
'i':String
cmd) (INI
app, a
name)
| Just String
icon <- String -> String -> INI -> Maybe String
iniLookup String
"desktop entry" String
"icon" INI
app =
String
"--icon " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
esc String
icon String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI
app, a
name)
| Bool
otherwise = URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI
app, a
name)
macros URI
uri (Char
'%':Char
'c':String
cmd) (INI
app, a
name) = a -> String
forall a. Show a => a -> String
esc a
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI
app, a
name)
macros URI
uri (Char
'%':Char
'k':String
cmd) (INI
app, a
name)
| Just String
file <- String -> String -> INI -> Maybe String
iniLookup String
" " String
"filename" INI
app = String -> String
forall a. Show a => a -> String
esc String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI
app, a
name)
| Bool
otherwise = URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI
app, a
name)
macros URI
uri (Char
'%':Char
'%':String
cmd) (INI, a)
x = Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
: URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros URI
uri (Char
c:String
cmd) (INI, a)
x = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: URI -> String -> (INI, a) -> String
macros URI
uri String
cmd (INI, a)
x
macros URI
_ [] (INI, a)
_ = []
esc :: a -> String
esc a
txt = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
esc' (a -> String
forall a. Show a => a -> String
show a
txt)
esc' :: String -> String
esc' (Char
'\'':String
cs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
esc' String
cs
esc' (Char
c:String
cs) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
esc' String
cs
esc' [] = String
"'"
execApp :: URI -> String -> String -> INI -> IO (Either String a)
execApp :: URI -> String -> String -> INI -> IO (Either String a)
execApp URI
uri String
exec String
name INI
app = do
String -> IO ProcessHandle
spawnCommand (String -> IO ProcessHandle) -> String -> IO ProcessHandle
forall a b. (a -> b) -> a -> b
$ URI -> String -> (INI, String) -> String
forall a. Show a => URI -> String -> (INI, a) -> String
macros URI
uri String
exec (INI
app, String
name)
Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a b. a -> Either a b
Left String
name
execFailed :: IOError -> IO (Either a Bool)
execFailed :: IOError -> IO (Either a Bool)
execFailed IOError
_ = Either a Bool -> IO (Either a Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a Bool -> IO (Either a Bool))
-> Either a Bool -> IO (Either a Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either a Bool
forall a b. b -> Either a b
Right Bool
False
desktop2app :: [String] -> String -> IO (Maybe Application)
desktop2app :: [String] -> String -> IO (Maybe Application)
desktop2app [String]
locales String
desktopId = do
INI
app <- String -> IO INI
readDesktopID String
desktopId
let grp :: String
grp = String
"desktop entry"
let localized :: String -> Maybe String
localized String
key = [String] -> String -> String -> INI -> Maybe String
iniLookupLocalized [String]
locales String
grp String
key INI
app
let isApp :: Bool
isApp = String -> String -> INI -> Maybe String
iniLookup String
grp String
"type" INI
app Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"Application" Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> String -> INI -> Maybe String
iniLookup String
grp String
"exec" INI
app)
Maybe Application -> IO (Maybe Application)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Application -> IO (Maybe Application))
-> Maybe Application -> IO (Maybe Application)
forall a b. (a -> b) -> a -> b
$ if Bool
isApp then Application -> Maybe Application
forall a. a -> Maybe a
Just (Application -> Maybe Application)
-> Application -> Maybe Application
forall a b. (a -> b) -> a -> b
$ Application :: String -> URI -> String -> String -> Application
Application {
name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
desktopId (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
localized String
"name",
description :: String
description = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
localized String
"comment",
icon :: URI
icon = case String -> Maybe String
localized String
"icon" of
Just String
icon -> String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
"xdg-icon:" Maybe URIAuth
forall a. Maybe a
Nothing String
icon String
"" String
""
Maybe String
Nothing -> String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
"about:" Maybe URIAuth
forall a. Maybe a
Nothing String
"blank" String
"" String
"",
appId :: String
appId = String
desktopId
} else Maybe Application
forall a. Maybe a
Nothing
leftToMaybe :: Either a b -> Maybe a
leftToMaybe (Left a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
leftToMaybe (Right b
_) = Maybe a
forall a. Maybe a
Nothing