code simplification thanks to applicative functors

Annex.hs

@@ -20,6 +20,7 @@ module Annex (
 
 import Control.Monad.State
 import Control.Monad.IO.Control
+import Control.Applicative hiding (empty)
 
 import qualified Git
 import Git.Queue
@@ -36,7 +37,9 @@ newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
 		Monad,
 		MonadIO,
 		MonadControlIO,
-		MonadState AnnexState
+		MonadState AnnexState,
+		Functor,
+		Applicative
 	)
 
 -- internal state storage
@@ -83,7 +86,7 @@ newState gitrepo = AnnexState
 
 {- Create and returns an Annex state object for the specified git repo. -}
 new :: Git.Repo -> IO AnnexState
-new gitrepo = newState `liftM` Git.configRead gitrepo
+new gitrepo = newState <$> Git.configRead gitrepo
 
 {- performs an action in the Annex monad -}
 run :: AnnexState -> Annex a -> IO (a, AnnexState)

Branch.hs

@@ -20,6 +20,7 @@ module Branch (
 
 import Control.Monad (when, unless, liftM)
 import Control.Monad.State (liftIO)
+import Control.Applicative ((<$>))
 import System.FilePath
 import System.Directory
 import Data.String.Utils
@@ -158,7 +159,7 @@ update = do
 		staged <- stageJournalFiles
 
 		refs <- siblingBranches
-		updated <- catMaybes `liftM` mapM updateRef refs
+		updated <- catMaybes <$> mapM updateRef refs
 		g <- Annex.gitRepo
 		unless (null updated && not staged) $ liftIO $
 			Git.commit g "update" fullname (fullname:updated)
@@ -182,7 +183,7 @@ hasOrigin = refExists originname
 
 {- Does the git-annex branch or a foo/git-annex branch exist? -}
 hasSomeBranch :: Annex Bool
-hasSomeBranch = liftM (not . null) siblingBranches
+hasSomeBranch = not . null <$> siblingBranches
 
 {- List of all git-annex branches, including the main one and any
  - from remotes. -}
@@ -323,7 +324,7 @@ getJournalFile file = do
 
 {- List of journal files. -}
 getJournalFiles :: Annex [FilePath]
-getJournalFiles = liftM (map fileJournal) getJournalFilesRaw
+getJournalFiles = map fileJournal <$> getJournalFilesRaw
 
 getJournalFilesRaw :: Annex [FilePath]
 getJournalFilesRaw = do

Command.hs

@@ -11,6 +11,7 @@ import Control.Monad.State (liftIO)
 import System.Directory
 import System.Posix.Files
 import Control.Monad (filterM, liftM, when)
+import Control.Applicative
 import System.Path.WildMatch
 import Text.Regex.PCRE.Light.Char8
 import Data.List
@@ -183,7 +184,7 @@ withNothing a [] = return [a]
 withNothing _ _ = error "This command takes no parameters."
 
 backendPairs :: CommandSeekBackendFiles
-backendPairs a files = liftM (map a) $ Backend.chooseBackends files
+backendPairs a files = map a <$> Backend.chooseBackends files
 
 {- Filter out files those matching the exclude glob pattern,
  - if it was specified. -}
@@ -204,7 +205,7 @@ wildsRegex ws = compile regex []
 
 {- filter out symlinks -}	
 notSymlink :: FilePath -> IO Bool
-notSymlink f = liftM (not . isSymbolicLink) $ liftIO $ getSymbolicLinkStatus f
+notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
 
 {- Descriptions of params used in usage messages. -}
 paramRepeating :: String -> String
@@ -271,4 +272,4 @@ preserveOrder orig new = collect orig new
  - of git file list commands, that assumption tends to hold.
  -}
 runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
-runPreserveOrder a files = liftM (preserveOrder files) (a files)
+runPreserveOrder a files = preserveOrder files <$> a files

Command/Migrate.hs

@@ -8,6 +8,7 @@
 module Command.Migrate where
 
 import Control.Monad.State (liftIO)
+import Control.Applicative
 import System.Posix.Files
 import System.Directory
 import System.FilePath
@@ -39,7 +40,7 @@ start (file, b) = isAnnexed file $ \(key, oldbackend) -> do
 			next $ perform file key newbackend
 		else stop
 	where
-		choosebackend Nothing = return . head =<< Backend.orderedList
+		choosebackend Nothing = head <$> Backend.orderedList
 		choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}

Command/Status.hs

@@ -8,6 +8,7 @@
 module Command.Status where
 
 import Control.Monad.State
+import Control.Applicative
 import Data.Maybe
 import System.IO
 import Data.List
@@ -112,12 +113,10 @@ total_annex_size = stat "total annex size" $
 	cachedKeysReferenced >>= keySizeSum
 
 local_annex_keys :: Stat
-local_annex_keys = stat "local annex keys" $ 
+local_annex_keys = stat "local annex keys" $ show . snd <$> cachedKeysPresent
-	return . show . snd =<< cachedKeysPresent
 
 total_annex_keys :: Stat
-total_annex_keys = stat "total annex keys" $
+total_annex_keys = stat "total annex keys" $ show . snd <$> cachedKeysReferenced
-	return . show . snd =<< cachedKeysReferenced
 
 tmp_size :: Stat
 tmp_size = staleSize "temporary directory size" gitAnnexTmpDir
@@ -126,8 +125,7 @@ bad_data_size :: Stat
 bad_data_size = staleSize "bad keys size" gitAnnexBadDir
 
 backend_usage :: Stat
-backend_usage = stat "backend usage" $
+backend_usage = stat "backend usage" $ usage <$> cachedKeysReferenced
-	return . usage =<< cachedKeysReferenced
 	where
 		usage (ks, _) = pp "" $ sort $ map swap $ splits ks
 		splits :: [Key] -> [(String, Integer)]

Config.hs

@@ -9,7 +9,7 @@ module Config where
 
 import Data.Maybe
 import Control.Monad.State (liftIO)
-import Control.Monad (liftM)
+import Control.Applicative
 import System.Cmd.Utils
 
 import qualified Git
@@ -47,8 +47,8 @@ remoteConfig r key = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex
 remoteCost :: Git.Repo -> Int -> Annex Int
 remoteCost r def = do
 	cmd <- getConfig r "cost-command" ""
-	return . safeparse =<< if not $ null cmd
+	safeparse <$> if not $ null cmd
-			then liftM snd $ liftIO $ pipeFrom "sh" ["-c", cmd]
+			then liftIO $ snd <$> pipeFrom "sh" ["-c", cmd]
 			else getConfig r "cost" ""
 	where
 		safeparse v

Crypto.hs

@@ -38,6 +38,7 @@ import System.IO
 import System.Posix.IO
 import System.Posix.Types
 import System.Posix.Process
+import Control.Applicative
 import Control.Concurrent
 import Control.Exception (finally)
 import System.Exit
@@ -136,7 +137,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
 decryptCipher _ (EncryptedCipher encipher _) = 
-	return . Cipher =<< gpgPipeStrict decrypt encipher
+	Cipher <$> gpgPipeStrict decrypt encipher
 	where
 		decrypt = [ Param "--decrypt" ]
 

Git.hs

@@ -63,6 +63,7 @@ module Git (
 ) where
 
 import Control.Monad (unless, when)
+import Control.Applicative
 import System.Directory
 import System.FilePath
 import System.Posix.Directory
@@ -446,7 +447,7 @@ commit g message newref parentrefs = do
 		pipeWriteRead g (map Param $ ["commit-tree", tree] ++ ps) message
 	run g "update-ref" [Param newref, Param sha]
 	where
