diff --git a/Backend/File.hs b/Backend/File.hs index b45354752f..5b93d8227e 100644 --- a/Backend/File.hs +++ b/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: " ++ diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs index f6daeffec4..76c368f84e 100644 --- a/Backend/SHA1.hs +++ b/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 diff --git a/Backend/URL.hs b/Backend/URL.hs index 384f933ebf..e6d3eb1ae5 100644 --- a/Backend/URL.hs +++ b/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 diff --git a/Backend/WORM.hs b/Backend/WORM.hs index b5ae11807e..848386ecd1 100644 --- a/Backend/WORM.hs +++ b/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 diff --git a/Core.hs b/Core.hs index c5026c6a5f..ebe5d2966c 100644 --- a/Core.hs +++ b/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 () diff --git a/Locations.hs b/Locations.hs index 49ee878c85..a296f8d876 100644 --- a/Locations.hs +++ b/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 - diff --git a/TypeInternals.hs b/TypeInternals.hs index f45be4760c..46c92cb59b 100644 --- a/TypeInternals.hs +++ b/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 { diff --git a/Utility.hs b/Utility.hs index e7b4b510b8..6867f473a7 100644 --- a/Utility.hs +++ b/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 '"'"'