lint
This commit is contained in:
parent
b327227ba5
commit
637b5feb45
26 changed files with 71 additions and 102 deletions
|
@ -63,7 +63,7 @@ withIndex :: Annex a -> Annex a
|
||||||
withIndex = withIndex' False
|
withIndex = withIndex' False
|
||||||
withIndex' :: Bool -> Annex a -> Annex a
|
withIndex' :: Bool -> Annex a -> Annex a
|
||||||
withIndex' bootstrapping a = do
|
withIndex' bootstrapping a = do
|
||||||
f <- fromRepo $ index
|
f <- fromRepo index
|
||||||
bracketIO (Git.useIndex f) id $ do
|
bracketIO (Git.useIndex f) id $ do
|
||||||
unlessM (liftIO $ doesFileExist f) $ do
|
unlessM (liftIO $ doesFileExist f) $ do
|
||||||
unless bootstrapping create
|
unless bootstrapping create
|
||||||
|
@ -336,8 +336,8 @@ stageJournalFiles = do
|
||||||
where
|
where
|
||||||
index_lines shas = map genline . zip shas
|
index_lines shas = map genline . zip shas
|
||||||
genline (sha, file) = Git.UnionMerge.update_index_line sha file
|
genline (sha, file) = Git.UnionMerge.update_index_line sha file
|
||||||
git_hash_object g = Git.gitCommandLine
|
git_hash_object = Git.gitCommandLine
|
||||||
[Param "hash-object", Param "-w", Param "--stdin-paths"] g
|
[Param "hash-object", Param "-w", Param "--stdin-paths"]
|
||||||
|
|
||||||
|
|
||||||
{- Checks if there are changes in the journal. -}
|
{- Checks if there are changes in the journal. -}
|
||||||
|
@ -366,7 +366,7 @@ fileJournal = replace "//" "_" . replace "_" "/"
|
||||||
- contention with other git-annex processes. -}
|
- contention with other git-annex processes. -}
|
||||||
lockJournal :: Annex a -> Annex a
|
lockJournal :: Annex a -> Annex a
|
||||||
lockJournal a = do
|
lockJournal a = do
|
||||||
file <- fromRepo $ gitAnnexJournalLock
|
file <- fromRepo gitAnnexJournalLock
|
||||||
bracketIO (lock file) unlock a
|
bracketIO (lock file) unlock a
|
||||||
where
|
where
|
||||||
lock file = do
|
lock file = do
|
||||||
|
|
|
@ -17,7 +17,7 @@ catFile :: String -> FilePath -> Annex String
|
||||||
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
|
catFile branch file = maybe startup go =<< Annex.getState Annex.catfilehandle
|
||||||
where
|
where
|
||||||
startup = do
|
startup = do
|
||||||
h <- inRepo $ Git.CatFile.catFileStart
|
h <- inRepo Git.CatFile.catFileStart
|
||||||
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
|
||||||
go h
|
go h
|
||||||
go h = liftIO $ Git.CatFile.catFile h branch file
|
go h = liftIO $ Git.CatFile.catFile h branch file
|
||||||
|
|
|
@ -91,7 +91,7 @@ openForLock file writelock = bracket_ prep cleanup go
|
||||||
- have to fiddle with permissions to open for an
|
- have to fiddle with permissions to open for an
|
||||||
- exclusive lock. -}
|
- exclusive lock. -}
|
||||||
forwritelock a =
|
forwritelock a =
|
||||||
when writelock $ whenM (doesFileExist file) $ a
|
when writelock $ whenM (doesFileExist file) a
|
||||||
prep = forwritelock $ allowWrite file
|
prep = forwritelock $ allowWrite file
|
||||||
cleanup = forwritelock $ preventWrite file
|
cleanup = forwritelock $ preventWrite file
|
||||||
|
|
||||||
|
@ -251,7 +251,7 @@ fromAnnex key dest = withObjectLoc key $ \(dir, file) -> liftIO $ do
|
||||||
moveBad :: Key -> Annex FilePath
|
moveBad :: Key -> Annex FilePath
|
||||||
moveBad key = do
|
moveBad key = do
|
||||||
src <- fromRepo $ gitAnnexLocation key
|
src <- fromRepo $ gitAnnexLocation key
|
||||||
bad <- fromRepo $ gitAnnexBadDir
|
bad <- fromRepo gitAnnexBadDir
|
||||||
let dest = bad </> takeFileName src
|
let dest = bad </> takeFileName src
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
createDirectoryIfMissing True (parentDir dest)
|
createDirectoryIfMissing True (parentDir dest)
|
||||||
|
|
|
@ -24,12 +24,12 @@ repoExists = CommandCheck 0 ensureInitialized
|
||||||
fromOpt :: CommandCheck
|
fromOpt :: CommandCheck
|
||||||
fromOpt = CommandCheck 1 $ do
|
fromOpt = CommandCheck 1 $ do
|
||||||
v <- Annex.getState Annex.fromremote
|
v <- Annex.getState Annex.fromremote
|
||||||
unless (v == Nothing) $ error "cannot use --from with this command"
|
unless (isNothing v) $ error "cannot use --from with this command"
|
||||||
|
|
||||||
toOpt :: CommandCheck
|
toOpt :: CommandCheck
|
||||||
toOpt = CommandCheck 2 $ do
|
toOpt = CommandCheck 2 $ do
|
||||||
v <- Annex.getState Annex.toremote
|
v <- Annex.getState Annex.toremote
|
||||||
unless (v == Nothing) $ error "cannot use --to with this command"
|
unless (isNothing v) $ error "cannot use --to with this command"
|
||||||
|
|
||||||
dontCheck :: CommandCheck -> Command -> Command
|
dontCheck :: CommandCheck -> Command -> Command
|
||||||
dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c
|
dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c
|
||||||
|
|
17
Command.hs
17
Command.hs
|
@ -6,10 +6,6 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Command (
|
module Command (
|
||||||
module Types.Command,
|
|
||||||
module Seek,
|
|
||||||
module Checks,
|
|
||||||
module Options,
|
|
||||||
command,
|
command,
|
||||||
next,
|
next,
|
||||||
stop,
|
stop,
|
||||||
|
@ -19,20 +15,21 @@ module Command (
|
||||||
notAnnexed,
|
notAnnexed,
|
||||||
notBareRepo,
|
notBareRepo,
|
||||||
isBareRepo,
|
isBareRepo,
|
||||||
autoCopies
|
autoCopies,
|
||||||
|
module ReExported
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Types.Command
|
import Types.Command as ReExported
|
||||||
|
import Seek as ReExported
|
||||||
|
import Checks as ReExported
|
||||||
|
import Options as ReExported
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
import Logs.Location
|
import Logs.Location
|
||||||
import Config
|
import Config
|
||||||
import Seek
|
|
||||||
import Checks
|
|
||||||
import Options
|
|
||||||
|
|
||||||
{- Generates a command with the common checks. -}
|
{- Generates a command with the common checks. -}
|
||||||
command :: String -> String -> [CommandSeek] -> String -> Command
|
command :: String -> String -> [CommandSeek] -> String -> Command
|
||||||
|
@ -50,7 +47,7 @@ stop = return Nothing
|
||||||
- list of actions to perform to run the command. -}
|
- list of actions to perform to run the command. -}
|
||||||
prepCommand :: Command -> [String] -> Annex [CommandCleanup]
|
prepCommand :: Command -> [String] -> Annex [CommandCleanup]
|
||||||
prepCommand Command { cmdseek = seek, cmdcheck = c } params = do
|
prepCommand Command { cmdseek = seek, cmdcheck = c } params = do
|
||||||
sequence_ $ map runCheck c
|
mapM_ runCheck c
|
||||||
map doCommand . concat <$> mapM (\s -> s params) seek
|
map doCommand . concat <$> mapM (\s -> s params) seek
|
||||||
|
|
||||||
{- Runs a command through the start, perform and cleanup stages -}
|
{- Runs a command through the start, perform and cleanup stages -}
|
||||||
|
|
|
@ -24,7 +24,7 @@ start (name:description) = do
|
||||||
showStart "describe" name
|
showStart "describe" name
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
next $ perform u $ unwords description
|
next $ perform u $ unwords description
|
||||||
start _ = do error "Specify a repository and a description."
|
start _ = error "Specify a repository and a description."
|
||||||
|
|
||||||
perform :: UUID -> String -> CommandPerform
|
perform :: UUID -> String -> CommandPerform
|
||||||
perform u description = do
|
perform u description = do
|
||||||
|
|
|
@ -22,7 +22,7 @@ seek = [withWords start]
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (keyname:file:[]) = notBareRepo $ do
|
start (keyname:file:[]) = notBareRepo $ do
|
||||||
let key = maybe (error "bad key") id $ readKey keyname
|
let key = fromMaybe (error "bad key") $ readKey keyname
|
||||||
inbackend <- inAnnex key
|
inbackend <- inAnnex key
|
||||||
unless inbackend $ error $
|
unless inbackend $ error $
|
||||||
"key ("++ keyname ++") is not present in backend"
|
"key ("++ keyname ++") is not present in backend"
|
||||||
|
|
|
@ -50,7 +50,7 @@ withBarePresentKeys a params = isBareRepo >>= go
|
||||||
where
|
where
|
||||||
go False = return []
|
go False = return []
|
||||||
go True = do
|
go True = do
|
||||||
unless (null params) $ do
|
unless (null params) $
|
||||||
error "fsck should be run without parameters in a bare repository"
|
error "fsck should be run without parameters in a bare repository"
|
||||||
prepStart a loggedKeys
|
prepStart a loggedKeys
|
||||||
|
|
||||||
|
@ -137,7 +137,7 @@ checkKeySize key = do
|
||||||
|
|
||||||
|
|
||||||
checkBackend :: Backend Annex -> Key -> Annex Bool
|
checkBackend :: Backend Annex -> Key -> Annex Bool
|
||||||
checkBackend backend key = (Types.Backend.fsckKey backend) key
|
checkBackend = Types.Backend.fsckKey
|
||||||
|
|
||||||
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
|
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
|
||||||
checkKeyNumCopies key file numcopies = do
|
checkKeyNumCopies key file numcopies = do
|
||||||
|
|
|
@ -46,7 +46,7 @@ perform file oldkey newbackend = do
|
||||||
-- The old backend's key is not dropped from it, because there may
|
-- The old backend's key is not dropped from it, because there may
|
||||||
-- be other files still pointing at that key.
|
-- be other files still pointing at that key.
|
||||||
src <- fromRepo $ gitAnnexLocation oldkey
|
src <- fromRepo $ gitAnnexLocation oldkey
|
||||||
tmp <- fromRepo $ gitAnnexTmpDir
|
tmp <- fromRepo gitAnnexTmpDir
|
||||||
let tmpfile = tmp </> takeFileName file
|
let tmpfile = tmp </> takeFileName file
|
||||||
liftIO $ createLink src tmpfile
|
liftIO $ createLink src tmpfile
|
||||||
k <- Backend.genKey tmpfile $ Just newbackend
|
k <- Backend.genKey tmpfile $ Just newbackend
|
||||||
|
@ -64,7 +64,7 @@ perform file oldkey newbackend = do
|
||||||
-- associated urls, record them for
|
-- associated urls, record them for
|
||||||
-- the new key as well.
|
-- the new key as well.
|
||||||
urls <- getUrls oldkey
|
urls <- getUrls oldkey
|
||||||
when (not $ null urls) $
|
unless (null urls) $
|
||||||
mapM_ (setUrlPresent newkey) urls
|
mapM_ (setUrlPresent newkey) urls
|
||||||
|
|
||||||
next $ Command.Add.cleanup file newkey True
|
next $ Command.Add.cleanup file newkey True
|
||||||
|
|
|
@ -82,7 +82,7 @@ toPerform dest move key = moveLock move key $ do
|
||||||
else Remote.hasKey dest key
|
else Remote.hasKey dest key
|
||||||
case isthere of
|
case isthere of
|
||||||
Left err -> do
|
Left err -> do
|
||||||
showNote $ err
|
showNote err
|
||||||
stop
|
stop
|
||||||
Right False -> do
|
Right False -> do
|
||||||
showAction $ "to " ++ Remote.name dest
|
showAction $ "to " ++ Remote.name dest
|
||||||
|
@ -111,7 +111,7 @@ toPerform dest move key = moveLock move key $ do
|
||||||
-}
|
-}
|
||||||
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
|
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
|
||||||
fromStart src move file key
|
fromStart src move file key
|
||||||
| move == True = go
|
| move = go
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
ishere <- inAnnex key
|
ishere <- inAnnex key
|
||||||
if ishere then stop else go
|
if ishere then stop else go
|
||||||
|
|
|
@ -51,11 +51,11 @@ perform = next cleanup
|
||||||
|
|
||||||
cleanup :: CommandCleanup
|
cleanup :: CommandCleanup
|
||||||
cleanup = do
|
cleanup = do
|
||||||
annexdir <- fromRepo $ gitAnnexDir
|
annexdir <- fromRepo gitAnnexDir
|
||||||
uninitialize
|
uninitialize
|
||||||
mapM_ removeAnnex =<< getKeysPresent
|
mapM_ removeAnnex =<< getKeysPresent
|
||||||
liftIO $ removeDirectoryRecursive annexdir
|
liftIO $ removeDirectoryRecursive annexdir
|
||||||
-- avoid normal shutdown
|
-- avoid normal shutdown
|
||||||
saveState
|
saveState
|
||||||
inRepo $ Git.run "branch" [Param "-D", Param Annex.Branch.name]
|
inRepo $ Git.run "branch" [Param "-D", Param Annex.Branch.name]
|
||||||
liftIO $ exitSuccess
|
liftIO exitSuccess
|
||||||
|
|
63
Common.hs
63
Common.hs
|
@ -1,46 +1,25 @@
|
||||||
module Common (
|
module Common (module X) where
|
||||||
module Control.Monad,
|
|
||||||
module Control.Applicative,
|
|
||||||
module Control.Monad.State,
|
|
||||||
module Control.Exception.Extensible,
|
|
||||||
module Data.Maybe,
|
|
||||||
module Data.List,
|
|
||||||
module Data.String.Utils,
|
|
||||||
module System.Path,
|
|
||||||
module System.FilePath,
|
|
||||||
module System.Directory,
|
|
||||||
module System.Cmd.Utils,
|
|
||||||
module System.IO,
|
|
||||||
module System.Posix.Files,
|
|
||||||
module System.Posix.IO,
|
|
||||||
module System.Posix.Process,
|
|
||||||
module System.Exit,
|
|
||||||
module Utility.Misc,
|
|
||||||
module Utility.Conditional,
|
|
||||||
module Utility.SafeCommand,
|
|
||||||
module Utility.Path,
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Monad hiding (join)
|
import Control.Monad as X hiding (join)
|
||||||
import Control.Applicative
|
import Control.Applicative as X
|
||||||
import Control.Monad.State (liftIO)
|
import Control.Monad.State as X (liftIO)
|
||||||
import Control.Exception.Extensible (IOException)
|
import Control.Exception.Extensible as X (IOException)
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe as X
|
||||||
import Data.List
|
import Data.List as X
|
||||||
import Data.String.Utils
|
import Data.String.Utils as X
|
||||||
|
|
||||||
import System.Path
|
import System.Path as X
|
||||||
import System.FilePath
|
import System.FilePath as X
|
||||||
import System.Directory
|
import System.Directory as X
|
||||||
import System.Cmd.Utils hiding (safeSystem)
|
import System.Cmd.Utils as X hiding (safeSystem)
|
||||||
import System.IO hiding (FilePath)
|
import System.IO as X hiding (FilePath)
|
||||||
import System.Posix.Files
|
import System.Posix.Files as X
|
||||||
import System.Posix.IO
|
import System.Posix.IO as X
|
||||||
import System.Posix.Process hiding (executeFile)
|
import System.Posix.Process as X hiding (executeFile)
|
||||||
import System.Exit
|
import System.Exit as X
|
||||||
|
|
||||||
import Utility.Misc
|
import Utility.Misc as X
|
||||||
import Utility.Conditional
|
import Utility.Conditional as X
|
||||||
import Utility.SafeCommand
|
import Utility.SafeCommand as X
|
||||||
import Utility.Path
|
import Utility.Path as X
|
||||||
|
|
|
@ -1,15 +1,8 @@
|
||||||
module Common.Annex (
|
module Common.Annex (module X) where
|
||||||
module Common,
|
|
||||||
module Types,
|
|
||||||
module Types.UUID,
|
|
||||||
module Annex,
|
|
||||||
module Locations,
|
|
||||||
module Messages,
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Common
|
import Common as X
|
||||||
import Types
|
import Types as X
|
||||||
import Types.UUID (toUUID, fromUUID)
|
import Types.UUID as X (toUUID, fromUUID)
|
||||||
import Annex (gitRepo, inRepo, fromRepo)
|
import Annex as X (gitRepo, inRepo, fromRepo)
|
||||||
import Locations
|
import Locations as X
|
||||||
import Messages
|
import Messages as X
|
||||||
|
|
|
@ -18,7 +18,7 @@ setConfig :: ConfigKey -> String -> Annex ()
|
||||||
setConfig k value = do
|
setConfig k value = do
|
||||||
inRepo $ Git.run "config" [Param k, Param value]
|
inRepo $ Git.run "config" [Param k, Param value]
|
||||||
-- re-read git config and update the repo's state
|
-- re-read git config and update the repo's state
|
||||||
newg <- inRepo $ Git.configRead
|
newg <- inRepo Git.configRead
|
||||||
Annex.changeState $ \s -> s { Annex.repo = newg }
|
Annex.changeState $ \s -> s { Annex.repo = newg }
|
||||||
|
|
||||||
{- Looks up a per-remote config setting in git config.
|
{- Looks up a per-remote config setting in git config.
|
||||||
|
|
|
@ -20,7 +20,7 @@ import Utility.SafeCommand
|
||||||
|
|
||||||
{- Scans for files that are checked into git at the specified locations. -}
|
{- Scans for files that are checked into git at the specified locations. -}
|
||||||
inRepo :: [FilePath] -> Repo -> IO [FilePath]
|
inRepo :: [FilePath] -> Repo -> IO [FilePath]
|
||||||
inRepo l repo = pipeNullSplit (Params "ls-files --cached -z --" : map File l) repo
|
inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
|
||||||
|
|
||||||
{- Scans for files at the specified locations that are not checked into git. -}
|
{- Scans for files at the specified locations that are not checked into git. -}
|
||||||
notInRepo :: Bool -> [FilePath] -> Repo -> IO [FilePath]
|
notInRepo :: Bool -> [FilePath] -> Repo -> IO [FilePath]
|
||||||
|
|
|
@ -37,7 +37,7 @@ merge x y repo = do
|
||||||
- the index are preserved (and participate in the merge). -}
|
- the index are preserved (and participate in the merge). -}
|
||||||
merge_index :: Repo -> [String] -> IO ()
|
merge_index :: Repo -> [String] -> IO ()
|
||||||
merge_index repo bs =
|
merge_index repo bs =
|
||||||
update_index repo =<< concat <$> mapM (\b -> merge_tree_index b repo) bs
|
update_index repo =<< concat <$> mapM (`merge_tree_index` repo) bs
|
||||||
|
|
||||||
{- Feeds a list into update-index. Later items in the list can override
|
{- Feeds a list into update-index. Later items in the list can override
|
||||||
- earlier ones, so the list can be generated from any combination of
|
- earlier ones, so the list can be generated from any combination of
|
||||||
|
|
|
@ -30,7 +30,7 @@ remoteLog = "remote.log"
|
||||||
{- Adds or updates a remote's config in the log. -}
|
{- Adds or updates a remote's config in the log. -}
|
||||||
configSet :: UUID -> RemoteConfig -> Annex ()
|
configSet :: UUID -> RemoteConfig -> Annex ()
|
||||||
configSet u c = do
|
configSet u c = do
|
||||||
ts <- liftIO $ getPOSIXTime
|
ts <- liftIO getPOSIXTime
|
||||||
Annex.Branch.change remoteLog $
|
Annex.Branch.change remoteLog $
|
||||||
showLog showConfig . changeLog ts u c . parseLog parseConfig
|
showLog showConfig . changeLog ts u c . parseLog parseConfig
|
||||||
|
|
||||||
|
|
|
@ -47,7 +47,7 @@ parseTrust :: String -> Maybe TrustLevel
|
||||||
parseTrust s
|
parseTrust s
|
||||||
| length w > 0 = Just $ parse $ head w
|
| length w > 0 = Just $ parse $ head w
|
||||||
-- back-compat; the trust.log used to only list trusted repos
|
-- back-compat; the trust.log used to only list trusted repos
|
||||||
| otherwise = Just $ Trusted
|
| otherwise = Just Trusted
|
||||||
where
|
where
|
||||||
w = words s
|
w = words s
|
||||||
parse "1" = Trusted
|
parse "1" = Trusted
|
||||||
|
@ -62,7 +62,7 @@ showTrust Trusted = "1"
|
||||||
{- Changes the trust level for a uuid in the trustLog. -}
|
{- Changes the trust level for a uuid in the trustLog. -}
|
||||||
trustSet :: UUID -> TrustLevel -> Annex ()
|
trustSet :: UUID -> TrustLevel -> Annex ()
|
||||||
trustSet uuid@(UUID _) level = do
|
trustSet uuid@(UUID _) level = do
|
||||||
ts <- liftIO $ getPOSIXTime
|
ts <- liftIO getPOSIXTime
|
||||||
Annex.Branch.change trustLog $
|
Annex.Branch.change trustLog $
|
||||||
showLog showTrust . changeLog ts uuid level . parseLog parseTrust
|
showLog showTrust . changeLog ts uuid level . parseLog parseTrust
|
||||||
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
|
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
|
||||||
|
|
|
@ -34,7 +34,7 @@ logfile = "uuid.log"
|
||||||
{- Records a description for a uuid in the log. -}
|
{- Records a description for a uuid in the log. -}
|
||||||
describeUUID :: UUID -> String -> Annex ()
|
describeUUID :: UUID -> String -> Annex ()
|
||||||
describeUUID uuid desc = do
|
describeUUID uuid desc = do
|
||||||
ts <- liftIO $ getPOSIXTime
|
ts <- liftIO getPOSIXTime
|
||||||
Annex.Branch.change logfile $
|
Annex.Branch.change logfile $
|
||||||
showLog id . changeLog ts uuid desc . parseLog Just
|
showLog id . changeLog ts uuid desc . parseLog Just
|
||||||
|
|
||||||
|
|
|
@ -55,7 +55,7 @@ showLog shower = unlines . map showpair . M.toList
|
||||||
unwords [fromUUID k, shower v]
|
unwords [fromUUID k, shower v]
|
||||||
|
|
||||||
parseLog :: (String -> Maybe a) -> String -> Log a
|
parseLog :: (String -> Maybe a) -> String -> Log a
|
||||||
parseLog parser = M.fromListWith best . catMaybes . map parse . lines
|
parseLog parser = M.fromListWith best . mapMaybe parse . lines
|
||||||
where
|
where
|
||||||
parse line
|
parse line
|
||||||
| null ws = Nothing
|
| null ws = Nothing
|
||||||
|
|
|
@ -166,7 +166,7 @@ onLocal r a = do
|
||||||
-- for anything onLocal is used to do.
|
-- for anything onLocal is used to do.
|
||||||
Annex.Branch.disableUpdate
|
Annex.Branch.disableUpdate
|
||||||
ret <- a
|
ret <- a
|
||||||
liftIO $ Git.reap
|
liftIO Git.reap
|
||||||
return ret
|
return ret
|
||||||
|
|
||||||
keyUrl :: Git.Repo -> Key -> String
|
keyUrl :: Git.Repo -> Key -> String
|
||||||
|
|
|
@ -19,7 +19,7 @@ import qualified Git
|
||||||
-}
|
-}
|
||||||
findSpecialRemotes :: String -> Annex [Git.Repo]
|
findSpecialRemotes :: String -> Annex [Git.Repo]
|
||||||
findSpecialRemotes s = do
|
findSpecialRemotes s = do
|
||||||
m <- fromRepo $ Git.configMap
|
m <- fromRepo Git.configMap
|
||||||
return $ map construct $ remotepairs m
|
return $ map construct $ remotepairs m
|
||||||
where
|
where
|
||||||
remotepairs = M.toList . M.filterWithKey match
|
remotepairs = M.toList . M.filterWithKey match
|
||||||
|
|
6
Seek.hs
6
Seek.hs
|
@ -23,7 +23,7 @@ import qualified Limit
|
||||||
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
|
seekHelper :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> [FilePath] -> Annex [FilePath]
|
||||||
seekHelper a params = do
|
seekHelper a params = do
|
||||||
g <- gitRepo
|
g <- gitRepo
|
||||||
liftIO $ runPreserveOrder (\p -> a p g) params
|
liftIO $ runPreserveOrder (`a` g) params
|
||||||
|
|
||||||
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
|
||||||
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
|
withFilesInGit a params = prepFiltered a $ seekHelper LsFiles.inRepo params
|
||||||
|
@ -73,7 +73,7 @@ withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
|
||||||
withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
|
withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO [FilePath]) -> (BackendFile -> CommandStart) -> CommandSeek
|
||||||
withFilesUnlocked' typechanged a params = do
|
withFilesUnlocked' typechanged a params = do
|
||||||
-- unlocked files have changed type from a symlink to a regular file
|
-- unlocked files have changed type from a symlink to a regular file
|
||||||
top <- fromRepo $ Git.workTree
|
top <- fromRepo Git.workTree
|
||||||
typechangedfiles <- seekHelper typechanged params
|
typechangedfiles <- seekHelper typechanged params
|
||||||
unlockedfiles <- liftIO $ filterM notSymlink $
|
unlockedfiles <- liftIO $ filterM notSymlink $
|
||||||
map (\f -> top ++ "/" ++ f) typechangedfiles
|
map (\f -> top ++ "/" ++ f) typechangedfiles
|
||||||
|
@ -109,7 +109,7 @@ prepFilteredGen a d fs = do
|
||||||
- command, using a list (ie of files) coming from an action. The list
|
- command, using a list (ie of files) coming from an action. The list
|
||||||
- will be produced and consumed lazily. -}
|
- will be produced and consumed lazily. -}
|
||||||
prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
|
prepStart :: (b -> CommandStart) -> Annex [b] -> Annex [CommandStart]
|
||||||
prepStart a fs = liftM (map a) fs
|
prepStart a = liftM (map a)
|
||||||
|
|
||||||
notSymlink :: FilePath -> IO Bool
|
notSymlink :: FilePath -> IO Bool
|
||||||
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
|
notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
|
||||||
|
|
|
@ -51,7 +51,7 @@ upgrade :: Annex Bool
|
||||||
upgrade = do
|
upgrade = do
|
||||||
showAction "v1 to v2"
|
showAction "v1 to v2"
|
||||||
|
|
||||||
bare <- fromRepo $ Git.repoIsLocalBare
|
bare <- fromRepo Git.repoIsLocalBare
|
||||||
if bare
|
if bare
|
||||||
then do
|
then do
|
||||||
moveContent
|
moveContent
|
||||||
|
@ -113,7 +113,7 @@ moveLocationLogs = do
|
||||||
else return []
|
else return []
|
||||||
move (l, k) = do
|
move (l, k) = do
|
||||||
dest <- fromRepo $ logFile2 k
|
dest <- fromRepo $ logFile2 k
|
||||||
dir <- fromRepo $ Upgrade.V2.gitStateDir
|
dir <- fromRepo Upgrade.V2.gitStateDir
|
||||||
let f = dir </> l
|
let f = dir </> l
|
||||||
liftIO $ createDirectoryIfMissing True (parentDir dest)
|
liftIO $ createDirectoryIfMissing True (parentDir dest)
|
||||||
-- could just git mv, but this way deals with
|
-- could just git mv, but this way deals with
|
||||||
|
|
|
@ -69,7 +69,7 @@ checkGitVersion = do
|
||||||
-- for git-check-attr behavior change
|
-- for git-check-attr behavior change
|
||||||
need = "1.7.7"
|
need = "1.7.7"
|
||||||
dotted = sum . mult 1 . reverse . extend 10 . map readi . split "."
|
dotted = sum . mult 1 . reverse . extend 10 . map readi . split "."
|
||||||
extend n l = l ++ take (n - length l) (repeat 0)
|
extend n l = l ++ replicate (n - length l) 0
|
||||||
mult _ [] = []
|
mult _ [] = []
|
||||||
mult n (x:xs) = (n*x) : (mult (n*100) xs)
|
mult n (x:xs) = (n*x) : (mult (n*100) xs)
|
||||||
readi :: String -> Integer
|
readi :: String -> Integer
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
Name: git-annex
|
Name: git-annex
|
||||||
Version: 3.20111107
|
Version: 3.20111108
|
||||||
Cabal-Version: >= 1.6
|
Cabal-Version: >= 1.6
|
||||||
License: GPL
|
License: GPL
|
||||||
Maintainer: Joey Hess <joey@kitenet.net>
|
Maintainer: Joey Hess <joey@kitenet.net>
|
||||||
|
|
Loading…
Reference in a new issue