more partial function removal

Left a few Prelude.head's in where it was checked not null and too hard to
remove, etc.

Backend.hs

@@ -107,7 +107,7 @@ chooseBackends fs = Annex.getState Annex.forcebackend >>= go
 			return $ map (\(f,b) -> (maybeLookupBackendName b, f)) pairs
 		go (Just _) = do
 			l <- orderedList
-			return $ map (\f -> (Just $ head l, f)) fs
+			return $ map (\f -> (Just $ Prelude.head l, f)) fs
 
 {- Looks up a backend by name. May fail if unknown. -}
 lookupBackendName :: String -> Backend Annex
@@ -115,8 +115,6 @@ lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
 	where
 		unknown = error $ "unknown backend " ++ s
 maybeLookupBackendName :: String -> Maybe (Backend Annex)
-maybeLookupBackendName s
-	| length matches == 1 = Just $ head matches
-	| otherwise = Nothing
+maybeLookupBackendName s = headMaybe matches
 	where
 		matches = filter (\b -> s == B.name b) list

Backend/SHA.hs

@@ -62,11 +62,10 @@ shaN :: SHASize -> FilePath -> Annex String
 shaN size file = do
 	showAction "checksum"
 	liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
-		line <- hGetLine h
-		let bits = split " " line
-		if null bits
+		sha <- fst . separate (== ' ') <$> hGetLine h
+		if null sha
 			then error $ command ++ " parse error"
-			else return $ head bits
+			else return sha
 	where
 		command = fromJust $ shaCommand size
 

CmdLine.hs

@@ -51,7 +51,7 @@ parseCmd argv cmds options header = check $ getOpt Permute options argv
 		check (_, [], []) = err "missing command"
 		check (flags, name:rest, [])
 			| null matches = err $ "unknown command " ++ name
-			| otherwise = (flags, head matches, rest)
+			| otherwise = (flags, Prelude.head matches, rest)
 			where
 				matches = filter (\c -> name == cmdname c) cmds
 		check (_, _, errs) = err $ concat errs

Command/InitRemote.hs

@@ -25,9 +25,13 @@ seek :: [CommandSeek]
 seek = [withWords start]
 
 start :: [String] -> CommandStart
-start ws = do
-	when (null ws) needname
-
+start [] = do
+	names <- remoteNames
+	error $ "Specify a name for the remote. " ++
+		if null names
+			then ""
+			else "Either a new name, or one of these existing special remotes: " ++ join " " names
+start (name:ws) = do
 	(u, c) <- findByName name
 	let fullconfig = config `M.union` c	
 	t <- findType fullconfig
@@ -36,15 +40,7 @@ start ws = do
 	next $ perform t u $ M.union config c
 
 	where
-		name = head ws
-		config = Logs.Remote.keyValToConfig $ tail ws
-		needname = do
-			let err s = error $ "Specify a name for the remote. " ++ s
-			names <- remoteNames
-			if null names
-				then err ""
-				else err $ "Either a new name, or one of these existing special remotes: " ++ join " " names
-			
+		config = Logs.Remote.keyValToConfig ws
 
 perform :: R.RemoteType Annex -> UUID -> R.RemoteConfig -> CommandPerform
 perform t u c = do
@@ -67,11 +63,8 @@ findByName name = do
 			return (uuid, M.insert nameKey name M.empty)
 
 findByName' :: String ->  M.Map UUID R.RemoteConfig -> Maybe (UUID, R.RemoteConfig)
-findByName' n m
-	| null matches = Nothing
-	| otherwise = Just $ head matches
+findByName' n = headMaybe . filter (matching . snd) . M.toList
 	where
-		matches = filter (matching . snd) $ M.toList m
 		matching c = case M.lookup nameKey c of
 			Nothing -> False
 			Just n'

Command/Map.hs

@@ -73,7 +73,7 @@ hostname r
 	| otherwise = "localhost"
 
 basehostname :: Git.Repo -> String
-basehostname r = head $ split "." $ hostname r
+basehostname r = Prelude.head $ split "." $ hostname r
 
 {- A name to display for a repo. Uses the name from uuid.log if available,
  - or the remote name if not. -}

Command/Migrate.hs

@@ -31,7 +31,7 @@ start b file (key, oldbackend) = do
 			next $ perform file key newbackend
 		else stop
 	where
-		choosebackend Nothing = head <$> Backend.orderedList
+		choosebackend Nothing = Prelude.head <$> Backend.orderedList
 		choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}

Command/Status.hs

@@ -116,7 +116,7 @@ remote_list level desc = stat n $ nojson $ lift $ do
 	us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap)
 	rs <- fst <$> trustPartition level us
 	s <- prettyPrintUUIDs n rs
-	return $ if null s then "0" else show (length rs) ++ "\n" ++ init s
+	return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s
 	where
 		n = desc ++ " repositories"
 

Command/Sync.hs

@@ -12,6 +12,8 @@ import Command
 import qualified Annex.Branch
 import qualified Git.Command
 import qualified Git.Config
+import qualified Git.Ref
+import qualified Git
 
 import qualified Data.ByteString.Lazy.Char8 as L
 
@@ -61,7 +63,7 @@ defaultRemote = do
 	fromRepo $ Git.Config.get ("branch." ++ branch ++ ".remote") "origin"
 
 currentBranch :: Annex String
-currentBranch = last . split "/" . L.unpack . head . L.lines <$>
+currentBranch = Git.Ref.describe . Git.Ref . firstLine . L.unpack <$>
 	inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"])
 
 checkRemote :: String -> Annex ()

Command/Uninit.hs

@@ -29,7 +29,7 @@ check = do
 	when (b == Annex.Branch.name) $ error $
 		"cannot uninit when the " ++ show b ++ " branch is checked out"
 	where
-		current_branch = Git.Ref . head . lines . B.unpack <$> revhead
+		current_branch = Git.Ref . Prelude.head . lines . B.unpack <$> revhead
 		revhead = inRepo $ Git.Command.pipeRead 
 			[Params "rev-parse --abbrev-ref HEAD"]
 

Command/Unused.hs

@@ -154,13 +154,13 @@ excludeReferenced l = do
 		(S.fromList l)
 	where
 		-- Skip the git-annex branches, and get all other unique refs.
-		refs = map (Git.Ref .  last) .
-			nubBy cmpheads .
+		refs = map (Git.Ref .  snd) .
+			nubBy uniqref .
 			filter ourbranches .
-			map words . lines . L.unpack
-		cmpheads a b = head a == head b
+			map (separate (== ' ')) . lines . L.unpack
+		uniqref (a, _) (b, _) = a == b
 		ourbranchend = '/' : show Annex.Branch.name
-		ourbranches ws = not $ ourbranchend `isSuffixOf` last ws
+		ourbranches (_, b) = not $ ourbranchend `isSuffixOf` b
 		removewith [] s = return $ S.toList s
 		removewith (a:as) s
 			| s == S.empty = return [] -- optimisation

Common.hs

@@ -6,7 +6,7 @@ import Control.Monad.State as X (liftIO)
 import Control.Exception.Extensible as X (IOException)
 
 import Data.Maybe as X
-import Data.List as X
+import Data.List as X hiding (head, tail, init, last)
 import Data.String.Utils as X
 
 import System.Path as X
@@ -25,3 +25,5 @@ import Utility.SafeCommand as X
 import Utility.Path as X
 import Utility.Directory as X
 import Utility.Monad as X
+
+import Utility.BadPrelude as X

Config.hs

@@ -40,15 +40,10 @@ remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" +
 remoteCost :: Git.Repo -> Int -> Annex Int
 remoteCost r def = do
 	cmd <- getConfig r "cost-command" ""
-	safeparse <$> if not $ null cmd
+	(fromMaybe def . readMaybe) <$>
+		if not $ null cmd
 			then liftIO $ snd <$> pipeFrom "sh" ["-c", cmd]
 			else getConfig r "cost" ""
-	where
-		safeparse v
-			| null ws = def
-			| otherwise = fromMaybe def $ readMaybe $ head ws
-			where
-				ws = words v
 
 cheapRemoteCost :: Int
 cheapRemoteCost = 100

Git/CheckAttr.hs

@@ -36,10 +36,9 @@ lookup attr files repo = do
 				, Param attr
 				, Params "-z --stdin"
 				] repo
-		topair l = (file, value)
+		topair l = (Git.Filename.decode file, value)
 			where 
