add webapp UI to manage unused files

1 files changed, 86 insertions, 0 deletions

diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs
new file mode 100644
index 000000000..3ad98c12e
--- /dev/null
+++ b/Assistant/Unused.hs
@@ -0,0 +1,86 @@
+{- git-annex assistant unused files
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Assistant.Unused where
+
+import qualified Data.Map as M
+
+import Assistant.Common
+import qualified Git
+import Types.Key
+import Logs.Unused
+import Logs.Location
+import Annex.Content
+import Utility.DataUnits
+import Utility.DiskFree
+import Utility.HumanTime
+import Utility.Tense
+
+import Data.Time.Clock.POSIX
+import qualified Data.Text as T
+
+describeUnused :: Assistant (Maybe TenseText)
+describeUnused = describeUnused' False
+
+describeUnusedWhenBig :: Assistant (Maybe TenseText)
+describeUnusedWhenBig = describeUnused' True
+
+{- This uses heuristics: 1000 unused keys, or more unused keys 
+ - than the remaining free disk space, or more than 1/10th the total
+ - disk space being unused keys all suggest a problem. -}
+describeUnused' :: Bool -> Assistant (Maybe TenseText)
+describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog ""
+  where
+	go m = do
+		let num = M.size m
+		let diskused = foldl' sumkeysize 0 (M.keys m)
+		df <- forpath getDiskFree
+		disksize <- forpath getDiskSize
+		return $ if num == 0
+			then Nothing
+			else if not whenbig || moreused df diskused || tenthused disksize diskused
+				then Just $ tenseWords
+					[ UnTensed $ T.pack $ roughSize storageUnits False diskused
+					, Tensed "are" "were"
+					, "taken up by unused files"
+					]
+				else if num > 1000
+					then Just $ tenseWords
+						[ UnTensed $ T.pack $ show num ++ " unused files"
+						, Tensed "exist" "existed"
+						]
+					else Nothing
+
+	moreused Nothing _ = False
+	moreused (Just df) used = df <= used
+
+	tenthused Nothing _ = False
+	tenthused (Just disksize) used = used >= disksize `div` 10
+
+	sumkeysize s k = s + fromMaybe 0 (keySize k)
+
+	forpath a = inRepo $ liftIO . a . Git.repoPath
+
+{- With a duration, expires all unused files that are older.
+ - With Nothing, expires *all* unused files. -}
+expireUnused :: Maybe Duration -> Assistant ()
+expireUnused duration = do
+	m <- liftAnnex $ readUnusedLog ""
+	now <- liftIO getPOSIXTime
+	let oldkeys = M.keys $ M.filter (tooold now) m
+	forM_ oldkeys $ \k -> do
+		debug ["removing old unused key", key2file k]
+		liftAnnex $ do
+			removeAnnex k
+			logStatus k InfoMissing
+  where
+	boundry = durationToPOSIXTime <$> duration
+	tooold now (_, mt) = case boundry of
+		Nothing -> True
+		Just b -> maybe False (\t -> now - t >= b) mt