1{- Freedesktop.org specifications
2 -
3 - http://standards.freedesktop.org/basedir-spec/latest/
4 - http://standards.freedesktop.org/desktop-entry-spec/latest/
5 - http://standards.freedesktop.org/menu-spec/latest/
6 - http://standards.freedesktop.org/icon-theme-spec/latest/
7 -
8 - Copyright 2012 Joey Hess <id@joeyh.name>
9 -
10 - License: BSD-2-clause
11 -}
12
13{-# OPTIONS_GHC -fno-warn-tabs #-}
14
15module Utility.FreeDesktop (
16	DesktopEntry,
17	genDesktopEntry,
18	buildDesktopMenuFile,
19	writeDesktopMenuFile,
20	desktopMenuFilePath,
21	autoStartPath,
22	iconDir,
23	iconFilePath,
24	systemDataDir,
25	systemConfigDir,
26	userDataDir,
27	userConfigDir,
28	userDesktopDir
29) where
30
31import Utility.Exception
32import Utility.UserInfo
33import Utility.Process
34
35import System.Environment
36import System.FilePath
37import System.Directory
38import Data.List
39import Data.Maybe
40import Control.Applicative
41import Prelude
42
43type DesktopEntry = [(Key, Value)]
44
45type Key = String
46
47data Value = StringV String | BoolV Bool | NumericV Float | ListV [Value]
48
49toString :: Value -> String
50toString (StringV s) = s
51toString (BoolV b)
52	| b = "true"
53	| otherwise = "false"
54toString (NumericV f) = show f
55toString (ListV l)
56	| null l = ""
57	| otherwise = (intercalate ";" $ map (concatMap escapesemi . toString) l) ++ ";"
58  where
59	escapesemi ';' = "\\;"
60	escapesemi c = [c]
61
62genDesktopEntry :: String -> String -> Bool -> FilePath -> Maybe String -> [String] -> DesktopEntry
63genDesktopEntry name comment terminal program icon categories = catMaybes
64	[ item "Type" StringV "Application"
65	, item "Version" NumericV 1.0
66	, item "Name" StringV name
67	, item "Comment" StringV comment
68	, item "Terminal" BoolV terminal
69	, item "Exec" StringV program
70	, maybe Nothing (item "Icon" StringV) icon
71	, item "Categories" ListV (map StringV categories)
72	]
73  where
74	item x c y = Just (x, c y)
75
76buildDesktopMenuFile :: DesktopEntry -> String
77buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
78  where
79	keyvalue (k, v) = k ++ "=" ++ toString v
80
81writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
82writeDesktopMenuFile d file = do
83	createDirectoryIfMissing True (takeDirectory file)
84	writeFile file $ buildDesktopMenuFile d
85
86{- Path to use for a desktop menu file, in either the systemDataDir or
87 - the userDataDir -}
88desktopMenuFilePath :: String -> FilePath -> FilePath
89desktopMenuFilePath basename datadir =
90	datadir </> "applications" </> desktopfile basename
91
92{- Path to use for a desktop autostart file, in either the systemDataDir
93 - or the userDataDir -}
94autoStartPath :: String -> FilePath -> FilePath
95autoStartPath basename configdir =
96	configdir </> "autostart" </> desktopfile basename
97
98{- Base directory to install an icon file, in either the systemDataDir
99 - or the userDatadir. -}
100iconDir :: FilePath -> FilePath
101iconDir datadir = datadir </> "icons" </> "hicolor"
102
103{- Filename of an icon, given the iconDir to use.
104 -
105 - The resolution is something like "48x48" or "scalable". -}
106iconFilePath :: FilePath -> String -> FilePath -> FilePath
107iconFilePath file resolution icondir =
108	icondir </> resolution </> "apps" </> file
109
110desktopfile :: FilePath -> FilePath
111desktopfile f = f ++ ".desktop"
112
113{- Directory used for installation of system wide data files.. -}
114systemDataDir :: FilePath
115systemDataDir = "/usr/share"
116
117{- Directory used for installation of system wide config files. -}
118systemConfigDir :: FilePath
119systemConfigDir = "/etc/xdg"
120
121{- Directory for user data files. -}
122userDataDir :: IO FilePath
123userDataDir = xdgEnvHome "DATA_HOME" ".local/share"
124
125{- Directory for user config files. -}
126userConfigDir :: IO FilePath
127userConfigDir = xdgEnvHome "CONFIG_HOME" ".config"
128
129{- Directory for the user's Desktop, may be localized.
130 -
131 - This is not looked up very fast; the config file is in a shell format
132 - that is best parsed by shell, so xdg-user-dir is used, with a fallback
133 - to ~/Desktop. -}
134userDesktopDir :: IO FilePath
135userDesktopDir = maybe fallback return =<< (parse <$> xdg_user_dir)
136  where
137	parse s = case lines <$> s of
138		Just (l:_) -> Just l
139		_ -> Nothing
140	xdg_user_dir = catchMaybeIO $ readProcess "xdg-user-dir" ["DESKTOP"]
141	fallback = xdgEnvHome "DESKTOP_DIR" "Desktop"
142
143xdgEnvHome :: String -> String -> IO String
144xdgEnvHome envbase homedef = do
145	home <- myHomeDir
146	catchDefaultIO (home </> homedef) $
147		getEnv $ "XDG_" ++ envbase
148