split out library

2 files changed, 91 insertions, 78 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