diff options
author | Joey Hess <joey@kitenet.net> | 2011-05-15 15:27:49 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-05-15 15:27:49 -0400 |
commit | 6aab88fa251a14fbf31c7a8d80296c78db0ed048 (patch) | |
tree | 34465a5c706ab825ecd34b9261ecc6f35e4dd555 | |
parent | 1e5beda86a1d0185466547bd1acb61a75ac66992 (diff) |
more monadic operator use
-rw-r--r-- | Annex.hs | 4 | ||||
-rw-r--r-- | Content.hs | 3 | ||||
-rw-r--r-- | LocationLog.hs | 6 | ||||
-rw-r--r-- | Remote.hs | 12 | ||||
-rw-r--r-- | UUID.hs | 6 |
5 files changed, 11 insertions, 20 deletions
@@ -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 diff --git a/Content.hs b/Content.hs index 9040383be..0758fcdb1 100644 --- a/Content.hs +++ b/Content.hs @@ -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 diff --git a/LocationLog.hs b/LocationLog.hs index 6759b47fe..b2d423cf9 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -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 @@ -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. @@ -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 |