more hlint
This commit is contained in:
parent
4515fa10aa
commit
40cec65ace
6 changed files with 34 additions and 44 deletions
|
@ -5,8 +5,6 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module Command (
|
||||
command,
|
||||
noRepo,
|
||||
|
|
17
Limit.hs
17
Limit.hs
|
@ -9,11 +9,6 @@
|
|||
|
||||
module Limit where
|
||||
|
||||
import Data.Time.Clock.POSIX
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import System.Path.WildMatch
|
||||
|
||||
import Common.Annex
|
||||
import qualified Annex
|
||||
import qualified Utility.Matcher
|
||||
|
@ -35,14 +30,14 @@ import Git.Types (RefDate(..))
|
|||
import Utility.HumanTime
|
||||
import Utility.DataUnits
|
||||
|
||||
import Data.Time.Clock.POSIX
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import System.Path.WildMatch
|
||||
|
||||
#ifdef WITH_TDFA
|
||||
import Text.Regex.TDFA
|
||||
import Text.Regex.TDFA.String
|
||||
#else
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Path.WildMatch
|
||||
import Types.FileMatcher
|
||||
#endif
|
||||
#endif
|
||||
|
||||
{- Checks if there are user-specified limits. -}
|
||||
|
@ -156,7 +151,7 @@ limitPresent u _ = Right $ const $ checkKey $ \key -> do
|
|||
limitInDir :: FilePath -> MkLimit
|
||||
limitInDir dir = const $ Right $ const go
|
||||
where
|
||||
go (MatchingFile fi) = return $ any (== dir) $ splitPath $ takeDirectory $ matchFile fi
|
||||
go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi
|
||||
go (MatchingKey _) = return False
|
||||
|
||||
{- Adds a limit to skip files not believed to have the specified number
|
||||
|
|
|
@ -330,7 +330,7 @@ preSanitizeKeyName = concatMap escape
|
|||
-- other characters. By itself, it is escaped to
|
||||
-- doubled form.
|
||||
| c == ',' = ",,"
|
||||
| otherwise = ',' : show(ord(c))
|
||||
| otherwise = ',' : show (ord c)
|
||||
|
||||
{- Converts a key into a filename fragment without any directory.
|
||||
-
|
||||
|
|
2
Logs.hs
2
Logs.hs
|
@ -120,7 +120,7 @@ isRemoteStateLog :: FilePath -> Bool
|
|||
isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path
|
||||
|
||||
prop_logs_sane :: Key -> Bool
|
||||
prop_logs_sane dummykey = all id
|
||||
prop_logs_sane dummykey = and
|
||||
[ isNothing (getLogVariety "unknown")
|
||||
, expect isUUIDBasedLog (getLogVariety uuidLog)
|
||||
, expect isPresenceLog (getLogVariety $ locationLogFile dummykey)
|
||||
|
|
|
@ -189,8 +189,7 @@ prettyUUID u = concat <$> prettyListUUIDs [u]
|
|||
remoteFromUUID :: UUID -> Annex (Maybe Remote)
|
||||
remoteFromUUID u = ifM ((==) u <$> getUUID)
|
||||
( return Nothing
|
||||
, do
|
||||
maybe tryharder (return . Just) =<< findinmap
|
||||
, maybe tryharder (return . Just) =<< findinmap
|
||||
)
|
||||
where
|
||||
findinmap = M.lookup u <$> remoteMap id
|
||||
|
|
52
Test.hs
52
Test.hs
|
@ -149,7 +149,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
|
|||
{- These tests set up the test environment, but also test some basic parts
|
||||
- of git-annex. They are always run before the unitTests. -}
|
||||
initTests :: TestEnv -> TestTree
|
||||
initTests env = testGroup ("Init Tests")
|
||||
initTests env = testGroup "Init Tests"
|
||||
[ check "init" test_init
|
||||
, check "add" test_add
|
||||
]
|
||||
|
@ -258,7 +258,7 @@ test_reinject :: TestEnv -> Assertion
|
|||
test_reinject env = intmpclonerepoInDirect env $ do
|
||||
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
|
||||
writeFile tmp $ content sha1annexedfile
|
||||
r <- annexeval $ Types.Backend.getKey backendSHA1 $
|
||||
r <- annexeval $ Types.Backend.getKey backendSHA1
|
||||
Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing }
|
||||
let key = Types.Key.key2file $ fromJust r
|
||||
git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed"
|
||||
|
@ -542,7 +542,7 @@ test_fsck_basic env = intmpclonerepo env $ do
|
|||
git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f
|
||||
|
||||
test_fsck_bare :: TestEnv -> Assertion
|
||||
test_fsck_bare env = intmpbareclonerepo env $ do
|
||||
test_fsck_bare env = intmpbareclonerepo env $
|
||||
git_annex env "fsck" [] @? "fsck failed"
|
||||
|
||||
test_fsck_localuntrusted :: TestEnv -> Assertion
|
||||
|
@ -585,7 +585,7 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do
|
|||
annexed_present sha1annexedfile
|
||||
if usegitattributes
|
||||
then do
|
||||
writeFile ".gitattributes" $ "* annex.backend=SHA1"
|
||||
writeFile ".gitattributes" "* annex.backend=SHA1"
|
||||
git_annex env "migrate" [sha1annexedfile]
|
||||
@? "migrate sha1annexedfile failed"
|
||||
git_annex env "migrate" [annexedfile]
|
||||
|
@ -601,7 +601,7 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do
|
|||
checkbackend sha1annexedfile backendSHA1
|
||||
|
||||
-- check that reversing a migration works
|
||||
writeFile ".gitattributes" $ "* annex.backend=SHA256"
|
||||
writeFile ".gitattributes" "* annex.backend=SHA256"
|
||||
git_annex env "migrate" [sha1annexedfile]
|
||||
@? "migrate sha1annexedfile failed"
|
||||
git_annex env "migrate" [annexedfile]
|
||||
|
@ -712,7 +712,7 @@ test_find env = intmpclonerepo env $ do
|
|||
git_annex_expectoutput env "find" ["--exclude", "*"] []
|
||||
|
||||
test_merge :: TestEnv -> Assertion
|
||||
test_merge env = intmpclonerepo env $ do
|
||||
test_merge env = intmpclonerepo env $
|
||||
git_annex env "merge" [] @? "merge failed"
|
||||
|
||||
test_info :: TestEnv -> Assertion
|
||||
|
@ -723,7 +723,7 @@ test_info env = intmpclonerepo env $ do
|
|||
Text.JSON.Error e -> assertFailure e
|
||||
|
||||
test_version :: TestEnv -> Assertion
|
||||
test_version env = intmpclonerepo env $ do
|
||||
test_version env = intmpclonerepo env $
|
||||
git_annex env "version" [] @? "version failed"
|
||||
|
||||
test_sync :: TestEnv -> Assertion
|
||||
|
@ -739,8 +739,8 @@ test_sync env = intmpclonerepo env $ do
|
|||
test_union_merge_regression :: TestEnv -> Assertion
|
||||
test_union_merge_regression env =
|
||||
{- We need 3 repos to see this bug. -}
|
||||
withtmpclonerepo env False $ \r1 -> do
|
||||
withtmpclonerepo env False $ \r2 -> do
|
||||
withtmpclonerepo env False $ \r1 ->
|
||||
withtmpclonerepo env False $ \r2 ->
|
||||
withtmpclonerepo env False $ \r3 -> do
|
||||
forM_ [r1, r2, r3] $ \r -> indir env r $ do
|
||||
when (r /= r1) $
|
||||
|
@ -766,7 +766,7 @@ test_union_merge_regression env =
|
|||
{- Regression test for the automatic conflict resolution bug fixed
|
||||
- in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -}
|
||||
test_conflict_resolution_movein_bug :: TestEnv -> Assertion
|
||||
test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do
|
||||
test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 ->
|
||||
withtmpclonerepo env False $ \r2 -> do
|
||||
let rname r = if r == r1 then "r1" else "r2"
|
||||
forM_ [r1, r2] $ \r -> indir env r $ do
|
||||
|
@ -785,7 +785,7 @@ test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do
|
|||
)
|
||||
{- Sync twice in r1 so it gets the conflict resolution
|
||||
- update from r2 -}
|
||||
forM_ [r1, r2, r1] $ \r -> indir env r $ do
|
||||
forM_ [r1, r2, r1] $ \r -> indir env r $
|
||||
git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r
|
||||
{- After the sync, it should be possible to get all
|
||||
- files. This includes both sides of the conflict,
|
||||
|
@ -935,7 +935,7 @@ test_hook_remote env = intmpclonerepo env $ do
|
|||
test_directory_remote :: TestEnv -> Assertion
|
||||
test_directory_remote env = intmpclonerepo env $ do
|
||||
createDirectory "dir"
|
||||
git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"
|
||||
git_annex env "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed"
|
||||
git_annex env "get" [annexedfile] @? "get of file failed"
|
||||
annexed_present annexedfile
|
||||
git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"
|
||||
|
@ -951,7 +951,7 @@ test_rsync_remote :: TestEnv -> Assertion
|
|||
test_rsync_remote env = intmpclonerepo env $ do
|
||||
#ifndef mingw32_HOST_OS
|
||||
createDirectory "dir"
|
||||
git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
|
||||
git_annex env "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"
|
||||
git_annex env "get" [annexedfile] @? "get of file failed"
|
||||
annexed_present annexedfile
|
||||
git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"
|
||||
|
@ -1085,7 +1085,7 @@ git_annex env command params = do
|
|||
Utility.Env.setEnv var val True
|
||||
|
||||
-- catch all errors, including normally fatal errors
|
||||
r <- try (run)::IO (Either SomeException ())
|
||||
r <- try run::IO (Either SomeException ())
|
||||
case r of
|
||||
Right _ -> return True
|
||||
Left _ -> return False
|
||||
|
@ -1126,7 +1126,7 @@ innewrepo :: TestEnv -> Assertion -> Assertion
|
|||
innewrepo env a = withgitrepo env $ \r -> indir env r a
|
||||
|
||||
inmainrepo :: TestEnv -> Assertion -> Assertion
|
||||
inmainrepo env a = indir env mainrepodir a
|
||||
inmainrepo env = indir env mainrepodir
|
||||
|
||||
intmpclonerepo :: TestEnv -> Assertion -> Assertion
|
||||
intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a
|
||||
|
@ -1163,7 +1163,7 @@ indir env dir a = do
|
|||
-- any type of error and change back to cwd before
|
||||
-- rethrowing.
|
||||
r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd)
|
||||
(try (a)::IO (Either SomeException ()))
|
||||
(try a::IO (Either SomeException ()))
|
||||
case r of
|
||||
Right () -> return ()
|
||||
Left e -> throw e
|
||||
|
@ -1186,7 +1186,7 @@ clonerepo env old new bare = do
|
|||
indir env new $
|
||||
git_annex env "init" ["-q", new] @? "git annex init failed"
|
||||
configrepo env new
|
||||
when (not bare) $
|
||||
unless bare $
|
||||
indir env new $
|
||||
handleforcedirect env
|
||||
return new
|
||||
|
@ -1218,12 +1218,12 @@ cleanup' final dir = whenM (doesDirectoryExist dir) $ do
|
|||
mapM_ (void . tryIO . Utility.FileMode.allowWrite)
|
||||
-- This sometimes fails on Windows, due to some files
|
||||
-- being still opened by a subprocess.
|
||||
catchIO (removeDirectoryRecursive dir) $ \e -> do
|
||||
catchIO (removeDirectoryRecursive dir) $ \e ->
|
||||
when final $ do
|
||||
print e
|
||||
putStrLn "sleeping 10 seconds and will retry directory cleanup"
|
||||
Utility.ThreadScheduler.threadDelaySeconds (Utility.ThreadScheduler.Seconds 10)
|
||||
whenM (doesDirectoryExist dir) $ do
|
||||
whenM (doesDirectoryExist dir) $
|
||||
removeDirectoryRecursive dir
|
||||
|
||||
checklink :: FilePath -> Assertion
|
||||
|
@ -1252,9 +1252,8 @@ checkunwritable f = unlessM (annexeval Config.isDirect) $ do
|
|||
-- modified despite permissions.
|
||||
s <- getFileStatus f
|
||||
let mode = fileMode s
|
||||
if (mode == mode `unionFileModes` ownerWriteMode)
|
||||
then assertFailure $ "able to modify annexed file's " ++ f ++ " content"
|
||||
else return ()
|
||||
when (mode == mode `unionFileModes` ownerWriteMode) $
|
||||
assertFailure $ "able to modify annexed file's " ++ f ++ " content"
|
||||
|
||||
checkwritable :: FilePath -> Assertion
|
||||
checkwritable f = do
|
||||
|
@ -1280,7 +1279,7 @@ checklocationlog f expected = do
|
|||
case r of
|
||||
Just (k, _) -> do
|
||||
uuids <- annexeval $ Remote.keyLocations k
|
||||
assertEqual ("bad content in location log for " ++ f ++ " key " ++ (Types.Key.key2file k) ++ " uuid " ++ show thisuuid)
|
||||
assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid)
|
||||
expected (thisuuid `elem` uuids)
|
||||
_ -> assertFailure $ f ++ " failed to look up key"
|
||||
|
||||
|
@ -1326,8 +1325,7 @@ withTestEnv forcedirect = withResource prepare release
|
|||
release = releaseTestEnv
|
||||
|
||||
releaseTestEnv :: TestEnv -> IO ()
|
||||
releaseTestEnv _env = do
|
||||
cleanup' True tmpdir
|
||||
releaseTestEnv _env = cleanup' True tmpdir
|
||||
|
||||
prepareTestEnv :: Bool -> IO TestEnv
|
||||
prepareTestEnv forcedirect = do
|
||||
|
@ -1404,7 +1402,7 @@ changecontent :: FilePath -> IO ()
|
|||
changecontent f = writeFile f $ changedcontent f
|
||||
|
||||
changedcontent :: FilePath -> String
|
||||
changedcontent f = (content f) ++ " (modified)"
|
||||
changedcontent f = content f ++ " (modified)"
|
||||
|
||||
backendSHA1 :: Types.Backend
|
||||
backendSHA1 = backend_ "SHA1"
|
||||
|
@ -1416,4 +1414,4 @@ backendWORM :: Types.Backend
|
|||
backendWORM = backend_ "WORM"
|
||||
|
||||
backend_ :: String -> Types.Backend
|
||||
backend_ name = Backend.lookupBackendName name
|
||||
backend_ = Backend.lookupBackendName
|
||||
|
|
Loading…
Reference in a new issue