2012-05-02 18:59:05 +00:00
|
|
|
{- git-annex unused log file
|
|
|
|
-
|
|
|
|
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Logs.Unused (
|
2013-07-04 06:36:02 +00:00
|
|
|
UnusedMap,
|
2012-05-02 18:59:05 +00:00
|
|
|
writeUnusedLog,
|
|
|
|
readUnusedLog,
|
2013-07-03 19:26:59 +00:00
|
|
|
unusedKeys,
|
2012-05-02 18:59:05 +00:00
|
|
|
) where
|
|
|
|
|
|
|
|
import qualified Data.Map as M
|
|
|
|
|
|
|
|
import Common.Annex
|
|
|
|
import Types.Key
|
2013-05-12 23:19:28 +00:00
|
|
|
import Utility.Tmp
|
2012-05-02 18:59:05 +00:00
|
|
|
|
2013-07-03 19:26:59 +00:00
|
|
|
type UnusedMap = M.Map Int Key
|
|
|
|
|
2012-05-02 18:59:05 +00:00
|
|
|
writeUnusedLog :: FilePath -> [(Int, Key)] -> Annex ()
|
|
|
|
writeUnusedLog prefix l = do
|
|
|
|
logfile <- fromRepo $ gitAnnexUnusedLog prefix
|
|
|
|
liftIO $ viaTmp writeFile logfile $
|
2012-08-08 20:06:01 +00:00
|
|
|
unlines $ map (\(n, k) -> show n ++ " " ++ key2file k) l
|
2012-05-02 18:59:05 +00:00
|
|
|
|
|
|
|
readUnusedLog :: FilePath -> Annex UnusedMap
|
|
|
|
readUnusedLog prefix = do
|
|
|
|
f <- fromRepo $ gitAnnexUnusedLog prefix
|
|
|
|
ifM (liftIO $ doesFileExist f)
|
2013-04-03 07:52:41 +00:00
|
|
|
( M.fromList . mapMaybe parse . lines
|
2012-05-02 18:59:05 +00:00
|
|
|
<$> liftIO (readFile f)
|
|
|
|
, return M.empty
|
|
|
|
)
|
2012-11-11 04:51:07 +00:00
|
|
|
where
|
|
|
|
parse line = case (readish tag, file2key rest) of
|
|
|
|
(Just num, Just key) -> Just (num, key)
|
|
|
|
_ -> Nothing
|
|
|
|
where
|
|
|
|
(tag, rest) = separate (== ' ') line
|
2012-05-02 18:59:05 +00:00
|
|
|
|
2013-07-03 19:26:59 +00:00
|
|
|
unusedKeys :: Annex [Key]
|
|
|
|
unusedKeys = M.elems <$> readUnusedLog ""
|