{- Records new content of a file into the journal -}
set :: FilePath -> String -> Annex ()
-set file content = setJournalFile file content
+set = setJournalFile
{- Stages the journal, and commits staged changes to the branch. -}
commit :: String -> Annex ()
cleanjournal <- stageJournal
ref <- getBranch
withIndex $ commitBranch ref message [fullname]
- liftIO $ cleanjournal
+ liftIO cleanjournal
{- Commits the staged changes in the index to the branch.
-
Git.UpdateIndex.streamUpdateIndex g
[genstream dir h fs]
hashObjectStop h
- return $ liftIO $ mapM_ removeFile $ map (dir </>) fs
+ return $ liftIO $ mapM_ (removeFile . (dir </>)) fs
where
genstream dir h fs streamer = forM_ fs $ \file -> do
let path = dir </> file
sameFileStatus key status = do
old <- recordedInodeCache key
let curr = toInodeCache status
- r <- case (old, curr) of
+ case (old, curr) of
(Just o, Just c) -> compareInodeCaches o c
(Nothing, Nothing) -> return True
_ -> return False
- return r
{- If the inodes have changed, only the size and mtime are compared. -}
compareInodeCaches :: InodeCache -> InodeCache -> Annex Bool
mergeDirectCleanup d oldsha newsha = do
(items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha
forM_ items updated
- void $ liftIO $ cleanup
+ void $ liftIO cleanup
liftIO $ removeDirectoryRecursive d
where
updated item = do
parseToken :: MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
parseToken checkpresent groupmap t
- | any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
+ | t `elem` tokens = Right $ token t
| t == "present" = use checkpresent
| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $
M.fromList
]
where
(k, v) = separate (== '=') t
- use a = Utility.Matcher.Operation <$> a v
+ use a = Operation <$> a v
{- This is really dumb tokenization; there's no support for quoted values.
- Open and close parens are always treated as standalone tokens;
largeFilesMatcher :: Annex FileMatcher
largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
where
- go Nothing = return $ matchAll
+ go Nothing = return matchAll
go (Just expr) = do
m <- groupMap
u <- getUUID
gettmpdir = liftIO $ getEnv "GIT_ANNEX_TMP_DIR"
usetmpdir tmpdir = liftIO $ catchMaybeIO $ do
createDirectoryIfMissing True tmpdir
- return $ tmpdir
+ return tmpdir
portParams :: Maybe Integer -> [CommandParam]
portParams Nothing = []
| otherwise = "watch"
start daemonize webappwaiter = withThreadState $ \st -> do
checkCanWatch
- when assistant $ checkEnvironment
+ when assistant
+ checkEnvironment
dstatus <- startDaemonStatus
logfile <- fromRepo gitAnnexLogFile
liftIO $ debugM desc $ "logging to " ++ logfile
data NamedThread = NamedThread ThreadName (Assistant ())
namedThread :: String -> Assistant () -> NamedThread
-namedThread name a = NamedThread (ThreadName name) a
+namedThread = NamedThread . ThreadName
data NetMessager = NetMessager
-- outgoing messages
- { netMessages :: TChan (NetMessage)
+ { netMessages :: TChan NetMessage
-- important messages for each client
, importantNetMessages :: TMVar (M.Map ClientID (S.Set NetMessage))
-- important messages that are believed to have been sent to a client
where
makeret k = let bname = keyBackendName k in
case maybeLookupBackendName bname of
- Just backend -> do
- return $ Just (k, backend)
+ Just backend -> return $ Just (k, backend)
Nothing -> do
warning $
"skipping " ++ file ++
Just credpair -> do
writeCacheCredPair credpair storage
return $ Just credpair
- _ -> do error $ "bad creds"
+ _ -> error "bad creds"
{- Gets a CredPair from the environment. -}
getEnvCredPair :: CredPairStorage -> IO (Maybe CredPair)
encryptCipher (Cipher c) (KeyIds ks) = do
-- gpg complains about duplicate recipient keyids
let ks' = nub $ sort ks
- encipher <- Gpg.pipeStrict ([ Params "--encrypt" ] ++ recipients ks') c
+ encipher <- Gpg.pipeStrict (Params "--encrypt" : recipients ks') c
return $ EncryptedCipher encipher (KeyIds ks')
where
recipients l = force_recipients :
genDescription :: Maybe String -> Annex String
genDescription (Just d) = return d
genDescription Nothing = do
- hostname <- maybe "" id <$> liftIO getHostname
+ hostname <- fromMaybe "" <$> liftIO getHostname
let at = if null hostname then "" else "@"
username <- liftIO myUserName
reldir <- liftIO . relHome =<< fromRepo Git.repoPath
return True
checkCrippledFileSystem :: Annex ()
-checkCrippledFileSystem = whenM (probeCrippledFileSystem) $ do
+checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
warning "Detected a crippled filesystem."
setCrippledFileSystem True
unlessM isDirect $ do
- Licensed under the GNU GPL version 3 or higher.
-}
-{-# LANGUAGE PackageImports, CPP #-}
+{-# LANGUAGE CPP #-}
module Limit where
limitPresent :: Maybe UUID -> MkLimit
limitPresent u _ = Right $ const $ check $ \key -> do
hereu <- getUUID
- if u == Just hereu || u == Nothing
+ if u == Just hereu || isNothing u
then inAnnex key
else do
us <- Remote.keyLocations key
makeGroupMap byuuid = GroupMap byuuid bygroup
where
bygroup = M.fromListWith S.union $
- concat $ map explode $ M.toList byuuid
+ concatMap explode $ M.toList byuuid
explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s)
{- If a repository is in exactly one standard group, returns it. -}
getStandardGroup :: S.Set Group -> Maybe StandardGroup
-getStandardGroup s = case catMaybes $ map toStandardGroup $ S.toList s of
+getStandardGroup s = case mapMaybe toStandardGroup $ S.toList s of
[g] -> Just g
_ -> Nothing
prop_parse_show_Config :: RemoteConfig -> Bool
prop_parse_show_Config c
-- whitespace and '=' are not supported in keys
- | any (\k -> any isSpace k || any (== '=') k) (M.keys c) = True
+ | any (\k -> any isSpace k || elem '=' k) (M.keys c) = True
| otherwise = parseConfig (showConfig c) ~~ Just c
where
normalize v = sort . M.toList <$> v
Just fd -> do
locked <- catchMaybeIO $
setLock fd (WriteLock, AbsoluteSeek, 0, 0)
- when (locked == Nothing) $
- error $ "transfer already in progress"
+ when (isNothing locked) $
+ error "transfer already in progress"
void $ tryIO $ writeTransferInfoFile info tfile
return mfd
cleanup _ Nothing = noop
where
updater tfile mvar b = modifyMVar_ mvar $ \oldbytes -> do
let newbytes = fromBytesProcessed b
- if (newbytes - oldbytes >= mindelta)
+ if newbytes - oldbytes >= mindelta
then do
let info' = info { bytesComplete = Just newbytes }
_ <- tryIO $ writeTransferInfoFile info' tfile
{- Gets all currently running transfers. -}
getTransfers :: Annex [(Transfer, TransferInfo)]
getTransfers = do
- transfers <- catMaybes . map parseTransferFile . concat <$> findfiles
+ transfers <- mapMaybe parseTransferFile . concat <$> findfiles
infos <- mapM checkTransfer transfers
return $ map (\(t, Just i) -> (t, i)) $
filter running $ zip transfers infos
{- Parses a transfer information filename to a Transfer. -}
parseTransferFile :: FilePath -> Maybe Transfer
parseTransferFile file
- | "lck." `isPrefixOf` (takeFileName file) = Nothing
+ | "lck." `isPrefixOf` takeFileName file = Nothing
| otherwise = case drop (length bits - 3) bits of
[direction, u, key] -> Transfer
<$> readLcDirection direction
writeTransferInfo :: TransferInfo -> String
writeTransferInfo info = unlines
[ (maybe "" show $ startedTime info) ++
- (maybe "" (\b -> " " ++ show b) $ bytesComplete info)
+ (maybe "" (\b -> ' ' : show b) (bytesComplete info))
, fromMaybe "" $ associatedFile info -- comes last; arbitrary content
]
-readTransferInfoFile :: (Maybe ProcessID) -> FilePath -> IO (Maybe TransferInfo)
+readTransferInfoFile :: Maybe ProcessID -> FilePath -> IO (Maybe TransferInfo)
readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do
h <- openFile tfile ReadMode
fileEncoding h
hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h)
-readTransferInfo :: (Maybe ProcessID) -> String -> Maybe TransferInfo
+readTransferInfo :: Maybe ProcessID -> String -> Maybe TransferInfo
readTransferInfo mpid s = TransferInfo
<$> time
<*> pure mpid
prop_read_write_transferinfo :: TransferInfo -> Bool
prop_read_write_transferinfo info
- | transferRemote info /= Nothing = True -- remote not stored
- | transferTid info /= Nothing = True -- tid not stored
+ | isJust (transferRemote info) = True -- remote not stored
+ | isJust (transferTid info) = True -- tid not stored
| otherwise = Just (info { transferPaused = False }) == info'
where
info' = readTransferInfo (transferPid info) (writeTransferInfo info)
return $ partition (`elem` candidates) ls
{- Filters UUIDs to those not matching a TrustLevel. -}
-trustExclude :: TrustLevel -> [UUID] -> Annex ([UUID])
+trustExclude :: TrustLevel -> [UUID] -> Annex [UUID]
trustExclude level ls = snd <$> trustPartition level ls
{- trustLog in a map, overridden with any values from forcetrust or
readUnusedLog prefix = do
f <- fromRepo $ gitAnnexUnusedLog prefix
ifM (liftIO $ doesFileExist f)
- ( M.fromList . catMaybes . map parse . lines
+ ( M.fromList . mapMaybe parse . lines
<$> liftIO (readFile f)
, return M.empty
)
{- Shows a progress meter while performing a transfer of a key.
- The action is passed a callback to use to update the meter. -}
-metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a
+metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
metered combinemeterupdate key a = go (keySize key)
where
go (Just size) = meteredBytes combinemeterupdate size a
{- Shows a progress meter while performing an action on a given number
- of bytes. -}
-meteredBytes :: (Maybe MeterUpdate) -> Integer -> (MeterUpdate -> Annex a) -> Annex a
+meteredBytes :: Maybe MeterUpdate -> Integer -> (MeterUpdate -> Annex a) -> Annex a
meteredBytes combinemeterupdate size a = withOutputType go
where
go NormalOutput = do
add v = putStr $ Stream.add v
complete :: JSON a => [(String, a)] -> IO ()
-complete v = putStr $ concat
- [ Stream.start v
- , Stream.end
- ]
+complete v = putStr $ Stream.start v ++ Stream.end
prettyListUUIDs uuids = do
hereu <- getUUID
m <- uuidDescriptions
- return $ map (\u -> prettify m hereu u) uuids
+ return $ map (prettify m hereu) uuids
where
finddescription m u = M.findWithDefault "" u m
prettify m hereu u
retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k undefined f , return False )
retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
-retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> do
+retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp ->
ifM (retrieve o enck undefined tmp)
( liftIO $ catchBoolIO $ do
decrypt cipher (feedFile tmp) $
runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params
{- Show warnings only for files/directories that do not exist. -}
forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->
- unlessM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus p)) $
+ unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $
fileNotFound p
return $ concat ll
divider
propigate rs qcok
where
- divider = putStrLn $ take 70 $ repeat '-'
+ divider = putStrLn $ replicate 70 '-'
propigate :: [Counts] -> Bool -> IO ()
propigate cs qcok
getbool k def = fromMaybe def $ getmaybebool k
getmaybebool k = Git.Config.isTrue =<< getmaybe k
getmayberead k = readish =<< getmaybe k
- getmaybe k = maybe (Git.Config.getMaybe (key k) r) Just $
- Git.Config.getMaybe (remotekey k) r
+ getmaybe k = mplus (Git.Config.getMaybe (key k) r)
+ (Git.Config.getMaybe (remotekey k) r)
getoptions k = fromMaybe [] $ words <$> getmaybe k
key k = "annex." ++ k
preferredContent :: StandardGroup -> String
preferredContent ClientGroup = lastResort
"exclude=*/archive/* and exclude=archive/*"
-preferredContent TransferGroup = lastResort $
+preferredContent TransferGroup = lastResort
"not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup
preferredContent BackupGroup = "include=*"
-preferredContent IncrementalBackupGroup = lastResort $
+preferredContent IncrementalBackupGroup = lastResort
"include=* and (not copies=incrementalbackup:1)"
preferredContent SmallArchiveGroup = lastResort $
"(include=*/archive/* or include=archive/*) and " ++ preferredContent FullArchiveGroup
-preferredContent FullArchiveGroup = lastResort $
+preferredContent FullArchiveGroup = lastResort
"not (copies=archive:1 or copies=smallarchive:1)"
preferredContent SourceGroup = "not (copies=1)"
-preferredContent ManualGroup = lastResort $
+preferredContent ManualGroup = lastResort
"present and exclude=*/archive/* and exclude=archive/*"
preferredContent UnwantedGroup = "exclude=*"
projects / git-annex.git / commitdiff