-				file = Git.Filename.decode $ join sep $ take end bits
-				value = bits !! end
-				end = length bits - 1
+				file = join sep $ beginning bits
+				value = end bits !! 0
 				bits = split sep l
 				sep = ": " ++ attr ++ ": "

Git/UnionMerge.hs

@@ -134,7 +134,7 @@ hashObject repo content = getSha subcmd $ do
 calcMerge :: [(Ref, [L.ByteString])] -> Either Ref [L.ByteString]
 calcMerge shacontents
 	| null reuseable = Right $ new
-	| otherwise = Left $ fst $ head reuseable
+	| otherwise = Left $ fst $ Prelude.head reuseable
 	where
 		reuseable = filter (\c -> sorteduniq (snd c) == new) shacontents
 		new = sorteduniq $ concat $ map snd shacontents

Logs/Location.hs

@@ -68,7 +68,7 @@ logFile key = hashDirLower key ++ keyFile key ++ ".log"
 {- Converts a log filename into a key. -}
 logFileKey :: FilePath -> Maybe Key
 logFileKey file
-	| end == ".log" = fileKey beginning
+	| ext == ".log" = fileKey base
 	| otherwise = Nothing
 	where
-		(beginning, end) = splitAt (length file - 4) file
+		(base, ext) = splitAt (length file - 4) file

Logs/Remote.hs

@@ -73,14 +73,13 @@ configUnEscape = unescape
 			| c == '&' = entity rest
 			| otherwise = c : unescape rest
 		entity s = if ok
-				then chr (read num) : unescape rest
+				then chr (Prelude.read num) : unescape rest
 				else '&' : unescape s
 			where
 				num = takeWhile isNumber s
 				r = drop (length num) s
 				rest = drop 1 r
-				ok = not (null num) && 
-					not (null r) && head r == ';'
+				ok = not (null num) && take 1 r == ";"
 
 {- for quickcheck -}
 prop_idempotent_configEscape :: String -> Bool

Logs/Trust.hs

@@ -54,18 +54,16 @@ trustMap = do
 		Just m -> return m
 		Nothing -> do
 			overrides <- M.fromList <$> Annex.getState Annex.forcetrust
-			m <- (M.union overrides . simpleMap . parseLog parseTrust) <$>
+			m <- (M.union overrides . simpleMap . parseLog (Just . parseTrust)) <$>
 				Annex.Branch.get trustLog
 			Annex.changeState $ \s -> s { Annex.trustmap = Just m }
 			return m
 
-parseTrust :: String -> Maybe TrustLevel
-parseTrust s
-	| length w > 0 = Just $ parse $ head w
-	-- back-compat; the trust.log used to only list trusted repos
-	| otherwise = Just Trusted
+{- The trust.log used to only list trusted repos, without a field for the
+ - trust status, which is why this defaults to Trusted. -}
+parseTrust :: String -> TrustLevel
+parseTrust s = maybe Trusted parse $ headMaybe $ words s
 	where
-		w = words s
 		parse "1" = Trusted
 		parse "0" = UnTrusted
 		parse "X" = DeadTrusted
@@ -82,6 +80,6 @@ trustSet :: UUID -> TrustLevel -> Annex ()
 trustSet uuid@(UUID _) level = do
 	ts <- liftIO getPOSIXTime
 	Annex.Branch.change trustLog $
-		showLog showTrust . changeLog ts uuid level . parseLog parseTrust
+		showLog showTrust . changeLog ts uuid level . parseLog (Just . parseTrust)
 	Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
 trustSet NoUUID _ = error "unknown UUID; cannot modify trust level"

Logs/UUID.hs

@@ -57,9 +57,9 @@ fixBadUUID = M.fromList . map fixup . M.toList
 				kuuid = fromUUID k
 				isbad = not (isuuid kuuid) && isuuid lastword
 				ws = words $ value v
-				lastword = last ws
+				lastword = Prelude.last ws
 				fixeduuid = toUUID lastword
-				fixedvalue = unwords $ kuuid: init ws
+				fixedvalue = unwords $ kuuid: Prelude.init ws
 		-- For the fixed line to take precidence, it should be
 		-- slightly newer, but only slightly.
 		newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice

Remote.hs

@@ -103,7 +103,7 @@ byName' n = do
 	let match = filter matching allremotes
 	if null match
 		then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
