This commit is contained in:
Joey Hess 2012-07-02 08:35:15 -04:00
parent bab6dc48d3
commit 9517fbb948
4 changed files with 38 additions and 12 deletions

32
Fields.hs Normal file
View file

@ -0,0 +1,32 @@
{- git-annex fields
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Fields where
import Common.Annex
import qualified Annex
import Data.Char
{- A field, stored in Annex state, with a value sanity checker. -}
data Field = Field
{ fieldName :: String
, fieldCheck :: String -> IO Bool
}
remoteUUID :: Field
remoteUUID = Field "remoteuuid" $
-- does it look like a UUID?
return . all (\c -> isAlphaNum c || c == '-')
associatedFile :: Field
associatedFile = Field "associatedfile" $ \value ->
-- is the file located within the current directory?
dirContains <$> getCurrentDirectory <*> pure value
getField :: Field -> Annex (Maybe String)
getField = Annex.getField . fieldName

View file

@ -9,7 +9,6 @@ module GitAnnexShell where
import System.Environment import System.Environment
import System.Console.GetOpt import System.Console.GetOpt
import Data.Char
import Common.Annex import Common.Annex
import qualified Git.Construct import qualified Git.Construct
@ -17,6 +16,7 @@ import CmdLine
import Command import Command
import Annex.UUID import Annex.UUID
import qualified Option import qualified Option
import Fields
import qualified Command.ConfigList import qualified Command.ConfigList
import qualified Command.InAnnex import qualified Command.InAnnex
@ -49,7 +49,6 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
options :: [OptDescr (Annex ())] options :: [OptDescr (Annex ())]
options = Option.common ++ options = Option.common ++
[ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid" [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid"
, Option [] ["remote-uuid"] (ReqArg checkuuid paramUUID) "remote repository uuid"
] ]
where where
checkuuid expected = getUUID >>= check checkuuid expected = getUUID >>= check
@ -116,12 +115,8 @@ parseFields = map (separate (== '='))
- Make sure that field values make sense. -} - Make sure that field values make sense. -}
checkField :: (String, String) -> IO Bool checkField :: (String, String) -> IO Bool
checkField (field, value) checkField (field, value)
| field == "remoteuuid" = return $ | field == fieldName remoteUUID = fieldCheck remoteUUID value
-- does it look like a UUID? | field == fieldName associatedFile = fieldCheck associatedFile value
all (\c -> isAlphaNum c || c == '-') value
| field == "associatedfile" =
-- is the file located within the current directory?
dirContains <$> getCurrentDirectory <*> pure value
| otherwise = return False | otherwise = return False
failure :: IO () failure :: IO ()

View file

@ -10,9 +10,9 @@ module Logs.Transfer where
import Common.Annex import Common.Annex
import Annex.Perms import Annex.Perms
import Annex.Exception import Annex.Exception
import qualified Annex
import qualified Git import qualified Git
import Types.Remote import Types.Remote
import qualified Fields
import Control.Concurrent import Control.Concurrent
import System.Posix.Types import System.Posix.Types
@ -57,9 +57,9 @@ download u key file a = transfer (Transfer Download u key) file a
fieldTransfer :: Direction -> Key -> Annex a -> Annex a fieldTransfer :: Direction -> Key -> Annex a -> Annex a
fieldTransfer direction key a = do fieldTransfer direction key a = do
afile <- Annex.getField "associatedfile" afile <- Fields.getField Fields.associatedFile
maybe a (\u -> transfer (Transfer direction (toUUID u) key) afile a) maybe a (\u -> transfer (Transfer direction (toUUID u) key) afile a)
=<< Annex.getField "remoteuuid" =<< Fields.getField Fields.remoteUUID
{- Runs a transfer action. Creates and locks the transfer information file {- Runs a transfer action. Creates and locks the transfer information file
- while the action is running. Will throw an error if the transfer is - while the action is running. Will throw an error if the transfer is

View file

@ -76,4 +76,3 @@ field short opt paramdesc description =
{- The flag or field name used for an option. -} {- The flag or field name used for an option. -}
name :: Option -> String name :: Option -> String
name (Option _ o _ _) = Prelude.head o name (Option _ o _ _) = Prelude.head o