installing desktop file working

Not hooked up to either Makefile or cabal yet

Build/Desktop.hs

@@ -0,0 +1,34 @@
+{- Generating and installing a desktop menu entry file.
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Build.Desktop where
+
+import Utility.Exception
+import Utility.FreeDesktop
+
+import Control.Applicative
+import System.Environment
+import System.Posix.User
+
+{- The command can be either just "git-annex", or the full path to use
+ - to run it. -}
+desktop :: FilePath -> DesktopEntry
+desktop command = genDesktopEntry
+	"Git Annex"
+	"Track and sync the files in your Git Annex"
+	False
+	(command ++ " webapp")
+	["Network", "FileTransfer"]
+
+writeDesktop :: DesktopEntry -> IO ()
+writeDesktop d = do
+	destdir <- catchDefaultIO (getEnv "DESTDIR") ""
+	uid <- fromIntegral <$> getRealUserID
+	dest <- if uid /= 0
+		then userDesktopMenuFilePath "git-annex"
+		else return $ systemDesktopMenuFilePath "git-annex"
+	writeDesktopMenuFile d dest

Utility/FreeDesktop.hs

@@ -9,7 +9,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Utility.DesktopMenu (
+module Utility.FreeDesktop (
 	DesktopEntry,	
 	genDesktopEntry,
 	buildDesktopMenuFile,
@@ -47,16 +47,14 @@ toString (ListV l)
 	where
 		escapesemi = join "\\;" . split ";"
 
-genDesktopEntry :: String -> String -> Bool -> FilePath -> FilePath -> [String] -> DesktopEntry
+genDesktopEntry :: String -> String -> Bool -> FilePath -> [String] -> DesktopEntry
-genDesktopEntry name comment terminal program icon categories =
+genDesktopEntry name comment terminal program categories =
-	[ item "Encoding" StringV "UTF-8"
+	[ item "Type" StringV "Application"
-	, 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
@@ -75,10 +73,14 @@ writeDesktopMenuFile d file = do
 userDesktopMenuFilePath :: String -> IO FilePath
 userDesktopMenuFilePath basename = do
 	datadir <- userDataDir
-	return $ datadir </> "applications" </> basename
+	return $ datadir </> "applications" </> desktopfile basename
 
 systemDesktopMenuFilePath :: String -> FilePath
-systemDesktopMenuFilePath basename = "/usr/share/applications" </> basename
+systemDesktopMenuFilePath basename =
+	"/usr/share/applications" </> desktopfile basename
+
+desktopfile :: FilePath -> FilePath
+desktopfile f = f ++ ".desktop"
 
 userDataDir :: IO FilePath
 userDataDir = do