-		else return $ Right $ head match
+		else return $ Right $ Prelude.head match
 	where
 		matching r = n == name r || toUUID n == uuid r
 

Remote/Bup.hs

@@ -209,20 +209,20 @@ bup2GitRemote "" = do
 	Git.Construct.fromAbsPath $ h </> ".bup"
 bup2GitRemote r
 	| bupLocal r = 
-		if head r == '/'
+		if "/" `isPrefixOf` r
 			then Git.Construct.fromAbsPath r
 			else error "please specify an absolute path"
 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
 		where
 			bits = split ":" r
-			host = head bits
+			host = Prelude.head bits
 			dir = join ":" $ drop 1 bits
 			-- "host:~user/dir" is not supported specially by bup;
 			-- "host:dir" is relative to the home directory;
 			-- "host:" goes in ~/.bup
 			slash d
-				| d == "" = "/~/.bup"
-				| head d == '/' = d
+				| null d = "/~/.bup"
+				| "/" `isPrefixOf` d = d
 				| otherwise = "/~/" ++ d
 
 bupLocal :: BupRepo -> Bool

Remote/Directory.hs

@@ -96,7 +96,7 @@ storeEncrypted d (cipher, enck) k = do
 
 storeHelper :: FilePath -> Key -> (FilePath -> IO Bool) -> IO Bool
 storeHelper d key a = do
-	let dest = head $ locations d key
+	let dest = Prelude.head $ locations d key
 	let dir = parentDir dest
 	createDirectoryIfMissing True dir
 	allowWrite dir

Remote/Rsync.hs

@@ -188,7 +188,7 @@ rsyncRemote o params = do
    directories. -}
 rsyncSend :: RsyncOpts -> Key -> FilePath -> Annex Bool
 rsyncSend o k src = withRsyncScratchDir $ \tmp -> do
-	let dest = tmp </> head (keyPaths k)
+	let dest = tmp </> Prelude.head (keyPaths k)
 	liftIO $ createDirectoryIfMissing True $ parentDir dest
 	liftIO $ createLink src dest
 	rsyncRemote o

Upgrade/V1.hs

@@ -146,20 +146,20 @@ oldlog2key l =
 readKey1 :: String -> Key
 readKey1 v = 
 	if mixup
-		then fromJust $ readKey $ join ":" $ tail bits
+		then fromJust $ readKey $ join ":" $ Prelude.tail bits
 		else Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t }
 	where
 		bits = split ":" v
-		b = head bits
+		b = Prelude.head bits
 		n = join ":" $ drop (if wormy then 3 else 1) bits
 		t = if wormy
-			then Just (read (bits !! 1) :: EpochTime)
+			then Just (Prelude.read (bits !! 1) :: EpochTime)
 			else Nothing
 		s = if wormy
-			then Just (read (bits !! 2) :: Integer)
+			then Just (Prelude.read (bits !! 2) :: Integer)
 			else Nothing
-		wormy = head bits == "WORM"
-		mixup = wormy && isUpper (head $ bits !! 1)
+		wormy = Prelude.head bits == "WORM"
+		mixup = wormy && isUpper (Prelude.head $ bits !! 1)
 
 showKey1 :: Key -> String
 showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =

Utility/BadPrelude.hs

@@ -12,7 +12,7 @@ read :: Read a => String -> a
 read = Prelude.read
 
 {- head is a partial function; head [] is an error
- - Instead, use: take 1 -}
+ - Instead, use: take 1 or headMaybe -}
 head :: [a] -> a
 head = Prelude.head
 
@@ -27,10 +27,20 @@ init :: [a] -> [a]
 init = Prelude.init
 
 {- last too
- - Instead, use: end -}
+ - Instead, use: end or lastMaybe -}
 last :: [a] -> a
 last = Prelude.last
 
+{- Like head but Nothing on empty list. -}
+headMaybe :: [a] -> Maybe a
+headMaybe [] = Nothing
+headMaybe v = Just $ Prelude.head v
+
+{- Like last but Nothing on empty list. -}
+lastMaybe :: [a] -> Maybe a
+lastMaybe [] = Nothing
+lastMaybe v = Just $ Prelude.last v
+
 {- All but the last element of a list.
  - (Like init, but no error on an empty list.) -}
 beginning :: [a] -> [a]