54ad1b4cfb
Works around this bug in unix-compat: https://github.com/jacobstanley/unix-compat/issues/56 getFileStatus and other FilePath using functions in unix-compat do not do UNC conversion on Windows. Made Utility.RawFilePath use convertToWindowsNativeNamespace to do the necessary conversion on windows to support long filenames. Audited all imports of System.PosixCompat.Files to make sure that no functions that operate on FilePath were imported from it. Instead, use the equvilants from Utility.RawFilePath. In particular the re-export of that module in Common had to be removed, which led to lots of other changes throughout the code. The changes to Build.Configure, Build.DesktopFile, and Build.TestConfig make Utility.Directory not be needed to build setup. And so let it use Utility.RawFilePath, which depends on unix, which cannot be in setup-depends. Sponsored-by: Dartmouth College's Datalad project
89 lines
2.3 KiB
Haskell
89 lines
2.3 KiB
Haskell
{- Generating and installing a desktop menu entry file and icon,
|
|
- and a desktop autostart file. (And OSX equivilants.)
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
|
|
module Build.DesktopFile where
|
|
|
|
import Utility.Exception
|
|
import Utility.FreeDesktop
|
|
import Utility.Path
|
|
import Utility.Monad
|
|
import Utility.SystemDirectory
|
|
import Utility.FileSystemEncoding
|
|
import Config.Files
|
|
import Utility.OSX
|
|
import Assistant.Install.AutoStart
|
|
import Assistant.Install.Menu
|
|
|
|
import System.Environment
|
|
#ifndef mingw32_HOST_OS
|
|
import System.PosixCompat.User
|
|
import Data.Maybe
|
|
import Control.Applicative
|
|
import Prelude
|
|
#endif
|
|
|
|
systemwideInstall :: IO Bool
|
|
#ifndef mingw32_HOST_OS
|
|
systemwideInstall = isroot <||> (not <$> userdirset)
|
|
where
|
|
isroot = do
|
|
uid <- fromIntegral <$> getRealUserID
|
|
return $ uid == (0 :: Int)
|
|
userdirset = isJust <$> catchMaybeIO (getEnv "USERDIR")
|
|
#else
|
|
systemwideInstall = return False
|
|
#endif
|
|
|
|
inDestDir :: FilePath -> IO FilePath
|
|
inDestDir f = do
|
|
destdir <- catchDefaultIO "" (getEnv "DESTDIR")
|
|
return $ destdir ++ "/" ++ f
|
|
|
|
writeFDODesktop :: FilePath -> IO ()
|
|
writeFDODesktop command = do
|
|
systemwide <- systemwideInstall
|
|
|
|
datadir <- if systemwide then return systemDataDir else userDataDir
|
|
menufile <- inDestDir (desktopMenuFilePath "git-annex" datadir)
|
|
icondir <- inDestDir (iconDir datadir)
|
|
installMenu command menufile "doc" icondir
|
|
|
|
configdir <- if systemwide then return systemConfigDir else 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 (fromRawFilePath (parentDir (toRawFilePath programfile)))
|
|
writeFile programfile command
|
|
)
|
|
|
|
installUser :: FilePath -> IO ()
|
|
installUser command = ifM systemwideInstall
|
|
( return ()
|
|
, install command
|
|
)
|