split out library
This commit is contained in:
Joey Hess
parent
6f8ec9a1d2
commit
e62de3f3b8
3 changed files with 93 additions and 80 deletions
90
Build/DesktopFile.hs
Normal file
90
Build/DesktopFile.hs
Normal file
|
|
@ -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
|
||||
)
|
||||
|
|
@ -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
|
||||
|
|
|
|||
4
Setup.hs
4
Setup.hs
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue