more monadic operator use
This commit is contained in:
parent
1e5beda86a
commit
6aab88fa25
5 changed files with 11 additions and 20 deletions
4
Annex.hs
4
Annex.hs
|
@ -86,9 +86,7 @@ getState c = liftM c get
|
|||
- Example: changeState (\s -> s { quiet = True })
|
||||
-}
|
||||
changeState :: (AnnexState -> AnnexState) -> Annex ()
|
||||
changeState a = do
|
||||
state <- get
|
||||
put (a state)
|
||||
changeState a = put . a =<< get
|
||||
|
||||
{- Returns the git repository being acted on -}
|
||||
gitRepo :: Annex Git.Repo
|
||||
|
|
|
@ -72,8 +72,7 @@ calcGitLink file key = do
|
|||
- updated instead. -}
|
||||
logStatus :: Key -> LogStatus -> Annex ()
|
||||
logStatus key status = do
|
||||
g <- Annex.gitRepo
|
||||
u <- getUUID g
|
||||
u <- getUUID =<< Annex.gitRepo
|
||||
logStatusFor u key status
|
||||
|
||||
{- Updates the LocationLog when a key's presence changes in a repository
|
||||
|
|
|
@ -150,16 +150,13 @@ mapLog m l =
|
|||
then Map.insert u l m
|
||||
else m
|
||||
where
|
||||
better = case Map.lookup u m of
|
||||
Just l' -> (date l' <= date l)
|
||||
Nothing -> True
|
||||
better = maybe True (\l' -> date l' <= date l) $ Map.lookup u m
|
||||
u = uuid l
|
||||
|
||||
{- Finds all keys that have location log information.
|
||||
- (There may be duplicate keys in the list.) -}
|
||||
loggedKeys :: Git.Repo -> IO [Key]
|
||||
loggedKeys repo = do
|
||||
let dir = gitStateDir repo
|
||||
exists <- doesDirectoryExist dir
|
||||
if exists
|
||||
then do
|
||||
|
@ -172,3 +169,4 @@ loggedKeys repo = do
|
|||
else return []
|
||||
where
|
||||
tryDirContents d = catch (dirContents d) (return . const [])
|
||||
dir = gitStateDir repo
|
||||
|
|
12
Remote.hs
12
Remote.hs
|
@ -75,10 +75,10 @@ genList = do
|
|||
return rs'
|
||||
else return rs
|
||||
where
|
||||
process m t = do
|
||||
l <- enumerate t
|
||||
l' <- filterM remoteNotIgnored l
|
||||
mapM (gen m t) l'
|
||||
process m t =
|
||||
enumerate t >>=
|
||||
filterM remoteNotIgnored >>=
|
||||
mapM (gen m t)
|
||||
gen m t r = do
|
||||
u <- getUUID r
|
||||
generate t r u (M.lookup u m)
|
||||
|
@ -97,9 +97,7 @@ byName n = do
|
|||
|
||||
{- Looks up a remote by name (or by UUID), and returns its UUID. -}
|
||||
nameToUUID :: String -> Annex UUID
|
||||
nameToUUID "." = do -- special case for current repo
|
||||
g <- Annex.gitRepo
|
||||
getUUID g
|
||||
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
|
||||
nameToUUID n = liftM uuid (byName n)
|
||||
|
||||
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
|
||||
|
|
6
UUID.hs
6
UUID.hs
|
@ -79,8 +79,7 @@ getUncachedUUID r = Git.configGet r configkey ""
|
|||
{- Make sure that the repo has an annex.uuid setting. -}
|
||||
prepUUID :: Annex ()
|
||||
prepUUID = do
|
||||
g <- Annex.gitRepo
|
||||
u <- getUUID g
|
||||
u <- getUUID =<< Annex.gitRepo
|
||||
when ("" == u) $ do
|
||||
uuid <- liftIO $ genUUID
|
||||
setConfig configkey uuid
|
||||
|
@ -88,8 +87,7 @@ prepUUID = do
|
|||
{- Pretty-prints a list of UUIDs -}
|
||||
prettyPrintUUIDs :: [UUID] -> Annex String
|
||||
prettyPrintUUIDs uuids = do
|
||||
g <- Annex.gitRepo
|
||||
here <- getUUID g
|
||||
here <- getUUID =<< Annex.gitRepo
|
||||
m <- uuidMap
|
||||
return $ unwords $ map (\u -> "\t" ++ prettify m u here ++ "\n") uuids
|
||||
where
|
||||
|
|
Loading…
Reference in a new issue