more Wall cleaning

This commit is contained in:
Joey Hess 2010-10-31 16:00:32 -04:00
parent b2c28c1ac0
commit cf4c926f2e
8 changed files with 23 additions and 32 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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