cleanup
This commit is contained in:
parent
bab6dc48d3
commit
9517fbb948
4 changed files with 38 additions and 12 deletions
32
Fields.hs
Normal file
32
Fields.hs
Normal 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
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue