hlint

Assistant/Threads/Committer.hs

@@ -112,7 +112,7 @@ waitChangeTime a = waitchanges 0
 	 - that make up a file rename? Or some of the pairs that make up 
 	 - a directory rename?
 	 -}
-	possiblyrename cs = all renamepart cs
+	possiblyrename = all renamepart
 
 	renamepart (PendingAddChange _ _) = True
 	renamepart c = isRmChange c
@@ -309,7 +309,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 			inRepo (Git.LsFiles.notInRepo False $ map changeFile pending)
 		-- note: timestamp info is lost here
 		let ts = changeTime exemplar
-		return (map (PendingAddChange ts) newfiles, void $ liftIO $ cleanup)
+		return (map (PendingAddChange ts) newfiles, void $ liftIO cleanup)
 
 	returnWhen c a
 		| c = return otherchanges
@@ -317,12 +317,13 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 
 	add :: Change -> Assistant (Maybe Change)
 	add change@(InProcessAddChange { keySource = ks }) = 
-		catchDefaultIO Nothing <~> do
-			sanitycheck ks $ do
-				(mkey, mcache) <- liftAnnex $ do
-					showStart "add" $ keyFilename ks
-					Command.Add.ingest $ Just ks
-				maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
+		catchDefaultIO Nothing <~> doadd
+	  where
+	  	doadd = sanitycheck ks $ do
+			(mkey, mcache) <- liftAnnex $ do
+				showStart "add" $ keyFilename ks
+				Command.Add.ingest $ Just ks
+			maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
 	add _ = return Nothing
 
 	{- In direct mode, avoid overhead of re-injesting a renamed
@@ -371,7 +372,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 			( inRepo $ gitAnnexLink file key
 			, Command.Add.link file key mcache
 			)
-		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
+		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $
 			stageSymlink file =<< hashSymlink link
 		showEndOk
 		return $ Just $ finishedChange change key
@@ -415,8 +416,8 @@ safeToAdd _ [] [] = return []
 safeToAdd delayadd pending inprocess = do
 	maybe noop (liftIO . threadDelaySeconds) delayadd
 	liftAnnex $ do
-		keysources <- mapM Command.Add.lockDown (map changeFile pending)
-		let inprocess' = inprocess ++ catMaybes (map mkinprocess $ zip pending keysources)
+		keysources <- forM pending $ Command.Add.lockDown . changeFile
+		let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources)
 		openfiles <- S.fromList . map fst3 . filter openwrite <$>
 			findopenfiles (map keySource inprocess')
 		let checked = map (check openfiles) inprocess'
@@ -434,7 +435,7 @@ safeToAdd delayadd pending inprocess = do
 		| S.member (contentLocation ks) openfiles = Left change
 	check _ change = Right change
 
-	mkinprocess (c, Just ks) = Just $ InProcessAddChange
+	mkinprocess (c, Just ks) = Just InProcessAddChange
 		{ changeTime = changeTime c
 		, keySource = ks
 		}

Assistant/Threads/ConfigMonitor.hs

@@ -54,7 +54,7 @@ type Configs = S.Set (FilePath, String)
 {- All git-annex's config files, and actions to run when they change. -}
 configFilesActions :: [(FilePath, Annex ())]
 configFilesActions =
-	[ (uuidLog, void $ uuidMapLoad)
+	[ (uuidLog, void uuidMapLoad)
 	, (remoteLog, void remoteListRefresh)
 	, (trustLog, void trustMapLoad)
 	, (groupLog, void groupMapLoad)
@@ -71,7 +71,7 @@ reloadConfigs changedconfigs = do
 	{- Changes to the remote log, or the trust log, can affect the
 	 - syncRemotes list. Changes to the uuid log may affect its
 	 - display so are also included. -}
-	when (any (`elem` fs) [remoteLog, trustLog, uuidLog]) $
+	when (any (`elem` fs) [remoteLog, trustLog, uuidLog])
 		updateSyncRemotes
   where
 	(fs, as) = unzip $ filter (flip S.member changedfiles . fst)

Assistant/Threads/Glacier.hs

@@ -30,7 +30,7 @@ glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go
 	go = do
 		rs <- filter isglacier . syncDataRemotes <$> getDaemonStatus
 		forM_ rs $ \r -> 
-			check r =<< (liftAnnex $ getFailedTransfers $ Remote.uuid r)
+			check r =<< liftAnnex (getFailedTransfers $ Remote.uuid r)
 	check _ [] = noop
 	check r l = do
 		let keys = map getkey l

Assistant/Threads/Merger.hs

@@ -54,7 +54,7 @@ runHandler handler file _filestatus =
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr msg = error msg
+onErr = error
 
 {- Called when a new branch ref is written, or a branch ref is modified.
  -
@@ -110,7 +110,7 @@ equivBranches x y = base x == base y
 isAnnexBranch :: FilePath -> Bool
 isAnnexBranch f = n `isSuffixOf` f
   where
-	n = "/" ++ show Annex.Branch.name
+	n = '/' : show Annex.Branch.name
 
 fileToBranch :: FilePath -> Git.Ref
 fileToBranch f = Git.Ref $ "refs" </> base

Assistant/Threads/MountWatcher.hs

@@ -34,7 +34,7 @@ import qualified Control.Exception as E
 #endif
 
 mountWatcherThread :: NamedThread
-mountWatcherThread = namedThread "MountWatcher" $
+mountWatcherThread = namedThread "MountWatcher"
 #if WITH_DBUS
 	dbusThread
 #else
@@ -173,10 +173,10 @@ remotesUnder dir = do
 	rs <- liftAnnex remoteList
 	pairs <- liftAnnex $ mapM (checkremote repotop) rs
 	let (waschanged, rs') = unzip pairs
-	when (any id waschanged) $ do
+	when (or waschanged) $ do
 		liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = catMaybes rs' }
 		updateSyncRemotes
-	return $ catMaybes $ map snd $ filter fst pairs
+	return $ mapMaybe snd $ filter fst pairs
   where
 	checkremote repotop r = case Remote.localpath r of
 		Just p | dirContains dir (absPathFrom repotop p) ->

Assistant/Threads/SanityChecker.hs

@@ -42,7 +42,7 @@ sanityCheckerDailyThread = namedThread "SanityCheckerDaily" $ forever $ do
 	go = do
 		modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True }
 
-		now <- liftIO $ getPOSIXTime -- before check started
+		now <- liftIO getPOSIXTime -- before check started
 		r <- either showerr return =<< (tryIO . batch) <~> dailyCheck
 
 		modifyDaemonStatus_ $ \s -> s
@@ -78,7 +78,7 @@ dailyCheck = do
 
 	-- Find old unstaged symlinks, and add them to git.
 	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g
-	now <- liftIO $ getPOSIXTime
+	now <- liftIO getPOSIXTime
 	forM_ unstaged $ \file -> do
 		ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file
 		case ms of

Assistant/Threads/TransferScanner.hs

@@ -85,13 +85,13 @@ failedTransferScan r = do
 	mapM_ retry failed
   where
 	retry (t, info)
-		| transferDirection t == Download = do
+		| transferDirection t == Download =
 			{- Check if the remote still has the key.
 			 - If not, relies on the expensiveScan to
 			 - get it queued from some other remote. -}
 			whenM (liftAnnex $ remoteHas r $ transferKey t) $
 				requeue t info
-		| otherwise = do
+		| otherwise =
 			{- The Transferrer checks when uploading
 			 - that the remote doesn't already have the
 			 - key, so it's not redundantly checked here. -}
@@ -161,7 +161,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
 			present key (Just f) Nothing
 		liftAnnex $ do
 			let slocs = S.fromList locs
-			let use a = return $ catMaybes $ map (a key slocs) syncrs
+			let use a = return $ mapMaybe (a key slocs) syncrs
 			ts <- if present
 				then filterM (wantSend True (Just f) . Remote.uuid . fst)
 					=<< use (genTransfer Upload False)
@@ -173,7 +173,7 @@ expensiveScan urlrenderer rs = unless onlyweb $ batch <~> do
 genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer)
 genTransfer direction want key slocs r
 	| direction == Upload && Remote.readonly r = Nothing
-	| (S.member (Remote.uuid r) slocs) == want = Just
+	| S.member (Remote.uuid r) slocs == want = Just
 		(r, Transfer direction (Remote.uuid r) key)
 	| otherwise = Nothing
 

Assistant/Threads/TransferWatcher.hs

@@ -51,7 +51,7 @@ runHandler handler file _filestatus =
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr msg = error msg
+onErr = error
 
 {- Called when a new transfer information file is written. -}
 onAdd :: Handler
@@ -70,10 +70,9 @@ onAdd file = case parseTransferFile file of
  - The only thing that should change in the transfer info is the
  - bytesComplete, so that's the only thing updated in the DaemonStatus. -}
 onModify :: Handler
-onModify file = do
-	case parseTransferFile file of
-		Nothing -> noop
-		Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
+onModify file = case parseTransferFile file of
+	Nothing -> noop
+	Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
   where
 	go _ Nothing = noop
 	go t (Just newinfo) = alterTransferInfo t $

Assistant/Threads/Transferrer.hs

@@ -31,7 +31,7 @@ transfererThread :: NamedThread
 transfererThread = namedThread "Transferrer" $ do
 	program <- liftIO readProgramFile
 	forever $ inTransferSlot program $
-		maybe (return Nothing) (uncurry $ genTransfer)
+		maybe (return Nothing) (uncurry genTransfer)
 			=<< getNextTransfer notrunning
   where
 	{- Skip transfers that are already running. -}
@@ -96,7 +96,7 @@ genTransfer t info = case (transferRemote info, associatedFile info) of
 					True (transferKey t)
 					(associatedFile info)
 					(Just remote)
-			void $ recordCommit
+			void recordCommit
 		, whenM (liftAnnex $ isNothing <$> checkTransfer t) $
 			void $ removeTransfer t
 		)

Assistant/Threads/Watcher.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE DeriveDataTypeable, BangPatterns, CPP #-}
+{-# LANGUAGE DeriveDataTypeable, CPP #-}
 
 module Assistant.Threads.Watcher (
 	watchThread,
@@ -79,7 +79,7 @@ watchThread = namedThread "Watcher" $
 runWatcher :: Assistant ()
 runWatcher = do
 	startup <- asIO1 startupScan
-	matcher <- liftAnnex $ largeFilesMatcher
+	matcher <- liftAnnex largeFilesMatcher
 	direct <- liftAnnex isDirect
 	symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig
 	addhook <- hook $ if direct
@@ -109,7 +109,7 @@ runWatcher = do
 
 waitFor :: WatcherException -> Assistant () -> Assistant ()
 waitFor sig next = do
-	r <- liftIO $ (E.try pause :: IO (Either E.SomeException ()))
+	r <- liftIO (E.try pause :: IO (Either E.SomeException ()))
 	case r of
 		Left e -> case E.fromException e of
 			Just s
@@ -124,7 +124,7 @@ startupScan :: IO a -> Assistant a
 startupScan scanner = do
 	liftAnnex $ showAction "scanning"
 	alertWhile' startupScanAlert $ do
-		r <- liftIO $ scanner
+		r <- liftIO scanner
 
 		-- Notice any files that were deleted before
 		-- watching was started.
@@ -133,7 +133,7 @@ startupScan scanner = do
 		forM_ fs $ \f -> do
 			liftAnnex $ onDel' f
 			maybe noop recordChange =<< madeChange f RmChange
-		void $ liftIO $ cleanup
+		void $ liftIO cleanup
 		
 		liftAnnex $ showAction "started"
 		liftIO $ putStrLn ""
@@ -176,7 +176,7 @@ runHandler handler file filestatus = void $ do
 		Right (Just change) -> do
 			-- Just in case the commit thread is not
 			-- flushing the queue fast enough.
-			liftAnnex $ Annex.Queue.flushWhenFull
+			liftAnnex Annex.Queue.flushWhenFull
 			recordChange change
   where
   	normalize f
@@ -340,8 +340,8 @@ onDelDir dir _ = do
 	now <- liftIO getCurrentTime
 	recordChanges $ map (\f -> Change now f RmChange) fs
 
-	void $ liftIO $ clean
-	liftAnnex $ Annex.Queue.flushWhenFull
+	void $ liftIO clean
+	liftAnnex Annex.Queue.flushWhenFull
 	noChange
 
 {- Called when there's an error with inotify or kqueue. -}

Assistant/Threads/XMPPClient.hs

@@ -103,9 +103,8 @@ xmppClient urlrenderer d creds =
 		 - will also be killed. -}
 		liftIO $ pinger `concurrently` sender `concurrently` receiver
 
-	sendnotifications selfjid = forever $ do
-		a <- inAssistant $ relayNetMessage selfjid
-		a
+	sendnotifications selfjid = forever $
+		join $ inAssistant $ relayNetMessage selfjid
 	receivenotifications selfjid lasttraffic = forever $ do
 		l <- decodeStanza selfjid <$> getStanza
 		void $ liftIO $ atomically . swapTMVar lasttraffic =<< getCurrentTime
@@ -115,7 +114,7 @@ xmppClient urlrenderer d creds =
 	sendpings selfjid lasttraffic = forever $ do
 		putStanza pingstanza
 
-		startping <- liftIO $ getCurrentTime
+		startping <- liftIO getCurrentTime
 		liftIO $ threadDelaySeconds (Seconds 120)
 		t <- liftIO $ atomically $ readTMVar lasttraffic
 		when (t < startping) $ do
@@ -154,8 +153,7 @@ xmppClient urlrenderer d creds =
 				, logJid jid
 				, show $ logNetMessage msg'
 				]
-			a <- inAssistant $ convertNetMsg msg' selfjid
-			a
+			join $ inAssistant $ convertNetMsg msg' selfjid
 			inAssistant $ sentImportantNetMessage msg c
 	resendImportantMessages _ _ = noop
 
@@ -196,7 +194,7 @@ logClient (Client jid) = logJid jid
 decodeStanza :: JID -> ReceivedStanza -> [XMPPEvent]
 decodeStanza selfjid s@(ReceivedPresence p)
 	| presenceType p == PresenceError = [ProtocolError s]
-	| presenceFrom p == Nothing = [Ignorable s]
+	| isNothing (presenceFrom p) = [Ignorable s]
 	| presenceFrom p == Just selfjid = [Ignorable s]
 	| otherwise = maybe [PresenceMessage p] decode (gitAnnexTagInfo p)
   where
@@ -209,7 +207,7 @@ decodeStanza selfjid s@(ReceivedPresence p)
 	 - along with their real meaning. -}
 	impliedp v = [PresenceMessage p, v]
 decodeStanza selfjid s@(ReceivedMessage m)
-	| messageFrom m == Nothing = [Ignorable s]
+	| isNothing (messageFrom m) = [Ignorable s]
 	| messageFrom m == Just selfjid = [Ignorable s]
 	| messageType m == MessageError = [ProtocolError s]
 	| otherwise = [fromMaybe (Unknown s) (GotNetMessage <$> decodeMessage m)]
@@ -241,13 +239,13 @@ relayNetMessage selfjid = do
 					\c -> (baseJID <$> parseJID c) == Just tojid
 				return $ putStanza presenceQuery
 		_ -> return noop
-	convert (Pushing c pushstage) = withOtherClient selfjid c $ \tojid -> do
+	convert (Pushing c pushstage) = withOtherClient selfjid c $ \tojid ->
 		if tojid == baseJID tojid
 			then do
 				clients <- maybe [] (S.toList . buddyAssistants)
 					<$> getBuddy (genBuddyKey tojid) <<~ buddyList
 				debug ["exploded undirected message to clients", unwords $ map logClient clients]
-				return $ forM_ (clients) $ \(Client jid) ->
+				return $ forM_ clients $ \(Client jid) ->
 					putStanza $ pushMessage pushstage jid selfjid
 			else do
 				debug ["to client:", logJid tojid]
@@ -266,7 +264,7 @@ convertNetMsg msg selfjid = convert msg
 	convert (Pushing c pushstage) = withOtherClient selfjid c $ \tojid ->
 		return $ putStanza $  pushMessage pushstage tojid selfjid
 
-withOtherClient :: JID -> ClientID -> (JID -> Assistant (XMPP ())) -> (Assistant (XMPP ()))
+withOtherClient :: JID -> ClientID -> (JID -> Assistant (XMPP ())) -> Assistant (XMPP ())
 withOtherClient selfjid c a = case parseJID c of
 	Nothing -> return noop
 	Just tojid
@@ -323,10 +321,10 @@ pairMsgReceived :: UrlRenderer -> PairStage -> UUID -> JID -> JID -> Assistant (
 pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid
 	| baseJID selfjid == baseJID theirjid = autoaccept
 	| otherwise = do
-		knownjids <- catMaybes . map (parseJID . getXMPPClientID)
+		knownjids <- mapMaybe (parseJID . getXMPPClientID)
 			. filter isXMPPRemote . syncRemotes <$> getDaemonStatus
 		um <- liftAnnex uuidMap
-		if any (== baseJID theirjid) knownjids && M.member theiruuid um
+		if elem (baseJID theirjid) knownjids && M.member theiruuid um
 			then autoaccept
 			else showalert