hlint

Assistant/WebApp/Configurators.hs

@@ -17,7 +17,7 @@ import Assistant.XMPP.Client
 
 {- The main configuration screen. -}
 getConfigurationR :: Handler Html
-getConfigurationR = ifM (inFirstRun)
+getConfigurationR = ifM inFirstRun
 	( redirect FirstRepositoryR
 	, page "Configuration" (Just Configuration) $ do
 #ifdef WITH_XMPP

Assistant/WebApp/Configurators/AWS.hs

@@ -94,10 +94,10 @@ awsCredsAForm defcreds = AWSCreds
 	<*> secretAccessKeyField (T.pack . snd <$> defcreds)
 
 accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
-accessKeyIDField help def = areq (textField `withNote` help) "Access Key ID" def
+accessKeyIDField help = areq (textField `withNote` help) "Access Key ID"
 
 accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
-accessKeyIDFieldWithHelp def = accessKeyIDField help def
+accessKeyIDFieldWithHelp = accessKeyIDField help
   where
 	help = [whamlet|
 <a href="https://portal.aws.amazon.com/gp/aws/securityCredentials#id_block">
@@ -105,7 +105,7 @@ accessKeyIDFieldWithHelp def = accessKeyIDField help def
 |]
 
 secretAccessKeyField :: Maybe Text -> MkAForm Text
-secretAccessKeyField def = areq passwordField "Secret Access Key" def
+secretAccessKeyField = areq passwordField "Secret Access Key"
 
 datacenterField :: AWS.Service -> MkAForm Text
 datacenterField service = areq (selectFieldList list) "Datacenter" defregion

Assistant/WebApp/Configurators/Edit.hs

@@ -62,7 +62,7 @@ getRepoConfig uuid mremote = do
 		Nothing -> (RepoGroupCustom $ unwords $ S.toList groups, Nothing)
 		Just g -> (RepoGroupStandard g, associatedDirectory remoteconfig g)
 	
-	description <- maybe Nothing (Just . T.pack) . M.lookup uuid <$> uuidMap
+	description <- fmap T.pack . M.lookup uuid <$> uuidMap
 
 	syncable <- case mremote of
 		Just r -> return $ remoteAnnexSync $ Remote.gitconfig r
@@ -99,7 +99,7 @@ setRepoConfig uuid mremote oldc newc = do
 				, Param $ T.unpack $ repoName oldc
 				, Param name
 				]
-			void $ Remote.remoteListRefresh
+			void Remote.remoteListRefresh
 		liftAssistant updateSyncRemotes
 	when associatedDirectoryChanged $ case repoAssociatedDirectory newc of
 		Nothing -> noop
@@ -120,11 +120,9 @@ setRepoConfig uuid mremote oldc newc = do
 		 - so avoid queueing a duplicate scan. -}
 		when (repoSyncable newc && not syncableChanged) $ liftAssistant $
 			case mremote of
-				Just remote -> do
-					addScanRemotes True [remote]
-				Nothing -> do
-					addScanRemotes True
-						=<< syncDataRemotes <$> getDaemonStatus
+				Just remote -> addScanRemotes True [remote]
+				Nothing -> addScanRemotes True
+					=<< syncDataRemotes <$> getDaemonStatus
 	when syncableChanged $
 		changeSyncable mremote (repoSyncable newc)
   where

Assistant/WebApp/Configurators/IA.hs

@@ -111,7 +111,7 @@ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
 #endif
 
 accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
-accessKeyIDFieldWithHelp def = AWS.accessKeyIDField help def
+accessKeyIDFieldWithHelp = AWS.accessKeyIDField help
   where
 	help = [whamlet|
 <a href="http://archive.org/account/s3.php">

Assistant/WebApp/Configurators/Ssh.hs

@@ -428,7 +428,7 @@ enableRsyncNetGCrypt sshinput reponame =
 prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html
 prepRsyncNet sshinput reponame a = do
 	knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput)
-	keypair <- liftIO $ genSshKeyPair
+	keypair <- liftIO genSshKeyPair
 	sshdata <- liftIO $ setupSshKeyPair keypair $
 		(mkSshData sshinput)
 			{ sshRepoName = reponame 

Assistant/WebApp/Configurators/WebDAV.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
+{-# LANGUAGE CPP, TemplateHaskell, OverloadedStrings #-}
 
 module Assistant.WebApp.Configurators.WebDAV where
 

Assistant/WebApp/Configurators/XMPP.hs

@@ -151,6 +151,8 @@ buddyListDisplay = do
 		catMaybes . map (buddySummary pairedwith)
 			<$> (getBuddyList <<~ buddyList)
 	$(widgetFile "configurators/xmpp/buddylist")
+#else
+	noop
 #endif
   where
 	ident = "buddylist"

Assistant/WebApp/DashBoard.hs

@@ -52,7 +52,7 @@ simplifyTransfers [] = []
 simplifyTransfers (x:[]) = [x]
 simplifyTransfers (v@(t1, _):r@((t2, _):l))
 	| equivilantTransfer t1 t2 = simplifyTransfers (v:l)
-	| otherwise = v : (simplifyTransfers r)
+	| otherwise = v : simplifyTransfers r
 
 {- Called by client to get a display of currently in process transfers.
  -
@@ -78,7 +78,7 @@ dashboard warnNoScript = do
 	$(widgetFile "dashboard/main")
 
 getDashboardR :: Handler Html
-getDashboardR = ifM (inFirstRun)
+getDashboardR = ifM inFirstRun
 	( redirect ConfigurationR
 	, page "" (Just DashBoard) $ dashboard True
 	)
@@ -107,7 +107,7 @@ postFileBrowserR = void openFileBrowser
 {- Used by non-javascript browsers, where clicking on the link actually
  - opens this page, so we redirect back to the referrer. -}
 getFileBrowserR :: Handler ()
-getFileBrowserR = whenM openFileBrowser $ redirectBack
+getFileBrowserR = whenM openFileBrowser redirectBack
 
 {- Opens the system file browser on the repo, or, as a fallback,
  - goes to a file:// url. Returns True if it's ok to redirect away
@@ -137,14 +137,17 @@ openFileBrowser = do
 {- Transfer controls. The GET is done in noscript mode and redirects back
  - to the referring page. The POST is called by javascript. -}
 getPauseTransferR :: Transfer -> Handler ()
-getPauseTransferR t = pauseTransfer t >> redirectBack
+getPauseTransferR = noscript postPauseTransferR
 postPauseTransferR :: Transfer -> Handler ()
-postPauseTransferR t = pauseTransfer t
+postPauseTransferR = pauseTransfer
 getStartTransferR :: Transfer -> Handler ()
-getStartTransferR t = startTransfer t >> redirectBack
+getStartTransferR = noscript postStartTransferR
 postStartTransferR :: Transfer -> Handler ()
-postStartTransferR t = startTransfer t
+postStartTransferR = startTransfer
 getCancelTransferR :: Transfer -> Handler ()
-getCancelTransferR t = cancelTransfer False t >> redirectBack
+getCancelTransferR = noscript postCancelTransferR
 postCancelTransferR :: Transfer -> Handler ()
-postCancelTransferR t = cancelTransfer False t
+postCancelTransferR = cancelTransfer False
+
+noscript :: (Transfer -> Handler ()) -> Transfer -> Handler ()
+noscript a t = a t >> redirectBack

Assistant/WebApp/Documentation.hs

@@ -38,5 +38,5 @@ getLicenseR = do
 			$(widgetFile "documentation/license")
 
 getRepoGroupR :: Handler Html
-getRepoGroupR = page "About repository groups" (Just About) $ do
+getRepoGroupR = page "About repository groups" (Just About) $
 	$(widgetFile "documentation/repogroup")

Assistant/WebApp/Gpg.hs

@@ -48,7 +48,7 @@ whenGcryptInstalled a = ifM (liftIO isGcryptInstalled)
 
 withNewSecretKey :: (KeyId -> Handler Html) -> Handler Html
 withNewSecretKey use = do
-	userid <- liftIO $ newUserId
+	userid <- liftIO newUserId
 	liftIO $ genSecretKey RSA "" userid maxRecommendedKeySize
 	results <- M.keys . M.filter (== userid) <$> liftIO secretKeys
 	case results of
@@ -70,7 +70,7 @@ getGCryptRemoteName u repoloc = do
 		[Params "remote add", Param tmpremote, Param $ Git.GCrypt.urlPrefix ++ repoloc]
 	mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote])
 		( do
-			void $ Annex.Branch.forceUpdate
+			void Annex.Branch.forceUpdate
 			(M.lookup "name" <=< M.lookup u) <$> readRemoteLog
 		, return Nothing
 		)

Assistant/WebApp/Page.hs

@@ -38,7 +38,7 @@ firstRunNavBar :: [NavBarItem]
 firstRunNavBar = [Configuration, About]
 
 selectNavBar :: Handler [NavBarItem]
-selectNavBar = ifM (inFirstRun) (return firstRunNavBar, return defaultNavBar)
+selectNavBar = ifM inFirstRun (return firstRunNavBar, return defaultNavBar)
 
 {- A standard page of the webapp, with a title, a sidebar, and that may
  - be highlighted on the navbar. -}

Assistant/WebApp/RepoList.hs

@@ -35,6 +35,7 @@ import qualified Git
 import qualified Data.Map as M
 import qualified Data.Set as S
 import qualified Data.Text as T
+import Data.Function
 
 data Actions
 	= DisabledRepoActions
@@ -100,7 +101,7 @@ mainRepoSelector = RepoSelector
 
 {- List of cloud repositories, configured and not. -}
 cloudRepoList :: Widget
-cloudRepoList = repoListDisplay $ RepoSelector
+cloudRepoList = repoListDisplay RepoSelector
 	{ onlyCloud = True
 	, onlyConfigured = False
 	, includeHere = False
@@ -161,7 +162,7 @@ repoList reposelector
 		g <- gitRepo
 		map snd . catMaybes . filter selectedremote 
 			. map (findinfo m g)
-			<$> (trustExclude DeadTrusted $ M.keys m)
+			<$> trustExclude DeadTrusted (M.keys m)
 	selectedrepo r
 		| Remote.readonly r = False
 		| onlyCloud reposelector = Git.repoIsUrl (Remote.repo r) && not (isXMPPRemote r)
@@ -192,7 +193,7 @@ repoList reposelector
 	  	getconfig k = M.lookup k =<< M.lookup u m
 		val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
 	list l = liftAnnex $ do
-		let l' = nubBy (\x y -> fst x == fst y) l
+		let l' = nubBy ((==) `on` fst) l
 		l'' <- zip
 			<$> Remote.prettyListUUIDs (map fst l')
 			<*> pure l'
@@ -258,7 +259,7 @@ getRetryUnfinishedRepositoriesR = do
 	redirect DashboardR
   where
 	unstall r = do
-		liftIO $ fixSshKeyPair
+		liftIO fixSshKeyPair
 		liftAnnex $ setConfig 
 			(remoteConfig (Remote.repo r) "ignore")
 			(boolConfig False)

Assistant/WebApp/Utility.hs

@@ -38,7 +38,7 @@ import Utility.Yesod
 
 {- Use Nothing to change autocommit setting; or a remote to change
  - its sync setting. -}
-changeSyncable :: (Maybe Remote) -> Bool -> Handler ()
+changeSyncable :: Maybe Remote -> Bool -> Handler ()
 changeSyncable Nothing enable = do
 	liftAnnex $ Config.setConfig key (boolConfig enable)
 	liftIO . maybe noop (`throwTo` signal)
@@ -53,7 +53,7 @@ changeSyncable (Just r) True = do
 	liftAssistant $ syncRemote r
 changeSyncable (Just r) False = do
 	changeSyncFlag r False
-	liftAssistant $ updateSyncRemotes
+	liftAssistant updateSyncRemotes
 	{- Stop all transfers to or from this remote.
 	 - XXX Can't stop any ongoing scan, or git syncs. -}
 	void $ liftAssistant $ dequeueTransfers tofrom
@@ -66,7 +66,7 @@ changeSyncable (Just r) False = do
 changeSyncFlag :: Remote -> Bool -> Handler ()
 changeSyncFlag r enabled = liftAnnex $ do
 	Config.setConfig key (boolConfig enabled)
-	void $ Remote.remoteListRefresh
+	void Remote.remoteListRefresh
   where
 	key = Config.remoteConfig (Remote.repo r) "sync"