diff options
| -rw-r--r-- | Fields.hs | 32 | ||||
| -rw-r--r-- | GitAnnexShell.hs | 11 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 6 | ||||
| -rw-r--r-- | Option.hs | 1 |
4 files changed, 38 insertions, 12 deletions
diff --git a/Fields.hs b/Fields.hs new file mode 100644 index 000000000..08189cbdf --- /dev/null +++ b/Fields.hs @@ -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 diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 559e30235..497e4cf8f 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -9,7 +9,6 @@ module GitAnnexShell where import System.Environment import System.Console.GetOpt -import Data.Char import Common.Annex import qualified Git.Construct @@ -17,6 +16,7 @@ import CmdLine import Command import Annex.UUID import qualified Option +import Fields import qualified Command.ConfigList import qualified Command.InAnnex @@ -49,7 +49,6 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly options :: [OptDescr (Annex ())] options = Option.common ++ [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid" - , Option [] ["remote-uuid"] (ReqArg checkuuid paramUUID) "remote repository uuid" ] where checkuuid expected = getUUID >>= check @@ -116,12 +115,8 @@ parseFields = map (separate (== '=')) - Make sure that field values make sense. -} checkField :: (String, String) -> IO Bool checkField (field, value) - | field == "remoteuuid" = return $ - -- does it look like a UUID? - all (\c -> isAlphaNum c || c == '-') value - | field == "associatedfile" = - -- is the file located within the current directory? - dirContains <$> getCurrentDirectory <*> pure value + | field == fieldName remoteUUID = fieldCheck remoteUUID value + | field == fieldName associatedFile = fieldCheck associatedFile value | otherwise = return False failure :: IO () diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 658e18b5d..dbd45f199 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -10,9 +10,9 @@ module Logs.Transfer where import Common.Annex import Annex.Perms import Annex.Exception -import qualified Annex import qualified Git import Types.Remote +import qualified Fields import Control.Concurrent 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 a = do - afile <- Annex.getField "associatedfile" + afile <- Fields.getField Fields.associatedFile 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 - while the action is running. Will throw an error if the transfer is @@ -76,4 +76,3 @@ field short opt paramdesc description = {- The flag or field name used for an option. -} name :: Option -> String name (Option _ o _ _) = Prelude.head o - |