refactoring, no code changes really

Backend.hs

@@ -31,13 +31,13 @@ import Control.Monad.State
 import IO (try)
 import System.FilePath
 import System.Posix.Files
-import Core
 
 import Locations
 import qualified GitRepo as Git
 import qualified Annex
 import Types
 import qualified TypeInternals as Internals
+import Messages
 
 {- List of backends in the order to try them when storing a new key. -}
 list :: Annex [Backend]

Backend/File.hs

@@ -25,6 +25,7 @@ import qualified GitRepo as Git
 import Core
 import qualified Annex
 import UUID
+import Messages
 
 backend :: Backend
 backend = Backend {

Backend/SHA1.hs

@@ -14,7 +14,7 @@ import System.IO
 
 import qualified Backend.File
 import TypeInternals
-import Core
+import Messages
 
 backend :: Backend
 backend = Backend.File.backend {

Backend/URL.hs

@@ -11,8 +11,8 @@ import Control.Monad.State (liftIO)
 import Data.String.Utils
 
 import TypeInternals
-import Core
 import Utility
+import Messages
 
 backend :: Backend
 backend = Backend {

Command.hs

@@ -9,7 +9,7 @@ module Command where
 
 import Types
 import qualified Backend
-import Core
+import Messages
 import qualified Annex
 
 {- A subcommand runs in four stages.

Command/Add.hs

@@ -19,6 +19,7 @@ import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- The add subcommand annexes a file, storing it in a backend, and then
  - moving it into the annex directory and setting up the symlink pointing

Command/Drop.hs

@@ -17,6 +17,7 @@ import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Indicates a file's content is not wanted anymore, and should be removed
  - if it's safe to do so. -}

Command/DropKey.hs

@@ -17,6 +17,7 @@ import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Drops cached content for a key. -}
 start :: SubCmdStartString

Command/Fix.hs

@@ -15,6 +15,7 @@ import Command
 import qualified Annex
 import Utility
 import Core
+import Messages
 
 {- Fixes the symlink to an annexed file. -}
 start :: SubCmdStartString

Command/FromKey.hs

@@ -18,6 +18,7 @@ import Utility
 import qualified Backend
 import Types
 import Core
+import Messages
 
 {- Adds a file pointing at a manually-specified key -}
 start :: SubCmdStartString

Command/Fsck.hs

@@ -8,19 +8,11 @@
 module Command.Fsck where
 
 import qualified Data.Map as M
-import System.Directory
-import System.Posix.Files
-import Monad (filterM)
-import Control.Monad.State (liftIO)
-import Data.Maybe
 
 import Command
 import Types
 import Core
-import Locations
-import qualified Annex
-import qualified GitRepo as Git
-import qualified Backend
+import Messages
 
 {- Checks the whole annex for problems. -}
 start :: SubCmdStart
@@ -71,22 +63,3 @@ unusedKeys = do
 
 existsMap :: Ord k => [k] -> M.Map k Int
 existsMap l = M.fromList $ map (\k -> (k, 1)) l
-
-getKeysPresent :: Annex [Key]
-getKeysPresent = do
-	g <- Annex.gitRepo
-	let top = annexDir g
-	contents <- liftIO $ getDirectoryContents top
-	files <- liftIO $ filterM (isreg top) contents
-	return $ map fileKey files
-	where
-		isreg top f = do
-			s <- getFileStatus $ top ++ "/" ++ f
-			return $ isRegularFile s
-
-getKeysReferenced :: Annex [Key]
-getKeysReferenced = do
-	g <- Annex.gitRepo
-	files <- liftIO $ Git.inRepo g $ Git.workTree g
-	keypairs <- mapM Backend.lookupFile files
-	return $ map fst $ catMaybes keypairs

Command/Get.hs

@@ -11,6 +11,7 @@ import Command
 import qualified Backend
 import Types
 import Core
+import Messages
 
 {- Gets an annexed file from one of the backends. -}
 start :: SubCmdStartString

Command/Init.hs

@@ -15,6 +15,7 @@ import qualified Annex
 import Core
 import qualified GitRepo as Git
 import UUID
+import Messages
 
 {- Stores description for the repository etc. -}
 start :: SubCmdStartString

Command/Move.hs

@@ -20,6 +20,7 @@ import Core
 import qualified GitRepo as Git
 import qualified Remotes
 import UUID
+import Messages
 
 {- Move a file either --to or --from a repository.
  -
@@ -64,7 +65,7 @@ moveToPerform key = do
 			showNote $ show err
 			return Nothing
 		Right False -> do
-			Core.showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
+			showNote $ "moving to " ++ (Git.repoDescribe remote) ++ "..."
 			let tmpfile = (annexTmpLocation remote) ++ (keyFile key)
 			ok <- Remotes.copyToRemote remote key tmpfile
 			if (ok)
@@ -112,7 +113,7 @@ moveFromPerform key = do
 	if (ishere)
 		then return $ Just $ moveFromCleanup remote key
 		else do
-			Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
+			showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
 			ok <- getViaTmp key (Remotes.copyFromRemote remote key)
 			if (ok)
 				then return $ Just $ moveFromCleanup remote key

Command/SetKey.hs

@@ -18,6 +18,7 @@ import qualified Backend
 import LocationLog
 import Types
 import Core
+import Messages
 
 {- Sets cached content for a key. -}
 start :: SubCmdStartString

Command/Unannex.hs

@@ -19,6 +19,7 @@ import LocationLog
 import Types
 import Core
 import qualified GitRepo as Git
+import Messages
 
 {- The unannex subcommand undoes an add. -}
 start :: SubCmdStartString

Core.hs

@@ -8,12 +8,12 @@
 module Core where
 
 import IO (try)
-import System.IO
 import System.Directory
 import Control.Monad.State (liftIO)
 import System.Path
-import Data.String.Utils
-import Control.Monad (when, unless)
+import Control.Monad (when, unless, filterM)
+import System.Posix.Files
+import Data.Maybe
 
 import Types
 import Locations
@@ -22,7 +22,9 @@ import UUID
 import qualified GitRepo as Git
 import qualified GitQueue
 import qualified Annex
+import qualified Backend
 import Utility
+import Messages
 
 {- Runs a list of Annex actions. Catches IO errors and continues
  - (but explicitly thrown errors terminate the whole command).
@@ -152,6 +154,27 @@ getViaTmp key action = do
 			-- to resume its transfer
 			return False
 
+{- List of keys whose content exists in .git/annex/objects/ -}
+getKeysPresent :: Annex [Key]
+getKeysPresent = do
+	g <- Annex.gitRepo
+	let top = annexObjectDir g
+	contents <- liftIO $ getDirectoryContents top
+	files <- liftIO $ filterM (isreg top) contents
+	return $ map fileKey files
+	where
+		isreg top f = do
+			s <- getFileStatus $ top ++ "/" ++ f
+			return $ isRegularFile s
+
+{- List of keys referenced by symlinks in the git repo. -}
+getKeysReferenced :: Annex [Key]
+getKeysReferenced = do
+	g <- Annex.gitRepo
+	files <- liftIO $ Git.inRepo g $ Git.workTree g
+	keypairs <- mapM Backend.lookupFile files
+	return $ map fst $ catMaybes keypairs
+
 {- Uses the annex.version git config setting to automate upgrades. -}
 autoUpgrade :: Annex ()
 autoUpgrade = do
@@ -159,6 +182,8 @@ autoUpgrade = do
 
 	case Git.configGet g field "0" of
 		"0" -> do -- before there was repo versioning
+			upgradeNote "Upgrading object directory layout..."
+			
 			setVersion
 		v | v == currentVersion -> return ()
 		_ -> error "this version of git-annex is too old for this git repository!"
@@ -166,37 +191,4 @@ autoUpgrade = do
 		currentVersion = "1"
 		setVersion = Annex.setConfig field currentVersion
 		field = "annex.version"
-
-{- Output logging -}
-verbose :: Annex () -> Annex ()
-verbose a = do
-	q <- Annex.flagIsSet "quiet"
-	unless q a
-showStart :: String -> String -> Annex ()
-showStart command file = verbose $ do
-	liftIO $ putStr $ command ++ " " ++ file ++ " "
-	liftIO $ hFlush stdout
-showNote :: String -> Annex ()
-showNote s = verbose $ do
-	liftIO $ putStr $ "(" ++ s ++ ") "
-	liftIO $ hFlush stdout
-showProgress :: Annex ()
-showProgress = verbose $ liftIO $ putStr "\n"
-showLongNote :: String -> Annex ()
-showLongNote s = verbose $ do
-	liftIO $ putStr $ "\n" ++ indented
-	where
-		indented = join "\n" $ map (\l -> "  " ++ l) $ lines s 
-showEndOk :: Annex ()
-showEndOk = verbose $ do
-	liftIO $ putStrLn "ok"
-showEndFail :: Annex ()
-showEndFail = verbose $ do
-	liftIO $ putStrLn "\nfailed"
-
-{- Exception pretty-printing. -}
-showErr :: (Show a) => a -> Annex ()
-showErr e = warning $ show e
-
-warning :: String -> Annex ()
-warning s = liftIO $ hPutStrLn stderr $ "git-annex: " ++ s
+		upgradeNote s = verbose $ liftIO $ putStrLn $ "("++s++")"

Messages.hs

@@ -0,0 +1,54 @@
+{- git-annex output messages
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Messages where
+
+import Control.Monad.State (liftIO)
+import System.IO
+import Control.Monad (unless)
+import Data.String.Utils
+
+import Types
+import qualified Annex
+
+verbose :: Annex () -> Annex ()
+verbose a = do
+	q <- Annex.flagIsSet "quiet"
+	unless q a
+
+showStart :: String -> String -> Annex ()
+showStart command file = verbose $ do
+	liftIO $ putStr $ command ++ " " ++ file ++ " "
+	liftIO $ hFlush stdout
+
+showNote :: String -> Annex ()
+showNote s = verbose $ do
+	liftIO $ putStr $ "(" ++ s ++ ") "
+	liftIO $ hFlush stdout
+
+showProgress :: Annex ()
+showProgress = verbose $ liftIO $ putStr "\n"
+
+showLongNote :: String -> Annex ()
+showLongNote s = verbose $ do
+	liftIO $ putStr $ "\n" ++ indented
+	where
+		indented = join "\n" $ map (\l -> "  " ++ l) $ lines s 
+showEndOk :: Annex ()
+showEndOk = verbose $ do
+	liftIO $ putStrLn "ok"
+
+showEndFail :: Annex ()
+showEndFail = verbose $ do
+	liftIO $ putStrLn "\nfailed"
+
+{- Exception pretty-printing. -}
+showErr :: (Show a) => a -> Annex ()
+showErr e = warning $ show e
+
+warning :: String -> Annex ()
+warning s = liftIO $ hPutStrLn stderr $ "git-annex: " ++ s

Remotes.hs

@@ -36,6 +36,7 @@ import Locations
 import UUID
 import Utility
 import qualified Core
+import Messages
 
 {- Human visible list of remotes. -}
 list :: [Git.Repo] -> String
@@ -64,7 +65,7 @@ keyPossibilities key = do
 			let expensive = filter Git.repoIsUrl allremotes
 			doexpensive <- filterM cachedUUID expensive
 			unless (null doexpensive) $ do
-				Core.showNote $ "getting UUID for " ++
+				showNote $ "getting UUID for " ++
 					(list doexpensive) ++ "..."
 			let todo = cheap ++ doexpensive
 			if (not $ null todo)
@@ -93,7 +94,7 @@ inAnnex r key = do
 			a <- Annex.new r []
 			Annex.eval a (Core.inAnnex key)
 		checkremote = do
-			Core.showNote ("checking " ++ Git.repoDescribe r ++ "...")
+			showNote ("checking " ++ Git.repoDescribe r ++ "...")
 			inannex <- runCmd r "test" ["-e", annexLocation r key]
 			-- XXX Note that ssh failing and the file not existing
 			-- are not currently differentiated.
@@ -228,7 +229,7 @@ sshLocation r file = (Git.urlHost r) ++ ":" ++ shellEscape file
 scp :: Git.Repo -> [String] -> Annex Bool
 scp r params = do
 	scpoptions <- repoConfig r "scp-options" ""
-	Core.showProgress -- make way for scp progress bar
+	showProgress -- make way for scp progress bar
 	liftIO $ boolSystem "scp" $ "-p":(words scpoptions) ++ params
 
 {- Runs a command in a remote, using ssh if necessary.