{- Generating and installing a desktop menu entry file - and a desktop autostart file. (And OSX equivilants.) - - Copyright 2012 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE CPP #-} module Build.InstallDesktopFile 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 {- 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") [] isRoot :: IO Bool isRoot = do uid <- fromIntegral <$> getRealUserID return $ uid == (0 :: Int) inDestDir :: FilePath -> IO FilePath inDestDir f = do destdir <- catchDefaultIO "" (getEnv "DESTDIR") return $ destdir f writeFDODesktop :: FilePath -> IO () writeFDODesktop command = do datadir <- ifM isRoot ( return systemDataDir, userDataDir ) writeDesktopMenuFile (desktop command) =<< inDestDir (desktopMenuFilePath "git-annex" datadir) configdir <- ifM isRoot ( return systemConfigDir, userConfigDir ) writeDesktopMenuFile (autostart command) =<< inDestDir (autoStartPath "git-annex" configdir) writeOSXDesktop :: FilePath -> IO () writeOSXDesktop command = do installAutoStart command =<< inDestDir =<< ifM isRoot ( return $ systemAutoStart autoStartLabel , userAutoStart autoStartLabel ) {- Install the OSX app in non-self-contained mode. -} let appdir = "git-annex.app" installOSXAppFile appdir "Contents/Info.plist" Nothing installOSXAppFile appdir "Contents/Resources/git-annex.icns" Nothing installOSXAppFile appdir "Contents/MacOS/git-annex-webapp" (Just webappscript) where webappscript = unlines [ "#!/bin/sh" , command ++ " webapp" ] installOSXAppFile :: FilePath -> FilePath -> Maybe String -> IO () installOSXAppFile appdir appfile mcontent = do let src = "ui-macos" appdir appfile home <- myHomeDir dest <- ifM isRoot ( return $ "/Applications" appdir appfile , return $ home "Desktop" appdir appfile ) createDirectoryIfMissing True (parentDir dest) case mcontent of Just content -> writeFile dest content Nothing -> copyFile src dest mode <- fileMode <$> getFileStatus src setFileMode dest mode install :: FilePath -> IO () install command = do #ifdef darwin_HOST_OS writeOSXDesktop command #else writeFDODesktop command #endif ifM isRoot ( return () , do programfile <- inDestDir =<< programFile createDirectoryIfMissing True (parentDir programfile) writeFile programfile command ) main :: IO () main = getArgs >>= go where go [] = error "specify git-annex command" go (command:_) = install command