hlint
This commit is contained in:
parent
85f0992c03
commit
942d8f7298
14 changed files with 20 additions and 21 deletions
|
@ -68,7 +68,7 @@ siblingBranches = inRepo $ Git.Ref.matchingUniq name
|
||||||
|
|
||||||
{- Creates the branch, if it does not already exist. -}
|
{- Creates the branch, if it does not already exist. -}
|
||||||
create :: Annex ()
|
create :: Annex ()
|
||||||
create = void $ getBranch
|
create = void getBranch
|
||||||
|
|
||||||
{- Returns the ref of the branch, creating it first if necessary. -}
|
{- Returns the ref of the branch, creating it first if necessary. -}
|
||||||
getBranch :: Annex Git.Ref
|
getBranch :: Annex Git.Ref
|
||||||
|
|
|
@ -87,7 +87,7 @@ lockContent key a = do
|
||||||
- to fiddle with permissions to open for an exclusive lock. -}
|
- to fiddle with permissions to open for an exclusive lock. -}
|
||||||
openforlock f = catchMaybeIO $ ifM (doesFileExist f)
|
openforlock f = catchMaybeIO $ ifM (doesFileExist f)
|
||||||
( withModifiedFileMode f
|
( withModifiedFileMode f
|
||||||
(\cur -> cur `unionFileModes` ownerWriteMode)
|
(`unionFileModes` ownerWriteMode)
|
||||||
open
|
open
|
||||||
, open
|
, open
|
||||||
)
|
)
|
||||||
|
|
|
@ -22,7 +22,7 @@ seek = [withNothing start]
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = next $ next $ do
|
start = next $ next $ do
|
||||||
Annex.Branch.commit "update"
|
Annex.Branch.commit "update"
|
||||||
_ <- runhook =<< (inRepo $ Git.hookPath "annex-content")
|
_ <- runhook =<< inRepo (Git.hookPath "annex-content")
|
||||||
return True
|
return True
|
||||||
where
|
where
|
||||||
runhook (Just hook) = liftIO $ boolSystem hook []
|
runhook (Just hook) = liftIO $ boolSystem hook []
|
||||||
|
|
|
@ -145,13 +145,13 @@ fixLink key file = do
|
||||||
-}
|
-}
|
||||||
whenM (liftIO $ doesFileExist file) $
|
whenM (liftIO $ doesFileExist file) $
|
||||||
unlessM (inAnnex key) $ do
|
unlessM (inAnnex key) $ do
|
||||||
showNote $ "fixing content location"
|
showNote "fixing content location"
|
||||||
dir <- liftIO $ parentDir <$> absPath file
|
dir <- liftIO $ parentDir <$> absPath file
|
||||||
let content = absPathFrom dir have
|
let content = absPathFrom dir have
|
||||||
liftIO $ allowWrite (parentDir content)
|
liftIO $ allowWrite (parentDir content)
|
||||||
moveAnnex key content
|
moveAnnex key content
|
||||||
|
|
||||||
showNote $ "fixing link"
|
showNote "fixing link"
|
||||||
liftIO $ createDirectoryIfMissing True (parentDir file)
|
liftIO $ createDirectoryIfMissing True (parentDir file)
|
||||||
liftIO $ removeFile file
|
liftIO $ removeFile file
|
||||||
liftIO $ createSymbolicLink want file
|
liftIO $ createSymbolicLink want file
|
||||||
|
@ -220,7 +220,7 @@ checkKeySize' key file bad = case Types.Key.keySize key of
|
||||||
Nothing -> return True
|
Nothing -> return True
|
||||||
Just size -> do
|
Just size -> do
|
||||||
size' <- fromIntegral . fileSize
|
size' <- fromIntegral . fileSize
|
||||||
<$> (liftIO $ getFileStatus file)
|
<$> liftIO (getFileStatus file)
|
||||||
comparesizes size size'
|
comparesizes size size'
|
||||||
where
|
where
|
||||||
comparesizes a b = do
|
comparesizes a b = do
|
||||||
|
|
|
@ -26,7 +26,7 @@ start from file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||||
autoCopies file key (<) $ \_numcopies ->
|
autoCopies file key (<) $ \_numcopies ->
|
||||||
case from of
|
case from of
|
||||||
Nothing -> go $ perform key
|
Nothing -> go $ perform key
|
||||||
Just src -> do
|
Just src ->
|
||||||
-- get --from = copy --from
|
-- get --from = copy --from
|
||||||
stopUnless (Command.Move.fromOk src key) $
|
stopUnless (Command.Move.fromOk src key) $
|
||||||
go $ Command.Move.fromPerform src False key
|
go $ Command.Move.fromPerform src False key
|
||||||
|
|
|
@ -128,9 +128,9 @@ fromOk src key
|
||||||
expensive = do
|
expensive = do
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
remotes <- Remote.keyPossibilities key
|
remotes <- Remote.keyPossibilities key
|
||||||
return $ u /= Remote.uuid src && any (== src) remotes
|
return $ u /= Remote.uuid src && elem src remotes
|
||||||
fromPerform :: Remote -> Bool -> Key -> CommandPerform
|
fromPerform :: Remote -> Bool -> Key -> CommandPerform
|
||||||
fromPerform src move key = moveLock move key $ do
|
fromPerform src move key = moveLock move key $
|
||||||
ifM (inAnnex key)
|
ifM (inAnnex key)
|
||||||
( handle move True
|
( handle move True
|
||||||
, do
|
, do
|
||||||
|
|
|
@ -28,8 +28,8 @@ check = do
|
||||||
"cannot uninit when the " ++ show b ++ " branch is checked out"
|
"cannot uninit when the " ++ show b ++ " branch is checked out"
|
||||||
top <- fromRepo Git.repoPath
|
top <- fromRepo Git.repoPath
|
||||||
cwd <- liftIO getCurrentDirectory
|
cwd <- liftIO getCurrentDirectory
|
||||||
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $ error $
|
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $
|
||||||
"can only run uninit from the top of the git repository"
|
error "can only run uninit from the top of the git repository"
|
||||||
where
|
where
|
||||||
current_branch = Git.Ref . Prelude.head . lines <$> revhead
|
current_branch = Git.Ref . Prelude.head . lines <$> revhead
|
||||||
revhead = inRepo $ Git.Command.pipeRead
|
revhead = inRepo $ Git.Command.pipeRead
|
||||||
|
|
|
@ -176,7 +176,7 @@ runHandler :: MVar Annex.AnnexState -> ChangeChan -> Handler -> FilePath -> IO (
|
||||||
runHandler st changechan handler file = void $ do
|
runHandler st changechan handler file = void $ do
|
||||||
r <- tryIO (runStateMVar st $ handler file)
|
r <- tryIO (runStateMVar st $ handler file)
|
||||||
case r of
|
case r of
|
||||||
Left e -> putStrLn $ show e
|
Left e -> print e
|
||||||
Right Nothing -> noop
|
Right Nothing -> noop
|
||||||
Right (Just change) -> void $
|
Right (Just change) -> void $
|
||||||
runChangeChan $ writeTChan changechan change
|
runChangeChan $ writeTChan changechan change
|
||||||
|
@ -236,7 +236,7 @@ onAddSymlink file = go =<< Backend.lookupFile file
|
||||||
- So for speed, tries to reuse the existing blob for
|
- So for speed, tries to reuse the existing blob for
|
||||||
- the symlink target. -}
|
- the symlink target. -}
|
||||||
addlink link = do
|
addlink link = do
|
||||||
v <- catObjectDetails $ Ref $ ":" ++ file
|
v <- catObjectDetails $ Ref $ ':':file
|
||||||
case v of
|
case v of
|
||||||
Just (currlink, sha)
|
Just (currlink, sha)
|
||||||
| s2w8 link == L.unpack currlink ->
|
| s2w8 link == L.unpack currlink ->
|
||||||
|
@ -307,7 +307,7 @@ commitThread st changechan = forever $ do
|
||||||
-- Now see if now's a good time to commit.
|
-- Now see if now's a good time to commit.
|
||||||
time <- getCurrentTime
|
time <- getCurrentTime
|
||||||
if shouldCommit time cs
|
if shouldCommit time cs
|
||||||
then void $ tryIO $ runStateMVar st $ commitStaged
|
then void $ tryIO $ runStateMVar st commitStaged
|
||||||
else refillChanges changechan cs
|
else refillChanges changechan cs
|
||||||
where
|
where
|
||||||
oneSecond = 1000000 -- microseconds
|
oneSecond = 1000000 -- microseconds
|
||||||
|
|
|
@ -37,7 +37,7 @@ perform remotemap key = do
|
||||||
unless (null safelocations) $ showLongNote pp
|
unless (null safelocations) $ showLongNote pp
|
||||||
pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
|
pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
|
||||||
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
|
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
|
||||||
forM_ (catMaybes $ map (`M.lookup` remotemap) locations) $
|
forM_ (mapMaybe (`M.lookup` remotemap) locations) $
|
||||||
performRemote key
|
performRemote key
|
||||||
if null safelocations then stop else next $ return True
|
if null safelocations then stop else next $ return True
|
||||||
where
|
where
|
||||||
|
|
|
@ -114,6 +114,6 @@ getDiskReserve = fromMaybe megabyte . readSize dataUnits
|
||||||
getHttpHeaders :: Annex [String]
|
getHttpHeaders :: Annex [String]
|
||||||
getHttpHeaders = do
|
getHttpHeaders = do
|
||||||
cmd <- getConfig (annexConfig "http-headers-command") ""
|
cmd <- getConfig (annexConfig "http-headers-command") ""
|
||||||
if (null cmd)
|
if null cmd
|
||||||
then fromRepo $ Git.Config.getList "annex.http-headers"
|
then fromRepo $ Git.Config.getList "annex.http-headers"
|
||||||
else lines . snd <$> liftIO (pipeFrom "sh" ["-c", cmd])
|
else lines . snd <$> liftIO (pipeFrom "sh" ["-c", cmd])
|
||||||
|
|
|
@ -138,7 +138,7 @@ withDecryptedContent = pass withDecryptedHandle
|
||||||
|
|
||||||
pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a)
|
pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a)
|
||||||
-> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
|
-> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
|
||||||
pass to n s a = to n s $ \h -> a =<< L.hGetContents h
|
pass to n s a = to n s $ a <=< L.hGetContents
|
||||||
|
|
||||||
hmacWithCipher :: Cipher -> String -> String
|
hmacWithCipher :: Cipher -> String -> String
|
||||||
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
|
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
|
||||||
|
|
|
@ -165,7 +165,7 @@ gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r </> "remotes"
|
||||||
|
|
||||||
{- Checks a symlink target to see if it appears to point to annexed content. -}
|
{- Checks a symlink target to see if it appears to point to annexed content. -}
|
||||||
isLinkToAnnex :: FilePath -> Bool
|
isLinkToAnnex :: FilePath -> Bool
|
||||||
isLinkToAnnex s = ("/" ++ d) `isInfixOf` s || d `isPrefixOf` s
|
isLinkToAnnex s = ('/':d) `isInfixOf` s || d `isPrefixOf` s
|
||||||
where
|
where
|
||||||
d = ".git" </> objectDir
|
d = ".git" </> objectDir
|
||||||
|
|
||||||
|
|
|
@ -183,7 +183,7 @@ setupConsole = do
|
||||||
fileEncoding stderr
|
fileEncoding stderr
|
||||||
|
|
||||||
handle :: IO () -> IO () -> Annex ()
|
handle :: IO () -> IO () -> Annex ()
|
||||||
handle json normal = withOutputType $ go
|
handle json normal = withOutputType go
|
||||||
where
|
where
|
||||||
go NormalOutput = liftIO normal
|
go NormalOutput = liftIO normal
|
||||||
go QuietOutput = q
|
go QuietOutput = q
|
||||||
|
|
|
@ -10,12 +10,11 @@ module Utility.Directory where
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Control.Exception (throw)
|
import Control.Exception (throw, bracket_)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IfElse
|
import Control.Monad.IfElse
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Exception (bracket_)
|
|
||||||
import System.Posix.Directory
|
import System.Posix.Directory
|
||||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue