more Wall cleaning
This commit is contained in:
parent
b2c28c1ac0
commit
cf4c926f2e
8 changed files with 23 additions and 32 deletions
|
@ -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
|
||||
|
@ -147,6 +141,7 @@ showLocations key = do
|
|||
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: " ++
|
||||
|
|
|
@ -15,6 +15,7 @@ import System.IO
|
|||
import qualified Backend.File
|
||||
import TypeInternals
|
||||
|
||||
backend :: Backend
|
||||
backend = Backend.File.backend {
|
||||
name = "SHA1",
|
||||
getKey = keyValue
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
2
Core.hs
2
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 ()
|
||||
|
|
|
@ -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
|
||||
-
|
||||
|
|
|
@ -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 {
|
||||
|
|
12
Utility.hs
12
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 '"'"'
|
||||
|
|
Loading…
Reference in a new issue