add webapp UI to manage unused files

6 files changed, 116 insertions, 51 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index b5ee706b8..58264cfbf 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -1,6 +1,6 @@
 {- git-annex assistant alerts
  -
- - Copyright 2012, 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index bdde1726d..8a513a43b 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -21,7 +21,6 @@ import Assistant.Ssh
 import Assistant.TransferQueue
 import Assistant.Types.UrlRenderer
 import qualified Annex.Branch
-import qualified Git
 import qualified Git.LsFiles
 import qualified Git.Command
 import qualified Git.Config
@@ -30,25 +29,21 @@ import qualified Assistant.Threads.Watcher as Watcher
 import Utility.LogFile
 import Utility.Batch
 import Utility.NotificationBroadcaster
-import Utility.DiskFree
 import Config
 import Utility.HumanTime
-import Utility.DataUnits
+import Utility.Tense
 import Git.Repair
 import Git.Index
+import Assistant.Unused
 import Logs.Unused
-import Logs.Location
 import Logs.Transfer
-import Annex.Content
 import Config.Files
-import Types.Key
 import qualified Annex
 #ifdef WITH_WEBAPP
 import Assistant.WebApp.Types
 #endif
 
 import Data.Time.Clock.POSIX
-import qualified Data.Map as M
 import qualified Data.Text as T
 
 {- This thread runs once at startup, and most other threads wait for it
@@ -226,56 +221,19 @@ oneDay = 24 * oneHour
  - for the specified duration, and remove them.
  -
  - Otherwise, check to see if unused keys are piling up, and let the user
- - know. 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. -}
+ - know. -}
 checkOldUnused :: UrlRenderer -> Assistant ()
 checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGitConfig
   where
 	go (Just Nothing) = noop
-  	go (Just (Just expireunused)) = do
-		m <- liftAnnex $ readUnusedLog ""
-		now <- liftIO getPOSIXTime
-		let duration = durationToPOSIXTime expireunused
-		let oldkeys = M.keys $ M.filter (tooold now duration) m
-		forM_ oldkeys $ \k -> do
-			debug ["removing old unused key", key2file k]
-			liftAnnex $ do
-				removeAnnex k
-				logStatus k InfoMissing
-	go Nothing = maybe noop prompt
-		=<< toobig =<< liftAnnex (readUnusedLog "")
-
-	tooold now duration (_, mt) =
-		maybe False (\t -> now - t >= duration) mt
-
-	toobig m = do
-		let num = M.size m
-		let diskused = foldl' sumkeysize 0 (M.keys m)
-		df <- forpath getDiskFree
-		disksize <- forpath getDiskSize
-		return $ if moreused df diskused || tenthused disksize diskused
-			then Just $ roughSize storageUnits False diskused ++
-				" is used by old files"
-			else if num > 1000
-				then Just $ show num ++ " old files exist"
-				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 = liftAnnex $ inRepo $ liftIO . a . Git.repoPath
+  	go (Just (Just expireunused)) = expireUnused (Just expireunused)
+	go Nothing = maybe noop prompt =<< describeUnusedWhenBig
 
 	prompt msg = 
 #ifdef WITH_WEBAPP
 		do
-			button <- mkAlertButton True (T.pack "Fix This") urlrenderer ConfigUnusedR
-			void $ addAlert $ unusedFilesAlert [button] msg
+			button <- mkAlertButton True (T.pack "Configure") urlrenderer ConfigUnusedR
+			void $ addAlert $ unusedFilesAlert [button] $ T.unpack $ renderTense Present msg
 #else
 		debug [msg]
 #endif
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
diff --git a/Logs/Unused.hs b/Logs/Unused.hs
index cdfcd2165..0af319f04 100644
--- a/Logs/Unused.hs
+++ b/Logs/Unused.hs
@@ -20,9 +20,10 @@ module Logs.Unused (
 	updateUnusedLog,
 	readUnusedLog,
 	readUnusedMap,
+	dateUnusedLog,
 	unusedKeys,
+	unusedKeys',
 	setUnusedKeys,
-	unusedKeys'
 ) where
 
 import qualified Data.Map as M
@@ -88,6 +89,11 @@ readUnusedLog prefix = do
 readUnusedMap :: FilePath -> Annex UnusedMap
 readUnusedMap = log2map <$$> readUnusedLog
 
+dateUnusedLog :: FilePath -> Annex (Maybe UTCTime)
+dateUnusedLog prefix = do
+	f <- fromRepo $ gitAnnexUnusedLog prefix
+	liftIO $ catchMaybeIO $ getModificationTime f
+
 {- Set of unused keys. This is cached for speed. -}
 unusedKeys :: Annex (S.Set Key)
 unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return
diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index 644e6fbab..297b2bd97 100644
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -7,7 +7,10 @@
 
 module Utility.HumanTime (
 	Duration(..),
+	durationSince,
 	durationToPOSIXTime,
+	durationToDays,
+	daysToDuration,
 	parseDuration,
 	fromDuration,
 	prop_duration_roundtrips
@@ -17,6 +20,7 @@ import Utility.PartialPrelude
 import Utility.Applicative
 import Utility.QuickCheck
 
+import Data.Time.Clock
 import Data.Time.Clock.POSIX (POSIXTime)
 import Data.Char
 import Control.Applicative
@@ -25,9 +29,20 @@ import qualified Data.Map as M
 newtype Duration = Duration { durationSeconds :: Integer }
   deriving (Eq, Ord, Read, Show)
 
+durationSince :: UTCTime -> IO Duration
+durationSince pasttime = do
+	now <- getCurrentTime
+	return $ Duration $ round $ diffUTCTime now pasttime
+
 durationToPOSIXTime :: Duration -> POSIXTime
 durationToPOSIXTime = fromIntegral . durationSeconds
 
+durationToDays :: Duration -> Integer
+durationToDays d = durationSeconds d `div` dsecs
+
+daysToDuration :: Integer -> Duration
+daysToDuration i = Duration $ i * dsecs
+
 {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
 parseDuration :: String -> Maybe Duration
 parseDuration = Duration <$$> go 0
diff --git a/doc/assistant/unused.png b/doc/assistant/unused.png
new file mode 100644
index 000000000..b0ace763c
--- /dev/null
+++ b/doc/assistant/unused.png