hlint
This commit is contained in:
		
					parent
					
						
							
								dd667844b6
							
						
					
				
			
			
				commit
				
					
						b61c6bc2ff
					
				
			
		
					 18 changed files with 50 additions and 52 deletions
				
			
		
							
								
								
									
										30
									
								
								Assistant.hs
									
										
									
									
									
								
							
							
						
						
									
										30
									
								
								Assistant.hs
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -147,7 +147,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 | 
			
		|||
		let threads = if isJust cannotrun
 | 
			
		||||
			then webappthread
 | 
			
		||||
			else webappthread ++
 | 
			
		||||
				[ watch $ commitThread
 | 
			
		||||
				[ watch commitThread
 | 
			
		||||
#ifdef WITH_WEBAPP
 | 
			
		||||
#ifdef WITH_PAIRING
 | 
			
		||||
				, assist $ pairListenerThread urlrenderer
 | 
			
		||||
| 
						 | 
				
			
			@ -158,29 +158,29 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 | 
			
		|||
				, assist $ xmppReceivePackThread urlrenderer
 | 
			
		||||
#endif
 | 
			
		||||
#endif
 | 
			
		||||
				, assist $ pushThread
 | 
			
		||||
				, assist $ pushRetryThread
 | 
			
		||||
				, assist $ mergeThread
 | 
			
		||||
				, assist $ transferWatcherThread
 | 
			
		||||
				, assist $ transferPollerThread
 | 
			
		||||
				, assist $ transfererThread
 | 
			
		||||
				, assist $ remoteControlThread
 | 
			
		||||
				, assist $ daemonStatusThread
 | 
			
		||||
				, assist pushThread
 | 
			
		||||
				, assist pushRetryThread
 | 
			
		||||
				, assist mergeThread
 | 
			
		||||
				, assist transferWatcherThread
 | 
			
		||||
				, assist transferPollerThread
 | 
			
		||||
				, assist transfererThread
 | 
			
		||||
				, assist remoteControlThread
 | 
			
		||||
				, assist daemonStatusThread
 | 
			
		||||
				, assist $ sanityCheckerDailyThread urlrenderer
 | 
			
		||||
				, assist $ sanityCheckerHourlyThread
 | 
			
		||||
				, assist sanityCheckerHourlyThread
 | 
			
		||||
				, assist $ problemFixerThread urlrenderer
 | 
			
		||||
#ifdef WITH_CLIBS
 | 
			
		||||
				, assist $ mountWatcherThread urlrenderer
 | 
			
		||||
#endif
 | 
			
		||||
				, assist $ netWatcherThread
 | 
			
		||||
				, assist netWatcherThread
 | 
			
		||||
				, assist $ upgraderThread urlrenderer
 | 
			
		||||
				, assist $ upgradeWatcherThread urlrenderer
 | 
			
		||||
				, assist $ netWatcherFallbackThread
 | 
			
		||||
				, assist netWatcherFallbackThread
 | 
			
		||||
				, assist $ transferScannerThread urlrenderer
 | 
			
		||||
				, assist $ cronnerThread urlrenderer
 | 
			
		||||
				, assist $ configMonitorThread
 | 
			
		||||
				, assist $ glacierThread
 | 
			
		||||
				, watch $ watchThread
 | 
			
		||||
				, assist configMonitorThread
 | 
			
		||||
				, assist glacierThread
 | 
			
		||||
				, watch watchThread
 | 
			
		||||
				-- must come last so that all threads that wait
 | 
			
		||||
				-- on it have already started waiting
 | 
			
		||||
				, watch $ sanityCheckerStartupThread startdelay
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6,7 +6,6 @@
 | 
			
		|||
 -}
 | 
			
		||||
 | 
			
		||||
{-# LANGUAGE CPP #-}
 | 
			
		||||
{-# LANGUAGE BangPatterns #-}
 | 
			
		||||
 | 
			
		||||
module CmdLine (
 | 
			
		||||
	dispatch,
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -177,14 +177,14 @@ ingest (Just source) = withTSDelta $ \delta -> do
 | 
			
		|||
			(undo (keyFilename source) key)
 | 
			
		||||
		maybe noop (genMetaData key (keyFilename source)) ms
 | 
			
		||||
		liftIO $ nukeFile $ keyFilename source
 | 
			
		||||
		return $ (Just key, mcache)
 | 
			
		||||
		return (Just key, mcache)
 | 
			
		||||
	goindirect _ _ _ = failure "failed to generate a key"
 | 
			
		||||
 | 
			
		||||
	godirect (Just (key, _)) (Just cache) ms = do
 | 
			
		||||
		addInodeCache key cache
 | 
			
		||||
		maybe noop (genMetaData key (keyFilename source)) ms
 | 
			
		||||
		finishIngestDirect key source
 | 
			
		||||
		return $ (Just key, Just cache)
 | 
			
		||||
		return (Just key, Just cache)
 | 
			
		||||
	godirect _ _ _ = failure "failed to generate a key"
 | 
			
		||||
 | 
			
		||||
	failure msg = do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -30,7 +30,7 @@ start gcryptid = next $ next $ do
 | 
			
		|||
	g <- gitRepo
 | 
			
		||||
	gu <- Remote.GCrypt.getGCryptUUID True g
 | 
			
		||||
	let newgu = genUUIDInNameSpace gCryptNameSpace gcryptid
 | 
			
		||||
	if gu == Nothing || gu == Just newgu
 | 
			
		||||
	if isNothing gu || gu == Just newgu
 | 
			
		||||
		then if Git.repoIsLocalBare g
 | 
			
		||||
			then do
 | 
			
		||||
				void $ Remote.GCrypt.setupRepo gcryptid g
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -96,7 +96,7 @@ start mode (srcfile, destfile) =
 | 
			
		|||
	handleexisting Nothing = noop
 | 
			
		||||
	handleexisting (Just s)
 | 
			
		||||
		| isDirectory s = notoverwriting "(is a directory)"
 | 
			
		||||
		| otherwise = ifM (Annex.getState Annex.force) $
 | 
			
		||||
		| otherwise = ifM (Annex.getState Annex.force)
 | 
			
		||||
			( liftIO $ nukeFile destfile
 | 
			
		||||
			, notoverwriting "(use --force to override)"
 | 
			
		||||
			)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -264,7 +264,7 @@ backend_usage = stat "backend usage" $ nojson $
 | 
			
		|||
  where
 | 
			
		||||
	calc x y = multiLine $
 | 
			
		||||
		map (\(n, b) -> b ++ ": " ++ show n) $
 | 
			
		||||
		reverse $ sort $ map swap $ M.toList $
 | 
			
		||||
		sortBy (flip compare) $ map swap $ M.toList $
 | 
			
		||||
		M.unionWith (+) x y
 | 
			
		||||
 | 
			
		||||
numcopies_stats :: Stat
 | 
			
		||||
| 
						 | 
				
			
			@ -273,7 +273,7 @@ numcopies_stats = stat "numcopies stats" $ nojson $
 | 
			
		|||
  where
 | 
			
		||||
	calc = multiLine
 | 
			
		||||
		. map (\(variance, count) -> show variance ++ ": " ++ show count)
 | 
			
		||||
		. reverse . sortBy (comparing snd) . M.toList
 | 
			
		||||
		. sortBy (flip (comparing snd)) . M.toList
 | 
			
		||||
 | 
			
		||||
cachedPresentData :: StatState KeyData
 | 
			
		||||
cachedPresentData = do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -63,7 +63,7 @@ findExisting name = do
 | 
			
		|||
	return $ headMaybe matches
 | 
			
		||||
 | 
			
		||||
newConfig :: String -> R.RemoteConfig
 | 
			
		||||
newConfig name = M.singleton nameKey name
 | 
			
		||||
newConfig = M.singleton nameKey
 | 
			
		||||
 | 
			
		||||
findByName :: String ->  M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
 | 
			
		||||
findByName n = filter (matching . snd) . M.toList
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -32,7 +32,7 @@ seek ps = do
 | 
			
		|||
		ps
 | 
			
		||||
 | 
			
		||||
start :: Maybe Remote -> Maybe Remote -> FilePath -> Key -> CommandStart
 | 
			
		||||
start to from file key = startKey to from (Just file) key
 | 
			
		||||
start to from file = startKey to from (Just file)
 | 
			
		||||
 | 
			
		||||
startKey :: Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
 | 
			
		||||
startKey to from afile key = do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -34,7 +34,7 @@ seek ps = do
 | 
			
		|||
		ps
 | 
			
		||||
 | 
			
		||||
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> Key -> CommandStart
 | 
			
		||||
start to from move file key = start' to from move (Just file) key
 | 
			
		||||
start to from move = start' to from move . Just
 | 
			
		||||
 | 
			
		||||
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
 | 
			
		||||
startKey to from move = start' to from move Nothing
 | 
			
		||||
| 
						 | 
				
			
			@ -91,7 +91,7 @@ expectedPresent dest key = do
 | 
			
		|||
	return $ dest `elem` remotes
 | 
			
		||||
 | 
			
		||||
toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform
 | 
			
		||||
toPerform dest move key afile fastcheck isthere = do
 | 
			
		||||
toPerform dest move key afile fastcheck isthere =
 | 
			
		||||
	case isthere of
 | 
			
		||||
		Left err -> do
 | 
			
		||||
			showNote err
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -51,7 +51,7 @@ start = do
 | 
			
		|||
	
 | 
			
		||||
	-- No messages need to be received from the caller,
 | 
			
		||||
	-- but when it closes the connection, notice and terminate.
 | 
			
		||||
	let receiver = forever $ void $ getLine
 | 
			
		||||
	let receiver = forever $ void getLine
 | 
			
		||||
	void $ liftIO $ concurrently sender receiver
 | 
			
		||||
	stop
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -22,8 +22,7 @@ seek = withWords start
 | 
			
		|||
 | 
			
		||||
start :: [String] -> CommandStart
 | 
			
		||||
start [] = startGet
 | 
			
		||||
start [s] = do
 | 
			
		||||
	case readish s of
 | 
			
		||||
start [s] = case readish s of
 | 
			
		||||
	Nothing -> error $ "Bad number: " ++ s
 | 
			
		||||
	Just n
 | 
			
		||||
		| n > 0 -> startSet n
 | 
			
		||||
| 
						 | 
				
			
			@ -39,9 +38,9 @@ startGet = next $ next $ do
 | 
			
		|||
	Annex.setOutput QuietOutput
 | 
			
		||||
	v <- getGlobalNumCopies
 | 
			
		||||
	case v of
 | 
			
		||||
		Just n -> liftIO $ putStrLn $ show $ fromNumCopies n
 | 
			
		||||
		Just n -> liftIO $ print $ fromNumCopies n
 | 
			
		||||
		Nothing -> do
 | 
			
		||||
			liftIO $ putStrLn $ "global numcopies is not set"
 | 
			
		||||
			liftIO $ putStrLn "global numcopies is not set"
 | 
			
		||||
			old <- deprecatedNumCopies
 | 
			
		||||
			case old of
 | 
			
		||||
				Nothing -> liftIO $ putStrLn "(default is 1)"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -59,7 +59,7 @@ startIndirect f = next $ do
 | 
			
		|||
	next $ return True
 | 
			
		||||
 | 
			
		||||
startDirect :: [String] -> CommandStart
 | 
			
		||||
startDirect _ = next $ next $ preCommitDirect
 | 
			
		||||
startDirect _ = next $ next preCommitDirect
 | 
			
		||||
 | 
			
		||||
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
 | 
			
		||||
addViewMetaData v f k = do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -68,7 +68,7 @@ repairAnnexBranch modifiedbranches
 | 
			
		|||
				)
 | 
			
		||||
		)
 | 
			
		||||
  where
 | 
			
		||||
	okindex = Annex.Branch.withIndex $ inRepo $ Git.Repair.checkIndex
 | 
			
		||||
	okindex = Annex.Branch.withIndex $ inRepo Git.Repair.checkIndex
 | 
			
		||||
	commitindex = do
 | 
			
		||||
		Annex.Branch.forceCommit "committing index after git repository repair"
 | 
			
		||||
		liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index"
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,7 +19,7 @@ def = [command "resolvemerge" paramNothing seek SectionPlumbing
 | 
			
		|||
	"resolve merge conflicts"]
 | 
			
		||||
 | 
			
		||||
seek :: CommandSeek
 | 
			
		||||
seek ps = withNothing start ps
 | 
			
		||||
seek = withNothing start
 | 
			
		||||
 | 
			
		||||
start :: CommandStart
 | 
			
		||||
start = do
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										2
									
								
								Limit.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								Limit.hs
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -82,7 +82,7 @@ addExclude = addLimit . limitExclude
 | 
			
		|||
limitExclude :: MkLimit Annex
 | 
			
		||||
limitExclude glob = Right $ const $ return . not . matchGlobFile glob
 | 
			
		||||
 | 
			
		||||
matchGlobFile :: String -> (MatchInfo -> Bool)
 | 
			
		||||
matchGlobFile :: String -> MatchInfo -> Bool
 | 
			
		||||
matchGlobFile glob = go
 | 
			
		||||
	where
 | 
			
		||||
		cglob = compileGlob glob CaseSensative -- memoized
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										2
									
								
								Logs.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								Logs.hs
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -173,7 +173,7 @@ prop_logs_sane dummykey = and
 | 
			
		|||
	, expect gotNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)
 | 
			
		||||
	, expect gotChunkLog (getLogVariety $ chunkLogFile dummykey)
 | 
			
		||||
	, expect gotOtherLog (getLogVariety $ metaDataLogFile dummykey)
 | 
			
		||||
	, expect gotOtherLog (getLogVariety $ numcopiesLog)
 | 
			
		||||
	, expect gotOtherLog (getLogVariety numcopiesLog)
 | 
			
		||||
	]
 | 
			
		||||
  where
 | 
			
		||||
	expect = maybe False
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -103,12 +103,12 @@ byNameWithUUID = checkuuid <=< byName
 | 
			
		|||
  where
 | 
			
		||||
	checkuuid Nothing = return Nothing
 | 
			
		||||
	checkuuid (Just r)
 | 
			
		||||
		| uuid r == NoUUID =
 | 
			
		||||
		| uuid r == NoUUID = error $
 | 
			
		||||
			if remoteAnnexIgnore (gitconfig r)
 | 
			
		||||
				then error $ noRemoteUUIDMsg r ++
 | 
			
		||||
				then noRemoteUUIDMsg r ++
 | 
			
		||||
					" (" ++ show (remoteConfig (repo r) "ignore") ++
 | 
			
		||||
					" is set)"
 | 
			
		||||
				else error $ noRemoteUUIDMsg r
 | 
			
		||||
				else noRemoteUUIDMsg r
 | 
			
		||||
		| otherwise = return $ Just r
 | 
			
		||||
 | 
			
		||||
