rough in fsck
This commit is contained in:
parent
55b92860ce
commit
ea8ccaa3d5
2 changed files with 39 additions and 9 deletions
|
@ -7,15 +7,10 @@
|
|||
|
||||
module Command.Fsck where
|
||||
|
||||
import Control.Monad.State (liftIO)
|
||||
import System.Posix.Files
|
||||
import System.Directory
|
||||
|
||||
import Command
|
||||
import qualified Annex
|
||||
import Types
|
||||
import Utility
|
||||
import Core
|
||||
import qualified Data.Map as M
|
||||
|
||||
{- Checks the whole annex for problems. -}
|
||||
start :: SubCmdStart
|
||||
|
@ -35,5 +30,40 @@ perform = do
|
|||
checkUnused :: Annex Bool
|
||||
checkUnused = do
|
||||
showNote "checking for unused data..."
|
||||
-- TODO
|
||||
unused <- unusedKeys
|
||||
if (null unused)
|
||||
then return True
|
||||
else do
|
||||
showLongNote $ w unused
|
||||
return False
|
||||
where
|
||||
w u = unlines $ [
|
||||
"Some annexed data is no longer pointed to by any file.",
|
||||
"If this data is no longer needed, it can be removed using git-annex dropkey:"
|
||||
] ++ map show u
|
||||
|
||||
unusedKeys :: Annex [Key]
|
||||
unusedKeys = do
|
||||
present <- getKeysPresent
|
||||
referenced <- getKeysReferenced
|
||||
|
||||
-- Constructing a single map, of the set that tends to be smaller,
|
||||
-- appears more efficient in both memory and CPU than constructing
|
||||
-- and taking the M.difference of two maps.
|
||||
let present_m = existsMap present
|
||||
let unused_m = remove referenced present_m
|
||||
return $ M.keys unused_m
|
||||
where
|
||||
remove [] m = m
|
||||
remove (x:xs) m = remove xs $ M.delete x m
|
||||
|
||||
existsMap :: Ord k => [k] -> M.Map k Int
|
||||
existsMap l = M.fromList $ map (\k -> (k, 1)) l
|
||||
|
||||
getKeysPresent :: Annex [Key]
|
||||
getKeysPresent = do
|
||||
return []
|
||||
|
||||
getKeysReferenced :: Annex [Key]
|
||||
getKeysReferenced = do
|
||||
return []
|
||||
|
|
|
@ -39,7 +39,7 @@ type Annex = StateT AnnexState IO
|
|||
-- annexed filenames are mapped through a backend into keys
|
||||
type KeyName = String
|
||||
type BackendName = String
|
||||
data Key = Key (BackendName, KeyName) deriving (Eq)
|
||||
data Key = Key (BackendName, KeyName) deriving (Eq, Ord)
|
||||
|
||||
-- constructs a key in a backend
|
||||
genKey :: Backend -> KeyName -> Key
|
||||
|
|
Loading…
Reference in a new issue