-		ignorehandle a = return . snd =<< a
+		ignorehandle a = snd <$> a
 		ps = concatMap (\r -> ["-p", r]) parentrefs
 
 {- Reads null terminated output of a git command (as enabled by the -z 

LocationLog.hs

@@ -24,6 +24,7 @@ module LocationLog (
 
 import System.FilePath
 import Control.Monad (when)
+import Control.Applicative
 import Data.Maybe
 
 import qualified Git
@@ -49,7 +50,7 @@ keyLocations key = currentLog $ logFile key
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}
 loggedKeys :: Annex [Key]
-loggedKeys = return . mapMaybe (logFileKey . takeFileName) =<< Branch.files
+loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Branch.files
 
 {- The filename of the log file for a given key. -}
 logFile :: Key -> String

PresenceLog.hs

@@ -28,6 +28,7 @@ import Data.Time
 import System.Locale
 import qualified Data.Map as Map
 import Control.Monad.State (liftIO)
+import Control.Applicative
 
 import qualified Branch
 import Types
@@ -81,7 +82,7 @@ addLog file line = do
 {- Reads a log file.
  - Note that the LogLines returned may be in any order. -}
 readLog :: FilePath -> Annex [LogLine]
-readLog file = return . parseLog =<< Branch.get file
+readLog file = parseLog <$> Branch.get file
 
 parseLog :: String -> [LogLine]
 parseLog s = filter parsable $ map read $ lines s

Remote.hs

@@ -29,11 +29,12 @@ module Remote (
 	forceTrust
 ) where
 
-import Control.Monad (filterM, liftM2)
+import Control.Monad (filterM)
 import Data.List
 import qualified Data.Map as M
 import Data.String.Utils
 import Data.Maybe
+import Control.Applicative
 
 import Types
 import Types.Remote
@@ -111,10 +112,10 @@ nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
 nameToUUID n = do
 	res <- byName' n
 	case res of
-		Left e -> return . fromMaybe (error e) =<< byDescription
+		Left e -> fromMaybe (error e) <$> byDescription
 		Right r -> return $ uuid r
 	where
-		byDescription = return . M.lookup n . invertMap =<< uuidMap
+		byDescription = M.lookup n . invertMap <$> uuidMap
 		invertMap = M.fromList . map swap . M.toList
 		swap (a, b) = (b, a)
 
@@ -124,10 +125,10 @@ prettyPrintUUIDs uuids = do
 	here <- getUUID =<< Annex.gitRepo
 	-- Show descriptions from the uuid log, falling back to remote names,
 	-- as some remotes may not be in the uuid log
-	m <- liftM2 M.union uuidMap $
+	m <- M.union <$> uuidMap <*> availMap
-		return . M.fromList . map (\r -> (uuid r, name r)) =<< genList
 	return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids
 	where
+		availMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
 		prettify m u here = base ++ ishere
 			where
 				base = if not $ null $ findlog m u
@@ -147,7 +148,7 @@ remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
 {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
  -}
 keyPossibilities :: Key -> Annex [Remote Annex]
-keyPossibilities key = return . fst =<< keyPossibilities' False key
+keyPossibilities key = fst <$> keyPossibilities' False key
 
 {- Cost ordered lists of remotes that the LocationLog indicate may have a key.
  -

RemoteLog.hs

@@ -19,6 +19,7 @@ import Data.List
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Char
+import Control.Applicative
 
 import qualified Branch
 import Types
@@ -40,7 +41,7 @@ configSet u c = do
 
 {- Map of remotes by uuid containing key/value config maps. -}
 readRemoteLog :: Annex (M.Map UUID RemoteConfig)
-readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
+readRemoteLog = remoteLogParse <$> Branch.get remoteLog
 
 remoteLogParse :: String -> M.Map UUID RemoteConfig
 remoteLogParse s =

Upgrade/V1.hs

@@ -11,6 +11,7 @@ import System.IO.Error (try)
 import System.Directory
 import Control.Monad.State (liftIO)
 import Control.Monad (filterM, forM_, unless)
+import Control.Applicative
 import System.Posix.Files
 import System.FilePath
 import Data.String.Utils
@@ -192,7 +193,7 @@ writeLog1 :: FilePath -> [LogLine] -> IO ()
 writeLog1 file ls = viaTmp writeFile file (unlines $ map show ls)
 
 readLog1 :: FilePath -> IO [LogLine]
-readLog1 file = catch (return . parseLog =<< readFileStrict file) (const $ return [])
+readLog1 file = catch (parseLog <$> readFileStrict file) (const $ return [])
 
 lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend Annex))
 lookupFile1 file = do
@@ -201,7 +202,7 @@ lookupFile1 file = do
 		Left _ -> return Nothing
 		Right l -> makekey l
 	where
-		getsymlink = return . takeFileName =<< readSymbolicLink file
+		getsymlink = takeFileName <$> readSymbolicLink file
 		makekey l = case maybeLookupBackendName bname of
 			Nothing -> do
 				unless (null kname || null bname ||

Utility/Path.hs

@@ -13,7 +13,7 @@ import System.FilePath
 import System.Directory
 import Data.List
 import Data.Maybe
-import Control.Monad (liftM2)
+import Control.Applicative
 
 {- Returns the parent directory of a path. Parent of / is "" -}
 parentDir :: FilePath -> FilePath
@@ -65,7 +65,7 @@ absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
  -    relPathCwdToFile "/tmp/foo/bar" == "" 
  -}
 relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = liftM2 relPathDirToFile getCurrentDirectory (absPath f)
+relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
 
 {- Constructs a relative path from a directory to a file.
  -

Utility/Url.hs

@@ -11,7 +11,7 @@ module Utility.Url (
 	get
 ) where
 
-import Control.Monad (liftM)
+import Control.Applicative
 import Control.Monad.State (liftIO)
 import qualified Network.Browser as Browser
 import Network.HTTP
@@ -64,7 +64,6 @@ request url requesttype = Browser.browse $ do
 	Browser.setErrHandler ignore
 	Browser.setOutHandler ignore
 	Browser.setAllowRedirects True
-	liftM snd $ Browser.request
+	snd <$> Browser.request (mkRequest requesttype url :: Request_String)
-		(mkRequest requesttype url :: Request_String)
 	where
 		ignore = const $ return ()