byName' :: RemoteName -> Annex (Either String Remote)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										10
									
								
								Test.hs
									
										
									
									
									
								
							
							
						
						
									
										10
									
								
								Test.hs
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -957,7 +957,7 @@ test_nonannexed_file_conflict_resolution testenv = do
 | 
			
		|||
	check False True
 | 
			
		||||
  where
 | 
			
		||||
	check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 -> do
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 ->
 | 
			
		||||
			whenM (isInDirect r1 <&&> isInDirect r2) $ do
 | 
			
		||||
				indir testenv r1 $ do
 | 
			
		||||
					disconnectOrigin
 | 
			
		||||
| 
						 | 
				
			
			@ -1007,7 +1007,7 @@ test_nonannexed_symlink_conflict_resolution testenv = do
 | 
			
		|||
	check False True
 | 
			
		||||
  where
 | 
			
		||||
	check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 -> do
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 ->
 | 
			
		||||
			whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1
 | 
			
		||||
			       <&&> isInDirect r1 <&&> isInDirect r2) $ do
 | 
			
		||||
				indir testenv r1 $ do
 | 
			
		||||
| 
						 | 
				
			
			@ -1094,9 +1094,9 @@ test_uncommitted_conflict_resolution testenv = do
 | 
			
		|||
 - lost track of whether a file was a symlink. 
 | 
			
		||||
 -}
 | 
			
		||||
