honor DESTDIR

Build/InstallDesktopFile.hs

@@ -1,5 +1,5 @@
 {- Generating and installing a desktop menu entry file
- - and a desktop autostart file.
+ - and a desktop autostart file. (And OSX equivilants.)
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
@@ -11,6 +11,7 @@ module Build.InstallDesktopFile where
 import Utility.Exception
 import Utility.FreeDesktop
 import Utility.Path
+import Utility.Monad
 import Locations.UserConfig
 
 import Control.Applicative
@@ -18,6 +19,7 @@ import Control.Monad
 import System.Directory
 import System.Environment
 import System.Posix.User
+import System.FilePath
 
 {- The command can be either just "git-annex", or the full path to use
  - to run it. -}
@@ -37,23 +39,33 @@ autostart command = genDesktopEntry
 	(command ++ " assistant --autostart")
 	[]
 
+isRoot :: IO Bool
+isRoot = do
+	uid <- fromIntegral <$> getRealUserID
+	return $ uid == 0
+
+inDestDir :: FilePath -> IO FilePath
+inDestDir f = do
+	destdir <- catchDefaultIO (getEnv "DESTDIR") ""
+	return $ destdir </> f
+
 writeDesktop :: FilePath -> IO ()
 writeDesktop command = do
-	destdir <- catchDefaultIO (getEnv "DESTDIR") ""
-	uid <- fromIntegral <$> getRealUserID
+	datadir <- ifM isRoot ( return systemDataDir, userDataDir )
+	writeDesktopMenuFile (desktop command) 
+		=<< inDestDir (desktopMenuFilePath "git-annex" datadir)
 
-	datadir <- if uid /= 0 then userDataDir else return systemDataDir
-	writeDesktopMenuFile (desktop command) $
-		desktopMenuFilePath "git-annex" datadir
+	configdir <- ifM isRoot ( return systemConfigDir, userConfigDir )
+	writeDesktopMenuFile (autostart command) 
+		=<< inDestDir (autoStartPath "git-annex" configdir)
 
-	configdir <- if uid /= 0 then userConfigDir else return systemConfigDir
-	writeDesktopMenuFile (autostart command) $
-		autoStartPath "git-annex" configdir
-
-	when (uid /= 0) $ do
-		programfile <- programFile
-		createDirectoryIfMissing True (parentDir programfile)
-		writeFile programfile command
+	ifM isRoot
+		( return ()
+		, do
+			programfile <- inDestDir =<< programFile
+			createDirectoryIfMissing True (parentDir programfile)
+			writeFile programfile command
+		)
 
 main = getArgs >>= go
 	where