more partial function removal
Left a few Prelude.head's in where it was checked not null and too hard to remove, etc.
This commit is contained in:
parent
b7e0d39abb
commit
95d2391f58
24 changed files with 73 additions and 78 deletions
|
@ -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'
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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"
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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"]
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue