984c9fc052
get, drop: Added --auto option, which decides whether to get/drop content as needed to work toward the configured numcopies. The problem with bundling it up in optimize was that I then found I wanted to run an optmize that did not drop files, only got them. Considered adding a --only-get switch to it, but that seemed wrong. Instead, let's make existing subcommands optionally smarter. Note that the only actual difference between drop and drop --auto is that the latter does not even try to drop a file if it knows of not enough copies, and does not print any error messages about files it was unable to drop. It might be nice to make get avoid asking git for attributes when not in auto mode. For now it always asks for attributes.
116 lines
2.5 KiB
Haskell
116 lines
2.5 KiB
Haskell
{- git-annex monad
|
||
-
|
||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||
-
|
||
- Licensed under the GNU GPL version 3 or higher.
|
||
-}
|
||
|
||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||
|
||
module Annex (
|
||
Annex,
|
||
AnnexState(..),
|
||
OutputType(..),
|
||
new,
|
||
run,
|
||
eval,
|
||
getState,
|
||
changeState,
|
||
gitRepo
|
||
) where
|
||
|
||
import Control.Monad.State
|
||
import Control.Monad.IO.Control
|
||
import Control.Applicative hiding (empty)
|
||
|
||
import qualified Git
|
||
import Git.Queue
|
||
import Types.Backend
|
||
import Types.Remote
|
||
import Types.Crypto
|
||
import Types.BranchState
|
||
import Types.TrustLevel
|
||
import Types.UUID
|
||
|
||
-- git-annex's monad
|
||
newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
|
||
deriving (
|
||
Monad,
|
||
MonadIO,
|
||
MonadControlIO,
|
||
MonadState AnnexState,
|
||
Functor,
|
||
Applicative
|
||
)
|
||
|
||
-- internal state storage
|
||
data AnnexState = AnnexState
|
||
{ repo :: Git.Repo
|
||
, backends :: [Backend Annex]
|
||
, remotes :: [Remote Annex]
|
||
, repoqueue :: Queue
|
||
, output :: OutputType
|
||
, force :: Bool
|
||
, fast :: Bool
|
||
, auto :: Bool
|
||
, branchstate :: BranchState
|
||
, forcebackend :: Maybe String
|
||
, forcenumcopies :: Maybe Int
|
||
, defaultkey :: Maybe String
|
||
, toremote :: Maybe String
|
||
, fromremote :: Maybe String
|
||
, exclude :: [String]
|
||
, forcetrust :: [(UUID, TrustLevel)]
|
||
, trustmap :: Maybe TrustMap
|
||
, cipher :: Maybe Cipher
|
||
}
|
||
|
||
data OutputType = NormalOutput | QuietOutput | JSONOutput
|
||
|
||
newState :: Git.Repo -> AnnexState
|
||
newState gitrepo = AnnexState
|
||
{ repo = gitrepo
|
||
, backends = []
|
||
, remotes = []
|
||
, repoqueue = empty
|
||
, output = NormalOutput
|
||
, force = False
|
||
, fast = False
|
||
, auto = False
|
||
, branchstate = startBranchState
|
||
, forcebackend = Nothing
|
||
, forcenumcopies = Nothing
|
||
, defaultkey = Nothing
|
||
, toremote = Nothing
|
||
, fromremote = Nothing
|
||
, exclude = []
|
||
, forcetrust = []
|
||
, trustmap = Nothing
|
||
, cipher = Nothing
|
||
}
|
||
|
||
{- Create and returns an Annex state object for the specified git repo. -}
|
||
new :: Git.Repo -> IO AnnexState
|
||
new gitrepo = newState <$> Git.configRead gitrepo
|
||
|
||
{- performs an action in the Annex monad -}
|
||
run :: AnnexState -> Annex a -> IO (a, AnnexState)
|
||
run s a = runStateT (runAnnex a) s
|
||
eval :: AnnexState -> Annex a -> IO a
|
||
eval s a = evalStateT (runAnnex a) s
|
||
|
||
{- Gets a value from the internal state, selected by the passed value
|
||
- constructor. -}
|
||
getState :: (AnnexState -> a) -> Annex a
|
||
getState = gets
|
||
|
||
{- Applies a state mutation function to change the internal state.
|
||
-
|
||
- Example: changeState $ \s -> s { quiet = True }
|
||
-}
|
||
changeState :: (AnnexState -> AnnexState) -> Annex ()
|
||
changeState = modify
|
||
|
||
{- Returns the git repository being acted on -}
|
||
gitRepo :: Annex Git.Repo
|
||
gitRepo = getState repo
|