more Wall cleaning

Backend/File.hs

@@ -15,25 +15,18 @@
 module Backend.File (backend) where
 
 import Control.Monad.State
-import System.IO
-import System.Cmd
-import System.Cmd.Utils
-import Control.Exception
 import System.Directory
-import List
-import Maybe
 
 import TypeInternals
 import LocationLog
 import Locations
 import qualified Remotes
 import qualified GitRepo as Git
-import Utility
 import Core
 import qualified Annex
 import UUID
-import qualified Backend
 
+backend :: Backend
 backend = Backend {
 	name = mustProvide,
 	getKey = mustProvide,
@@ -43,11 +36,12 @@ backend = Backend {
 	hasKey = checkKeyFile
 }
 
+mustProvide :: a
 mustProvide = error "must provide this field"
 
 {- Storing a key is a no-op. -}
 dummyStore :: FilePath -> Key -> Annex (Bool)
-dummyStore file key = return True
+dummyStore _ _ = return True
 
 {- Just check if the .git/annex/ file for the key exists. -}
 checkKeyFile :: Key -> Annex Bool
@@ -146,7 +140,8 @@ showLocations key = do
 	if (null uuidsf)
 		then showLongNote $ "No other repository is known to contain the file."
 		else showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
-	
+
+showTriedRemotes :: [Git.Repo] -> Annex ()
 showTriedRemotes [] = return ()	
 showTriedRemotes remotes =
 	showLongNote $ "I was unable to access these remotes: " ++

Backend/SHA1.hs

@@ -15,6 +15,7 @@ import System.IO
 import qualified Backend.File
 import TypeInternals
 
+backend :: Backend
 backend = Backend.File.backend {
 	name = "SHA1",
 	getKey = keyValue

Backend/URL.hs

@@ -9,14 +9,12 @@ module Backend.URL (backend) where
 
 import Control.Monad.State (liftIO)
 import Data.String.Utils
-import System.Cmd
-import System.Cmd.Utils
-import System.Exit
 
 import TypeInternals
 import Core
 import Utility
 
+backend :: Backend
 backend = Backend {
 	name = "URL",
 	getKey = keyValue,
@@ -28,15 +26,15 @@ backend = Backend {
 
 -- cannot generate url from filename
 keyValue :: FilePath -> Annex (Maybe Key)
-keyValue file = return Nothing
+keyValue _ = return Nothing
 
 -- cannot change url contents
 dummyStore :: FilePath -> Key -> Annex Bool
-dummyStore file url = return False
+dummyStore _ _ = return False
 
 -- allow keys to be removed; presumably they can always be downloaded again
 dummyOk :: Key -> Annex Bool
-dummyOk url = return True
+dummyOk _ = return True
 
 downloadUrl :: Key -> FilePath -> Annex Bool
 downloadUrl key file = do

Backend/WORM.hs

@@ -10,12 +10,11 @@ module Backend.WORM (backend) where
 import Control.Monad.State
 import System.FilePath
 import System.Posix.Files
-import qualified Data.ByteString.Lazy.Char8 as B
 
 import qualified Backend.File
 import TypeInternals
-import Utility
 
+backend :: Backend
 backend = Backend.File.backend {
 	name = "WORM",
 	getKey = keyValue

Core.hs

@@ -109,7 +109,7 @@ calcGitLink file key = do
 		Just f -> f
 		Nothing -> error $ "unable to normalize " ++ file
 	return $ (relPathDirToDir (parentDir absfile) (Git.workTree g)) ++
-		annexLocationRelative g key
+		annexLocationRelative key
 
 {- Updates the LocationLog when a key's presence changes. -}
 logStatus :: Key -> LogStatus -> Annex ()

Locations.hs

@@ -18,11 +18,11 @@ module Locations (
 import Data.String.Utils
 
 import Types
-import qualified TypeInternals as Internals
 import qualified GitRepo as Git
 
 {- Long-term, cross-repo state is stored in files inside the .git-annex
  - directory, in the git repository's working tree. -}
+stateLoc :: String
 stateLoc = ".git-annex/"
 gitStateDir :: Git.Repo -> FilePath
 gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
@@ -35,13 +35,13 @@ gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
  -}
 annexLocation :: Git.Repo -> Key -> FilePath
 annexLocation r key = 
-	(Git.workTree r) ++ "/" ++ (annexLocationRelative r key)
+	(Git.workTree r) ++ "/" ++ (annexLocationRelative key)
 
 {- Annexed file's location relative to git's working tree. 
  -
  - Note: Assumes repo is NOT bare.-}
-annexLocationRelative :: Git.Repo -> Key -> FilePath
-annexLocationRelative r key = ".git/annex/" ++ (keyFile key)
+annexLocationRelative :: Key -> FilePath
+annexLocationRelative key = ".git/annex/" ++ (keyFile key)
 
 {- .git-annex/tmp is used for temp files
  -

TypeInternals.hs

@@ -58,9 +58,9 @@ instance Read Key where
 			k = join ":" $ drop 1 l
 
 backendName :: Key -> BackendName
-backendName (Key (b,k)) = b
+backendName (Key (b,_)) = b
 keyName :: Key -> KeyName
-keyName (Key (b,k)) = k
+keyName (Key (_,k)) = k
 
 -- this structure represents a key-value backend
 data Backend = Backend {

Utility.hs

@@ -15,20 +15,17 @@ module Utility (
 ) where
 
 import System.IO
-import System.Cmd.Utils
 import System.Exit
 import System.Posix.Process
-import System.Posix.Process.Internals
 import System.Posix.Signals
-import System.Posix.IO
 import Data.String.Utils
 import System.Path
-import System.IO.HVFS
 import System.FilePath
 import System.Directory
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
+hGetContentsStrict :: Handle -> IO String
 hGetContentsStrict h  = hGetContents h >>= \s -> length s `seq` return s
 
 {- Returns the parent directory of a path. Parent of / is "" -}
@@ -53,11 +50,11 @@ parentDir dir =
 relPathCwdToDir :: FilePath -> IO FilePath
 relPathCwdToDir dir = do
 	cwd <- getCurrentDirectory
-	let absdir = abs cwd dir
+	let absdir = absnorm cwd
 	return $ relPathDirToDir cwd absdir
 	where
 		-- absolute, normalized form of the directory
-		abs cwd dir = 
+		absnorm cwd = 
 			case (absNormPath cwd dir) of
 				Just d -> d
 				Nothing -> error $ "unable to normalize " ++ dir
@@ -106,13 +103,14 @@ boolSystem command params = do
 		_ -> return False
 	where
 		restoresignals oldint oldset = do
-			installHandler sigINT oldint Nothing
+			_ <- installHandler sigINT oldint Nothing
 			setSignalMask oldset
 		childaction oldint oldset = do
 			restoresignals oldint oldset
 			executeFile command True params Nothing
 
 {- Escapes a filename to be safely able to be exposed to the shell. -}
+shellEscape :: FilePath -> FilePath
 shellEscape f = "'" ++ quote ++ "'"
 	where
 		-- replace ' with '"'"'