moved AssociatedFile definition

This commit is contained in:
Joey Hess 2013-07-04 02:36:02 -04:00
parent 7ae3223eab
commit 7a7e426352
13 changed files with 15 additions and 20 deletions

View file

@ -10,7 +10,6 @@ module Annex.Wanted where
import Common.Annex import Common.Annex
import Logs.PreferredContent import Logs.PreferredContent
import Annex.UUID import Annex.UUID
import Types.Remote
import qualified Data.Set as S import qualified Data.Set as S

View file

@ -11,7 +11,7 @@ import Assistant.Common
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Logs.Location import Logs.Location
import Logs.Trust import Logs.Trust
import Types.Remote (AssociatedFile, uuid) import Types.Remote (uuid)
import qualified Remote import qualified Remote
import qualified Command.Drop import qualified Command.Drop
import Command import Command

View file

@ -16,7 +16,6 @@ import Control.Concurrent.STM
import System.Process (create_group) import System.Process (create_group)
import Control.Exception (throw) import Control.Exception (throw)
import Control.Concurrent import Control.Concurrent
import Types.Remote (AssociatedFile)
{- Runs an action with a Transferrer from the pool. -} {- Runs an action with a Transferrer from the pool. -}
withTransferrer :: FilePath -> TransferrerPool -> (Transferrer -> IO a) -> IO a withTransferrer :: FilePath -> TransferrerPool -> (Transferrer -> IO a) -> IO a

View file

@ -9,7 +9,6 @@ module Assistant.Types.TransferQueue where
import Common.Annex import Common.Annex
import Logs.Transfer import Logs.Transfer
import Types.Remote
import Control.Concurrent.STM import Control.Concurrent.STM
import Utility.TList import Utility.TList

View file

@ -16,7 +16,6 @@ import Logs.Transfer
import Annex.Wanted import Annex.Wanted
import GitAnnex.Options import GitAnnex.Options
import Types.Key import Types.Key
import Types.Remote
def :: [Command] def :: [Command]
def = [withOptions getOptions $ command "get" paramPaths seek def = [withOptions getOptions $ command "get" paramPaths seek

View file

@ -19,7 +19,6 @@ import Logs.Presence
import Logs.Transfer import Logs.Transfer
import GitAnnex.Options import GitAnnex.Options
import Types.Key import Types.Key
import Types.Remote
def :: [Command] def :: [Command]
def = [withOptions moveOptions $ command "move" paramPaths seek def = [withOptions moveOptions $ command "move" paramPaths seek

View file

@ -15,7 +15,6 @@ import Annex.Content
import Logs.Location import Logs.Location
import Logs.Transfer import Logs.Transfer
import qualified Remote import qualified Remote
import Types.Remote (AssociatedFile)
import Types.Key import Types.Key
import qualified Option import qualified Option

View file

@ -13,7 +13,6 @@ import Common.Annex
import Annex.Perms import Annex.Perms
import Annex.Exception import Annex.Exception
import qualified Git import qualified Git
import Types.Remote
import Types.Key import Types.Key
import Utility.Metered import Utility.Metered
import Utility.Percentage import Utility.Percentage

View file

@ -6,7 +6,7 @@
-} -}
module Logs.Unused ( module Logs.Unused (
UnusedMap(..), UnusedMap,
writeUnusedLog, writeUnusedLog,
readUnusedLog, readUnusedLog,
unusedKeys, unusedKeys,

View file

@ -134,14 +134,14 @@ withNothing _ _ = error "This command takes no parameters."
withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek
withKeyOptions keyop fallbackop params = do withKeyOptions keyop fallbackop params = do
bare <- fromRepo Git.repoIsLocalBare bare <- fromRepo Git.repoIsLocalBare
all <- Annex.getFlag "all" <||> pure bare allkeys <- Annex.getFlag "all" <||> pure bare
unused <- Annex.getFlag "unused" unused <- Annex.getFlag "unused"
auto <- Annex.getState Annex.auto auto <- Annex.getState Annex.auto
case (all , unused, auto ) of case (allkeys , unused, auto ) of
(True , False , False) -> go loggedKeys (True , False , False) -> go loggedKeys
(False, True , False) -> go unusedKeys (False , True , False) -> go unusedKeys
(True , True , _ ) -> error "Cannot use --all with --unused." (True , True , _ ) -> error "Cannot use --all with --unused."
(False, False , _ ) -> fallbackop params (False , False , _ ) -> fallbackop params
(_ , _ , True ) (_ , _ , True )
| bare -> error "Cannot use --auto in a bare repository." | bare -> error "Cannot use --auto in a bare repository."
| otherwise -> error "Cannot use --auto with --all or --unused." | otherwise -> error "Cannot use --auto with --all or --unused."

View file

@ -9,6 +9,7 @@ module Types (
Annex, Annex,
Backend, Backend,
Key, Key,
AssociatedFile,
UUID(..), UUID(..),
GitConfig(..), GitConfig(..),
RemoteGitConfig(..), RemoteGitConfig(..),

View file

@ -9,6 +9,7 @@
module Types.Key ( module Types.Key (
Key(..), Key(..),
AssociatedFile,
stubKey, stubKey,
key2file, key2file,
file2key, file2key,
@ -21,7 +22,7 @@ import System.Posix.Types
import Common import Common
import Utility.QuickCheck import Utility.QuickCheck
{- A Key has a unique name, is associated with a key/value backend, {- A Key has a unique name, which is derived from a particular backend,
- and may contain other optional metadata. -} - and may contain other optional metadata. -}
data Key = Key { data Key = Key {
keyName :: String, keyName :: String,
@ -30,6 +31,9 @@ data Key = Key {
keyMtime :: Maybe EpochTime keyMtime :: Maybe EpochTime
} deriving (Eq, Ord, Read, Show) } deriving (Eq, Ord, Read, Show)
{- A filename may be associated with a Key. -}
type AssociatedFile = Maybe FilePath
stubKey :: Key stubKey :: Key
stubKey = Key { stubKey = Key {
keyName = "", keyName = "",

View file

@ -37,9 +37,6 @@ data RemoteTypeA a = RemoteType {
instance Eq (RemoteTypeA a) where instance Eq (RemoteTypeA a) where
x == y = typename x == typename y x == y = typename x == typename y
{- A filename associated with a Key, for display to user. -}
type AssociatedFile = Maybe FilePath
{- An individual remote. -} {- An individual remote. -}
data RemoteA a = Remote { data RemoteA a = Remote {
-- each Remote has a unique uuid -- each Remote has a unique uuid