summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-07-10 16:26:23 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-07-10 16:26:23 -0400
commitfc65981e5950f151da1b9e5b30575e6d77b8d187 (patch)
tree8521196721ef3ab30d8f9e9426ae508b6a2c242d
parent8b5e406cffc7eeccba308ff4219a26cfc6d10ac2 (diff)
convert Expire
-rw-r--r--CmdLine/GitAnnex.hs4
-rw-r--r--Command/Expire.hs48
2 files changed, 30 insertions, 22 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 662766f46..2990a6c38 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -48,7 +48,7 @@ import qualified Command.Init
import qualified Command.Describe
import qualified Command.InitRemote
import qualified Command.EnableRemote
---import qualified Command.Expire
+import qualified Command.Expire
import qualified Command.Repair
import qualified Command.Unused
import qualified Command.DropUnused
@@ -178,7 +178,7 @@ cmds =
, Command.VPop.cmd
, Command.VCycle.cmd
, Command.Fix.cmd
--- , Command.Expire.cmd
+ , Command.Expire.cmd
, Command.Repair.cmd
, Command.Unused.cmd
, Command.DropUnused.cmd
diff --git a/Command/Expire.hs b/Command/Expire.hs
index 9552128f1..1e67d1d2a 100644
--- a/Command/Expire.hs
+++ b/Command/Expire.hs
@@ -21,30 +21,39 @@ import Data.Time.Clock.POSIX
import qualified Data.Map as M
cmd :: Command
-cmd = withOptions [activityOption, noActOption] $
- command "expire" SectionMaintenance
- "expire inactive repositories"
- paramExpire (withParams seek)
+cmd = command "expire" SectionMaintenance
+ "expire inactive repositories"
+ paramExpire (seek <$$> optParser)
paramExpire :: String
paramExpire = (paramRepeating $ paramOptional paramRemote ++ ":" ++ paramTime)
-activityOption :: Option
-activityOption = fieldOption [] "activity" "Name" "specify activity"
+data ExpireOptions = ExpireOptions
+ { expireParams :: CmdParams
+ , activityOption :: Maybe Activity
+ , noActOption :: Bool
+ }
-noActOption :: Option
-noActOption = flagOption [] "no-act" "don't really do anything"
+optParser :: CmdParamsDesc -> Parser ExpireOptions
+optParser desc = ExpireOptions
+ <$> cmdParams desc
+ <*> optional (option (str >>= parseActivity)
+ ( long "activity" <> metavar paramName
+ <> help "specify activity that prevents expiry"
+ ))
+ <*> switch
+ ( long "no-act"
+ <> help "don't really do anything"
+ )
-seek :: CmdParams -> CommandSeek
-seek ps = do
- expire <- parseExpire ps
- wantact <- getOptionField activityOption (pure . parseActivity)
- noact <- getOptionFlag noActOption
- actlog <- lastActivities wantact
+seek :: ExpireOptions -> CommandSeek
+seek o = do
+ expire <- parseExpire (expireParams o)
+ actlog <- lastActivities (activityOption o)
u <- getUUID
us <- filter (/= u) . M.keys <$> uuidMap
descs <- uuidMap
- seekActions $ pure $ map (start expire noact actlog descs) us
+ seekActions $ pure $ map (start expire (noActOption o) actlog descs) us
start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandStart
start (Expire expire) noact actlog descs u =
@@ -99,10 +108,9 @@ parseExpire ps = do
Nothing -> error $ "bad expire time: " ++ s
Just d -> Just (now - durationToPOSIXTime d)
-parseActivity :: Maybe String -> Maybe Activity
-parseActivity Nothing = Nothing
-parseActivity (Just s) = case readish s of
- Nothing -> error $ "Unknown activity. Choose from: " ++
+parseActivity :: Monad m => String -> m Activity
+parseActivity s = case readish s of
+ Nothing -> fail $ "Unknown activity. Choose from: " ++
unwords (map show [minBound..maxBound :: Activity])
- Just v -> Just v
+ Just v -> return v