split out library

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
+		)

Build/InstallDesktopFile.hs

@@ -10,84 +10,7 @@
 
 module Main where
 
-import Utility.Exception
+import Build.InstallDesktopFile
-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
-		)
 
 main :: IO ()
 main = getArgs >>= go

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