test_conflict_resolution_symlink_bit :: TestEnv -> Assertion
 | 
			
		||||
test_conflict_resolution_symlink_bit testenv = do
 | 
			
		||||
test_conflict_resolution_symlink_bit testenv =
 | 
			
		||||
	withtmpclonerepo testenv False $ \r1 ->
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 -> do
 | 
			
		||||
		withtmpclonerepo testenv False $ \r2 ->
 | 
			
		||||
			withtmpclonerepo testenv False $ \r3 -> do
 | 
			
		||||
				indir testenv r1 $ do
 | 
			
		||||
					writeFile conflictor "conflictor"
 | 
			
		||||
| 
						 | 
				
			
			@ -1152,7 +1152,7 @@ test_uninit_inbranch testenv = intmpclonerepoInDirect testenv $ do
 | 
			
		|||
	not <$> git_annex testenv "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"
 | 
			
		||||
 | 
			
		||||
test_upgrade :: TestEnv -> Assertion
 | 
			
		||||
test_upgrade testenv = intmpclonerepo testenv $ do
 | 
			
		||||
test_upgrade testenv = intmpclonerepo testenv $
 | 
			
		||||
	git_annex testenv "upgrade" [] @? "upgrade from same version failed"
 | 
			
		||||
 | 
			
		||||
test_whereis :: TestEnv -> Assertion
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue