rename
This commit is contained in:
parent
ff21fd4a65
commit
cfe21e85e7
73 changed files with 173 additions and 173 deletions
|
@ -7,14 +7,14 @@
|
|||
|
||||
module Command.Add where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Annex.Exception
|
||||
import Command
|
||||
import qualified Annex
|
||||
import qualified AnnexQueue
|
||||
import qualified Annex.Queue
|
||||
import qualified Backend
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Utility.Touch
|
||||
import Backend
|
||||
|
||||
|
@ -81,6 +81,6 @@ cleanup file key hascontent = do
|
|||
|
||||
force <- Annex.getState Annex.force
|
||||
if force
|
||||
then AnnexQueue.add "add" [Param "-f", Param "--"] [file]
|
||||
else AnnexQueue.add "add" [Param "--"] [file]
|
||||
then Annex.Queue.add "add" [Param "-f", Param "--"] [file]
|
||||
else Annex.Queue.add "add" [Param "--"] [file]
|
||||
return True
|
||||
|
|
|
@ -9,7 +9,7 @@ module Command.AddUrl where
|
|||
|
||||
import Network.URI
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Backend
|
||||
import qualified Utility.Url as Url
|
||||
|
@ -17,7 +17,7 @@ import qualified Remote.Web
|
|||
import qualified Command.Add
|
||||
import qualified Annex
|
||||
import qualified Backend.URL
|
||||
import Content
|
||||
import Annex.Content
|
||||
import PresenceLog
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.ConfigList where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import UUID
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Describe where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import UUID
|
||||
|
|
|
@ -7,12 +7,12 @@
|
|||
|
||||
module Command.Drop where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import qualified Annex
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Trust
|
||||
import Config
|
||||
|
||||
|
|
|
@ -7,11 +7,11 @@
|
|||
|
||||
module Command.DropKey where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Annex
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "dropkey" (paramRepeating paramKey) seek
|
||||
|
|
|
@ -9,7 +9,7 @@ module Command.DropUnused where
|
|||
|
||||
import qualified Data.Map as M
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Annex
|
||||
import qualified Command.Drop
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.Find where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Limit
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.Fix where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified AnnexQueue
|
||||
import Content
|
||||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "fix" paramPaths seek
|
||||
|
@ -39,5 +39,5 @@ perform file link = do
|
|||
|
||||
cleanup :: FilePath -> CommandCleanup
|
||||
cleanup file = do
|
||||
AnnexQueue.add "add" [Param "--"] [file]
|
||||
Annex.Queue.add "add" [Param "--"] [file]
|
||||
return True
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.FromKey where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified AnnexQueue
|
||||
import Content
|
||||
import qualified Annex.Queue
|
||||
import Annex.Content
|
||||
import Types.Key
|
||||
|
||||
command :: [Command]
|
||||
|
@ -39,5 +39,5 @@ perform file = do
|
|||
|
||||
cleanup :: FilePath -> CommandCleanup
|
||||
cleanup file = do
|
||||
AnnexQueue.add "add" [Param "--"] [file]
|
||||
Annex.Queue.add "add" [Param "--"] [file]
|
||||
return True
|
||||
|
|
|
@ -7,13 +7,13 @@
|
|||
|
||||
module Command.Fsck where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import qualified Types.Backend
|
||||
import qualified Types.Key
|
||||
import UUID
|
||||
import Content
|
||||
import Annex.Content
|
||||
import LocationLog
|
||||
import Trust
|
||||
import Utility.DataUnits
|
||||
|
|
|
@ -7,11 +7,11 @@
|
|||
|
||||
module Command.Get where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Annex
|
||||
import qualified Remote
|
||||
import Content
|
||||
import Annex.Content
|
||||
import qualified Command.Move
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.InAnnex where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Content
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "inannex" (paramRepeating paramKey) seek
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Init where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import UUID
|
||||
import Init
|
||||
|
|
|
@ -9,7 +9,7 @@ module Command.InitRemote where
|
|||
|
||||
import qualified Data.Map as M
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import qualified RemoteLog
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.Lock where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified AnnexQueue
|
||||
import qualified Annex.Queue
|
||||
import Backend
|
||||
|
||||
command :: [Command]
|
||||
|
@ -30,5 +30,5 @@ perform file = do
|
|||
-- Checkout from HEAD to get rid of any changes that might be
|
||||
-- staged in the index, and get back to the previous symlink to
|
||||
-- the content.
|
||||
AnnexQueue.add "checkout" [Param "HEAD", Param "--"] [file]
|
||||
Annex.Queue.add "checkout" [Param "HEAD", Param "--"] [file]
|
||||
next $ return True -- no cleanup needed
|
||||
|
|
|
@ -10,7 +10,7 @@ module Command.Map where
|
|||
import Control.Exception.Extensible
|
||||
import qualified Data.Map as M
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Git
|
||||
import UUID
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.Merge where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Branch
|
||||
import qualified Annex.Branch
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "merge" paramNothing seek
|
||||
|
@ -25,5 +25,5 @@ start = do
|
|||
|
||||
perform :: CommandPerform
|
||||
perform = do
|
||||
Branch.update
|
||||
Annex.Branch.update
|
||||
next $ return True
|
||||
|
|
|
@ -7,11 +7,11 @@
|
|||
|
||||
module Command.Migrate where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Backend
|
||||
import qualified Types.Key
|
||||
import Content
|
||||
import Annex.Content
|
||||
import qualified Command.Add
|
||||
import Backend
|
||||
|
||||
|
|
|
@ -7,12 +7,12 @@
|
|||
|
||||
module Command.Move where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Command.Drop
|
||||
import qualified Annex
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
import qualified Remote
|
||||
import UUID
|
||||
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.RecvKey where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import CmdLine
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Utility.RsyncFile
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Semitrust where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import UUID
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.SendKey where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Utility.RsyncFile
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.SetKey where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "setkey" paramPath seek
|
||||
|
|
|
@ -12,7 +12,7 @@ import qualified Data.Map as M
|
|||
import qualified Data.Set as S
|
||||
import Data.Set (Set)
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import qualified Types.Backend as B
|
||||
import qualified Types.Remote as R
|
||||
import qualified Remote
|
||||
|
@ -20,7 +20,7 @@ import qualified Command.Unused
|
|||
import qualified Git
|
||||
import Command
|
||||
import Utility.DataUnits
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Types.Key
|
||||
import Backend
|
||||
import UUID
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Trust where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import Trust
|
||||
|
|
|
@ -7,14 +7,14 @@
|
|||
|
||||
module Command.Unannex where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Command.Drop
|
||||
import qualified Annex
|
||||
import qualified AnnexQueue
|
||||
import qualified Annex.Queue
|
||||
import Utility.FileMode
|
||||
import LocationLog
|
||||
import Content
|
||||
import Annex.Content
|
||||
import qualified Git
|
||||
import qualified Git.LsFiles as LsFiles
|
||||
|
||||
|
@ -71,6 +71,6 @@ cleanup file key = do
|
|||
-- Commit staged changes at end to avoid confusing the
|
||||
-- pre-commit hook if this file is later added back to
|
||||
-- git as a normal, non-annexed file.
|
||||
AnnexQueue.add "commit" [Param "-m", Param "content removed from git annex"] []
|
||||
Annex.Queue.add "commit" [Param "-m", Param "content removed from git annex"] []
|
||||
|
||||
return True
|
||||
|
|
|
@ -7,14 +7,14 @@
|
|||
|
||||
module Command.Uninit where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Git
|
||||
import qualified Annex
|
||||
import qualified Command.Unannex
|
||||
import Init
|
||||
import qualified Branch
|
||||
import Content
|
||||
import qualified Annex.Branch
|
||||
import Annex.Content
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "uninit" paramPaths seek
|
||||
|
@ -46,5 +46,5 @@ cleanup = do
|
|||
-- avoid normal shutdown
|
||||
saveState
|
||||
liftIO $ do
|
||||
Git.run g "branch" [Param "-D", Param Branch.name]
|
||||
Git.run g "branch" [Param "-D", Param Annex.Branch.name]
|
||||
exitSuccess
|
||||
|
|
|
@ -7,9 +7,9 @@
|
|||
|
||||
module Command.Unlock where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Utility.CopyFile
|
||||
import Utility.FileMode
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Untrust where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Remote
|
||||
import UUID
|
||||
|
|
|
@ -12,9 +12,9 @@ module Command.Unused where
|
|||
import qualified Data.Set as S
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Content
|
||||
import Annex.Content
|
||||
import Utility.FileMode
|
||||
import LocationLog
|
||||
import qualified Annex
|
||||
|
@ -23,8 +23,8 @@ import qualified Git.LsFiles as LsFiles
|
|||
import qualified Git.LsTree as LsTree
|
||||
import qualified Backend
|
||||
import qualified Remote
|
||||
import qualified Branch
|
||||
import CatFile
|
||||
import qualified Annex.Branch
|
||||
import Annex.CatFile
|
||||
|
||||
command :: [Command]
|
||||
command = [repoCommand "unused" paramNothing seek
|
||||
|
@ -165,7 +165,7 @@ excludeReferenced l = do
|
|||
filter ourbranches .
|
||||
map words . lines . L.unpack
|
||||
cmpheads a b = head a == head b
|
||||
ourbranchend = '/' : Branch.name
|
||||
ourbranchend = '/' : Annex.Branch.name
|
||||
ourbranches ws = not $ ourbranchend `isSuffixOf` last ws
|
||||
removewith [] s = return $ S.toList s
|
||||
removewith (a:as) s
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.Upgrade where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import Upgrade
|
||||
import Version
|
||||
import Annex.Version
|
||||
|
||||
command :: [Command]
|
||||
command = [standaloneCommand "upgrade" paramNothing seek
|
||||
|
|
|
@ -7,10 +7,10 @@
|
|||
|
||||
module Command.Version where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import Command
|
||||
import qualified Build.SysConfig as SysConfig
|
||||
import Version
|
||||
import Annex.Version
|
||||
|
||||
command :: [Command]
|
||||
command = [standaloneCommand "version" paramNothing seek "show version info"]
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
module Command.Whereis where
|
||||
|
||||
import AnnexCommon
|
||||
import Annex.Common
|
||||
import LocationLog
|
||||
import Command
|
||||
import Remote
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue