diff options
| -rw-r--r-- | Build/DesktopFile.hs | 90 | ||||
| -rw-r--r-- | Build/InstallDesktopFile.hs | 79 | ||||
| -rw-r--r-- | Setup.hs | 4 |
3 files changed, 93 insertions, 80 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 + ) diff --git a/Build/InstallDesktopFile.hs b/Build/InstallDesktopFile.hs index c01557414..36d60d0d1 100644 --- a/Build/InstallDesktopFile.hs +++ b/Build/InstallDesktopFile.hs @@ -10,84 +10,7 @@ module Main 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 - ) +import Build.InstallDesktopFile main :: IO () main = getArgs >>= go @@ -13,7 +13,7 @@ import Control.Applicative import Control.Monad import System.Directory -import qualified Build.InstallDesktopFile as InstallDesktopFile +import qualified Build.DesktopFile as DesktopFile import qualified Build.Configure as Configure main = defaultMainWithHooks simpleUserHooks @@ -58,6 +58,6 @@ installManpages copyDest verbosity pkg lbi = installDesktopFile :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO () installDesktopFile copyDest verbosity pkg lbi = - InstallDesktopFile.install $ dstBinDir </> "git-annex" + DesktopFile.install $ dstBinDir </> "git-annex" where dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest |