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