summaryrefslogtreecommitdiff
path: root/LocationLog.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-06-22 14:27:50 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-06-22 14:27:50 -0400
commitd3f0106f2ed15a4e4abbc09cc3e985a27dfee662 (patch)
tree2d5867dd13895eabc4def6412d791f543f3e2710 /LocationLog.hs
parent78a325b09315efd593e6b729de18f15871a0d643 (diff)
move LocationLog into Annex monad from IO
It will need to run in Annex so it can use Branch
Diffstat (limited to 'LocationLog.hs')
-rw-r--r--LocationLog.hs25
1 files changed, 13 insertions, 12 deletions
diff --git a/LocationLog.hs b/LocationLog.hs
index b2d423cf9..1b55abfb2 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -36,6 +36,7 @@ import System.FilePath
import qualified Data.Map as Map
import Control.Monad (when)
import Data.Maybe
+import Control.Monad.State (liftIO)
import qualified GitRepo as Git
import Utility
@@ -86,7 +87,7 @@ instance Read LogLine where
{- Log a change in the presence of a key's value in a repository,
- and returns the filename of the logfile. -}
-logChange :: Git.Repo -> Key -> UUID -> LogStatus -> IO FilePath
+logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex FilePath
logChange repo key u s = do
when (null u) $
error $ "unknown UUID for " ++ Git.repoDescribe repo ++
@@ -100,8 +101,8 @@ logChange repo key u s = do
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
-readLog :: FilePath -> IO [LogLine]
-readLog file = catch (return . parseLog =<< readFileStrict file) (const $ return [])
+readLog :: FilePath -> Annex [LogLine]
+readLog file = liftIO $ catch (return . parseLog =<< readFileStrict file) (const $ return [])
parseLog :: String -> [LogLine]
parseLog s = filter parsable $ map read $ lines s
@@ -110,18 +111,18 @@ parseLog s = filter parsable $ map read $ lines s
parsable l = status l /= Undefined
{- Writes a set of lines to a log file -}
-writeLog :: FilePath -> [LogLine] -> IO ()
-writeLog file ls = safeWriteFile file (unlines $ map show ls)
+writeLog :: FilePath -> [LogLine] -> Annex ()
+writeLog file ls = liftIO $ safeWriteFile file (unlines $ map show ls)
{- Generates a new LogLine with the current date. -}
-logNow :: LogStatus -> UUID -> IO LogLine
+logNow :: LogStatus -> UUID -> Annex LogLine
logNow s u = do
- now <- getPOSIXTime
+ now <- liftIO $ getPOSIXTime
return $ LogLine now s u
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
-keyLocations :: Git.Repo -> Key -> IO [UUID]
+keyLocations :: Git.Repo -> Key -> Annex [UUID]
keyLocations thisrepo key = do
ls <- readLog $ logFile thisrepo key
ls' <- readLog $ logFileOld thisrepo key
@@ -155,18 +156,18 @@ mapLog m l =
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}
-loggedKeys :: Git.Repo -> IO [Key]
+loggedKeys :: Git.Repo -> Annex [Key]
loggedKeys repo = do
- exists <- doesDirectoryExist dir
+ exists <- liftIO $ doesDirectoryExist dir
if exists
then do
-- 2 levels of hashing
- levela <- dirContents dir
+ levela <- liftIO $ dirContents dir
levelb <- mapM tryDirContents levela
files <- mapM tryDirContents (concat levelb)
return $ catMaybes $
map (logFileKey . takeFileName) (concat files)
else return []
where
- tryDirContents d = catch (dirContents d) (return . const [])
+ tryDirContents d = liftIO $ catch (dirContents d) (return . const [])
dir = gitStateDir repo