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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
{- Freedesktop.org specifications
-
- http://standards.freedesktop.org/basedir-spec/latest/
- http://standards.freedesktop.org/desktop-entry-spec/latest/
- http://standards.freedesktop.org/menu-spec/latest/
- http://standards.freedesktop.org/icon-theme-spec/latest/
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FreeDesktop (
DesktopEntry,
genDesktopEntry,
buildDesktopMenuFile,
writeDesktopMenuFile,
desktopMenuFilePath,
autoStartPath,
iconDir,
iconFilePath,
systemDataDir,
systemConfigDir,
userDataDir,
userConfigDir,
userDesktopDir
) where
import Common
import Utility.UserInfo
import System.Environment
type DesktopEntry = [(Key, Value)]
type Key = String
data Value = StringV String | BoolV Bool | NumericV Float | ListV [Value]
toString :: Value -> String
toString (StringV s) = s
toString (BoolV b)
| b = "true"
| otherwise = "false"
toString (NumericV f) = show f
toString (ListV l)
| null l = ""
| otherwise = (intercalate ";" $ map (concatMap escapesemi . toString) l) ++ ";"
where
escapesemi ';' = "\\;"
escapesemi c = [c]
genDesktopEntry :: String -> String -> Bool -> FilePath -> Maybe String -> [String] -> DesktopEntry
genDesktopEntry name comment terminal program icon categories = catMaybes
[ item "Type" StringV "Application"
, item "Version" NumericV 1.0
, item "Name" StringV name
, item "Comment" StringV comment
, item "Terminal" BoolV terminal
, item "Exec" StringV program
, maybe Nothing (item "Icon" StringV) icon
, item "Categories" ListV (map StringV categories)
]
where
item x c y = Just (x, c y)
buildDesktopMenuFile :: DesktopEntry -> String
buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
where
keyvalue (k, v) = k ++ "=" ++ toString v
writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO ()
writeDesktopMenuFile d file = do
createDirectoryIfMissing True (takeDirectory file)
writeFile (fromOsPath file) $ buildDesktopMenuFile d
{- Path to use for a desktop menu file, in either the systemDataDir or
- the userDataDir -}
desktopMenuFilePath :: String -> OsPath -> OsPath
desktopMenuFilePath basename datadir =
datadir </> literalOsPath "applications" </> desktopfile basename
{- Path to use for a desktop autostart file, in either the systemDataDir
- or the userDataDir -}
autoStartPath :: String -> OsPath -> OsPath
autoStartPath basename configdir =
configdir </> literalOsPath "autostart" </> desktopfile basename
{- Base directory to install an icon file, in either the systemDataDir
- or the userDatadir. -}
iconDir :: OsPath -> OsPath
iconDir datadir = datadir </> literalOsPath "icons" </> literalOsPath "hicolor"
{- Filename of an icon, given the iconDir to use.
-
- The resolution is something like "48x48" or "scalable". -}
iconFilePath :: OsPath -> String -> OsPath -> OsPath
iconFilePath file resolution icondir =
icondir </> toOsPath resolution </> literalOsPath "apps" </> file
desktopfile :: FilePath -> OsPath
desktopfile f = toOsPath $ f ++ ".desktop"
{- Directory used for installation of system wide data files.. -}
systemDataDir :: OsPath
systemDataDir = literalOsPath "/usr/share"
{- Directory used for installation of system wide config files. -}
systemConfigDir :: OsPath
systemConfigDir = literalOsPath "/etc/xdg"
{- Directory for user data files. -}
userDataDir :: IO OsPath
userDataDir = toOsPath <$> xdgEnvHome "DATA_HOME" ".local/share"
{- Directory for user config files. -}
userConfigDir :: IO OsPath
userConfigDir = toOsPath <$> xdgEnvHome "CONFIG_HOME" ".config"
{- Directory for the user's Desktop, may be localized.
-
- This is not looked up very fast; the config file is in a shell format
- that is best parsed by shell, so xdg-user-dir is used, with a fallback
- to ~/Desktop. -}
userDesktopDir :: IO FilePath
userDesktopDir = maybe fallback return =<< (parse <$> xdg_user_dir)
where
parse s = case lines <$> s of
Just (l:_) -> Just l
_ -> Nothing
xdg_user_dir = catchMaybeIO $ readProcess "xdg-user-dir" ["DESKTOP"]
fallback = xdgEnvHome "DESKTOP_DIR" "Desktop"
xdgEnvHome :: String -> String -> IO String
xdgEnvHome envbase homedef = do
home <- toOsPath <$> myHomeDir
catchDefaultIO (fromOsPath $ home </> toOsPath homedef) $
getEnv ("XDG_" ++ envbase)
|
