git-annex/Command.hs
Joey Hess e213ef310f git-annex (5.20140717) unstable; urgency=high
* Fix minor FD leak in journal code. Closes: #754608
  * direct: Fix handling of case where a work tree subdirectory cannot
    be written to due to permissions.
  * migrate: Avoid re-checksumming when migrating from hashE to hash backend.
  * uninit: Avoid failing final removal in some direct mode repositories
    due to file modes.
  * S3: Deal with AWS ACL configurations that do not allow creating or
    checking the location of a bucket, but only reading and writing content to
    it.
  * resolvemerge: New plumbing command that runs the automatic merge conflict
    resolver.
  * Deal with change in git 2.0 that made indirect mode merge conflict
    resolution leave behind old files.
  * sync: Fix git sync with local git remotes even when they don't have an
    annex.uuid set. (The assistant already did so.)
  * Set gcrypt-publish-participants when setting up a gcrypt repository,
    to avoid unncessary passphrase prompts.
    This is a security/usability tradeoff. To avoid exposing the gpg key
    ids who can decrypt the repository, users can unset
    gcrypt-publish-participants.
  * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet
    exist, since it is not automatically created for Gnome 3 users.
  * Windows: Move .vbs files out of git\bin, to avoid that being in the
    PATH, which caused some weird breakage. (Thanks, divB)
  * Windows: Fix locking issue that prevented the webapp starting
    (since 5.20140707).

# imported from the archive
2014-07-17 11:27:25 -04:00

85 lines
2.4 KiB
Haskell

{- git-annex command infrastructure
-
- Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command (
command,
noRepo,
noCommit,
noMessages,
withOptions,
next,
stop,
stopUnless,
whenAnnexed,
ifAnnexed,
isBareRepo,
checkAuto,
module ReExported
) where
import Common.Annex
import qualified Backend
import qualified Annex
import qualified Git
import Types.Command as ReExported
import Types.Option as ReExported
import CmdLine.Seek as ReExported
import Checks as ReExported
import CmdLine.Usage as ReExported
import CmdLine.Action as ReExported
import CmdLine.Option as ReExported
import CmdLine.GitAnnex.Options as ReExported
{- Generates a normal command -}
command :: String -> String -> CommandSeek -> CommandSection -> String -> Command
command = Command [] Nothing commonChecks False False
{- Indicates that a command doesn't need to commit any changes to
- the git-annex branch. -}
noCommit :: Command -> Command
noCommit c = c { cmdnocommit = True }
{- Indicates that a command should not output anything other than what
- it directly sends to stdout. (--json can override this). -}
noMessages :: Command -> Command
noMessages c = c { cmdnomessages = True }
{- Adds a fallback action to a command, that will be run if it's used
- outside a git repository. -}
noRepo :: (CmdParams -> IO ()) -> Command -> Command
noRepo a c = c { cmdnorepo = Just a }
{- Adds options to a command. -}
withOptions :: [Option] -> Command -> Command
withOptions o c = c { cmdoptions = o }
{- For start and perform stages to indicate what step to run next. -}
next :: a -> Annex (Maybe a)
next a = return $ Just a
{- Or to indicate nothing needs to be done. -}
stop :: Annex (Maybe a)
stop = return Nothing
{- Stops unless a condition is met. -}
stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
stopUnless c a = ifM c ( a , stop )
{- Modifies an action to only act on files that are already annexed,
- and passes the key on to it. -}
whenAnnexed :: (FilePath -> Key -> Annex (Maybe a)) -> FilePath -> Annex (Maybe a)
whenAnnexed a file = ifAnnexed file (a file) (return Nothing)
ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a
ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare
checkAuto :: Annex Bool -> Annex Bool
checkAuto checker = ifM (Annex.getState Annex.auto)
( checker , return True )