split out library

1 files changed, 90 insertions, 0 deletions

diff --git a/Build/DesktopFile.hs b/Build/DesktopFile.hs
new file mode 100644
index 000000000..cd7031fe2
--- /dev/null
+++ b/Build/DesktopFile.hs
@@ -0,0 +1,90 @@
+{- Generating and installing a desktop menu entry file
+ - and a desktop autostart file. (And OSX equivilants.)
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Build.DesktopFile where
+
+import Utility.Exception
+import Utility.FreeDesktop
+import Utility.Path
+import Utility.Monad
+import Locations.UserConfig
+import Utility.OSX
+import Assistant.Install.AutoStart
+
+import Control.Applicative
+import System.Directory
+import System.Environment
+import System.Posix.User
+import System.Posix.Files
+import System.FilePath
+import Data.Maybe
+
+{- 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"]
+
+autostart :: FilePath -> DesktopEntry
+autostart command = genDesktopEntry
+	"Git Annex Assistant"
+	"Autostart"
+	False
+	(command ++ " assistant --autostart")
+	[]
+
+systemwideInstall :: IO Bool
+systemwideInstall = isroot <||> destdirset
+  where
+	isroot = do
+		uid <- fromIntegral <$> getRealUserID
+		return $ uid == (0 :: Int)
+	destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
+
+inDestDir :: FilePath -> IO FilePath
+inDestDir f = do
+	destdir <- catchDefaultIO "" (getEnv "DESTDIR")
+	return $ destdir ++ "/" ++ f
+
+writeFDODesktop :: FilePath -> IO ()
+writeFDODesktop command = do
+	datadir <- ifM systemwideInstall ( return systemDataDir, userDataDir )
+	writeDesktopMenuFile (desktop command) 
+		=<< inDestDir (desktopMenuFilePath "git-annex" datadir)
+
+	configdir <- ifM systemwideInstall ( return systemConfigDir, userConfigDir )
+	installAutoStart command 
+		=<< inDestDir (autoStartPath "git-annex" configdir)
+
+writeOSXDesktop :: FilePath -> IO ()
+writeOSXDesktop command = do
+	installAutoStart command =<< inDestDir =<< ifM systemwideInstall
+		( return $ systemAutoStart osxAutoStartLabel
+		, userAutoStart osxAutoStartLabel
+		)
+
+install :: FilePath -> IO ()
+install command = do
+#ifdef darwin_HOST_OS
+	writeOSXDesktop command
+#else
+	writeFDODesktop command
+#endif
+	ifM systemwideInstall
+		( return ()
+		, do
+			programfile <- inDestDir =<< programFile
+			createDirectoryIfMissing True (parentDir programfile)
+			writeFile programfile command
+		)