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
142
143
144
145
146
147
|
{- 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
-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FreeDesktop (
DesktopEntry,
genDesktopEntry,
buildDesktopMenuFile,
writeDesktopMenuFile,
desktopMenuFilePath,
autoStartPath,
iconDir,
iconFilePath,
systemDataDir,
systemConfigDir,
userDataDir,
userConfigDir,
userDesktopDir
) where
import Utility.Exception
import Utility.Path
import Utility.UserInfo
import Utility.Process
import Utility.PartialPrelude
import System.Environment
import System.Directory
import System.FilePath
import Data.List
import Data.String.Utils
import Data.Maybe
import Control.Applicative
import Prelude
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 (escapesemi . toString) l) ++ ";"
where
escapesemi = intercalate "\\;" . split ";"
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 -> String -> IO ()
writeDesktopMenuFile d file = do
createDirectoryIfMissing True (parentDir file)
writeFile file $ buildDesktopMenuFile d
{- Path to use for a desktop menu file, in either the systemDataDir or
- the userDataDir -}
desktopMenuFilePath :: String -> FilePath -> FilePath
desktopMenuFilePath basename datadir =
datadir </> "applications" </> desktopfile basename
{- Path to use for a desktop autostart file, in either the systemDataDir
- or the userDataDir -}
autoStartPath :: String -> FilePath -> FilePath
autoStartPath basename configdir =
configdir </> "autostart" </> desktopfile basename
{- Base directory to install an icon file, in either the systemDataDir
- or the userDatadir. -}
iconDir :: FilePath -> FilePath
iconDir datadir = datadir </> "icons" </> "hicolor"
{- Filename of an icon, given the iconDir to use.
-
- The resolution is something like "48x48" or "scalable". -}
iconFilePath :: FilePath -> String -> FilePath -> FilePath
iconFilePath file resolution icondir =
icondir </> resolution </> "apps" </> file
desktopfile :: FilePath -> FilePath
desktopfile f = f ++ ".desktop"
{- Directory used for installation of system wide data files.. -}
systemDataDir :: FilePath
systemDataDir = "/usr/share"
{- Directory used for installation of system wide config files. -}
systemConfigDir :: FilePath
systemConfigDir = "/etc/xdg"
{- Directory for user data files. -}
userDataDir :: IO FilePath
userDataDir = xdgEnvHome "DATA_HOME" ".local/share"
{- Directory for user config files. -}
userConfigDir :: IO FilePath
userConfigDir = 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 = maybe Nothing (headMaybe . lines)
xdg_user_dir = catchMaybeIO $ readProcess "xdg-user-dir" ["DESKTOP"]
fallback = xdgEnvHome "DESKTOP_DIR" "Desktop"
xdgEnvHome :: String -> String -> IO String
xdgEnvHome envbase homedef = do
home <- myHomeDir
catchDefaultIO (home </> homedef) $
getEnv $ "XDG_" ++ envbase
|
