summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-01 20:27:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-01 20:27:45 -0400
commit89ec253a6a02addca9293815966454a9646dcf0d (patch)
treefa9bd43caacb0ddb775587514103edeeeba34659 /Utility
parentbdd5fe4170afe3e6ca0cd2f72c1522d2cf4f8bb1 (diff)
implement enough of the fdo specs to be able to write desktop menu files
to the appropriate system or local user directory
Diffstat (limited to 'Utility')
-rw-r--r--Utility/FreeDesktop.hs94
1 files changed, 94 insertions, 0 deletions
diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs
new file mode 100644
index 000000000..ce3501766
--- /dev/null
+++ b/Utility/FreeDesktop.hs
@@ -0,0 +1,94 @@
+{- 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/
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.DesktopMenu (
+ DesktopEntry,
+ genDesktopEntry,
+ buildDesktopMenuFile,
+ writeDesktopMenuFile,
+ userDesktopMenuFilePath,
+ systemDesktopMenuFilePath
+) where
+
+import Utility.Exception
+import Utility.Directory
+import Utility.Path
+
+import System.IO
+import System.Environment
+import System.Directory
+import System.FilePath
+import Data.List
+import Data.String.Utils
+
+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 = join "\\;" . split ";"
+
+genDesktopEntry :: String -> String -> Bool -> FilePath -> FilePath -> [String] -> DesktopEntry
+genDesktopEntry name comment terminal program icon categories =
+ [ item "Encoding" StringV "UTF-8"
+ , 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
+ , item "Icon" StringV icon
+ , item "Categories" ListV (map StringV categories)
+ ]
+ where
+ item x c y = (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
+
+userDesktopMenuFilePath :: String -> IO FilePath
+userDesktopMenuFilePath basename = do
+ datadir <- userDataDir
+ return $ datadir </> "applications" </> basename
+
+systemDesktopMenuFilePath :: String -> FilePath
+systemDesktopMenuFilePath basename = "/usr/share/applications" </> basename
+
+userDataDir :: IO FilePath
+userDataDir = do
+ dir <- xdgEnv "DATA_HOME" =<< myHomeDir
+ return $ dir </> ".local" </> "share"
+
+userConfigDir :: IO FilePath
+userConfigDir = do
+ dir <- xdgEnv "DATA_HOME" =<< myHomeDir
+ return $ dir </> ".config"
+
+xdgEnv :: String -> String -> IO String
+xdgEnv envbase def = catchDefaultIO (getEnv $ "XDG_" ++ envbase) def