mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

reformat

Browse source
This commit is contained in:
Joey Hess 2014-12-16 15:26:13 -04:00
parent c64ede23cd
commit 65bce2c80d
8 changed files with 206 additions and 206 deletions
Download patch file Download diff file Expand all files Collapse all files

52
Remote/Directory.hs
View file

@ -46,32 +46,32 @@ gen r u c gc = do
(retrieve dir chunkconfig) (retrieve dir chunkconfig)
(simplyPrepare $ remove dir) (simplyPrepare $ remove dir)
(simplyPrepare $ checkKey dir chunkconfig) (simplyPrepare $ checkKey dir chunkconfig)
Remote { Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = retrieveCheap dir chunkconfig, , retrieveKeyFileCheap = retrieveCheap dir chunkconfig
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = True, , checkPresentCheap = True
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
localpath = Just dir, , localpath = Just dir
readonly = False, , readonly = False
availability = LocallyAvailable, , availability = LocallyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = gen r u c $ , mkUnavailable = gen r u c $
gc { remoteAnnexDirectory = Just "/dev/null" }, gc { remoteAnnexDirectory = Just "/dev/null" }
getInfo = return [("directory", dir)], , getInfo = return [("directory", dir)]
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
where where
dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc

52
Remote/External.hs
View file

@ -48,32 +48,32 @@ gen r u c gc = do
(simplyPrepare $ retrieve external) (simplyPrepare $ retrieve external)
(simplyPrepare $ remove external) (simplyPrepare $ remove external)
(simplyPrepare $ checkKey external) (simplyPrepare $ checkKey external)
Remote { Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = \_ _ -> return False, , retrieveKeyFileCheap = \_ _ -> return False
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
localpath = Nothing, , localpath = Nothing
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
readonly = False, , readonly = False
availability = avail, , availability = avail
remotetype = remote, , remotetype = remote
mkUnavailable = gen r u c $ , mkUnavailable = gen r u c $
gc { remoteAnnexExternalType = Just "!dne!" }, gc { remoteAnnexExternalType = Just "!dne!" }
getInfo = return [("externaltype", externaltype)], , getInfo = return [("externaltype", externaltype)]
claimUrl = Just (claimurl external), , claimUrl = Just (claimurl external)
checkUrl = Just (checkurl external) , checkUrl = Just (checkurl external)
} }
where where
externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)

52
Remote/Glacier.hs
View file

@ -46,32 +46,32 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
(simplyPrepare $ checkKey this) (simplyPrepare $ checkKey this)
this this
where where
this = Remote { this = Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = retrieveCheap this, , retrieveKeyFileCheap = retrieveCheap this
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
localpath = Nothing, , localpath = Nothing
readonly = False, , readonly = False
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = return Nothing, , mkUnavailable = return Nothing
getInfo = includeCredsInfo c (AWS.creds u) $ , getInfo = includeCredsInfo c (AWS.creds u) $
[ ("glacier vault", getVault c) ], [ ("glacier vault", getVault c) ]
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
specialcfg = (specialRemoteCfg c) specialcfg = (specialRemoteCfg c)
-- Disabled until jobList gets support for chunks. -- Disabled until jobList gets support for chunks.
{ chunkConfig = NoChunks { chunkConfig = NoChunks

52
Remote/Hook.hs
View file

@ -39,32 +39,32 @@ gen r u c gc = do
(simplyPrepare $ retrieve hooktype) (simplyPrepare $ retrieve hooktype)
(simplyPrepare $ remove hooktype) (simplyPrepare $ remove hooktype)
(simplyPrepare $ checkKey r hooktype) (simplyPrepare $ checkKey r hooktype)
Remote { Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = retrieveCheap hooktype, , retrieveKeyFileCheap = retrieveCheap hooktype
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
localpath = Nothing, , localpath = Nothing
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
readonly = False, , readonly = False
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = gen r u c $ , mkUnavailable = gen r u c $
gc { remoteAnnexHookType = Just "!dne!" }, gc { remoteAnnexHookType = Just "!dne!" }
getInfo = return [("hooktype", hooktype)], , getInfo = return [("hooktype", hooktype)]
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
where where
hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc

52
Remote/S3.hs
View file

@ -65,37 +65,37 @@ gen r u c gc = do
(prepareS3 this info $ checkKey this) (prepareS3 this info $ checkKey this)
this this
where where
this = Remote { this = Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = retrieveCheap, , retrieveKeyFileCheap = retrieveCheap
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
localpath = Nothing, , localpath = Nothing
readonly = False, , readonly = False
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc, , mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc
getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes , getInfo = includeCredsInfo c (AWS.creds u) $ catMaybes
[ Just ("bucket", fromMaybe "unknown" (getBucketName c)) [ Just ("bucket", fromMaybe "unknown" (getBucketName c))
, if configIA c , if configIA c
then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucketName c) then Just ("internet archive item", iaItemUrl $ fromMaybe "unknown" $ getBucketName c)
else Nothing else Nothing
, Just ("partsize", maybe "unlimited" (roughSize storageUnits False) (getPartSize c)) , Just ("partsize", maybe "unlimited" (roughSize storageUnits False) (getPartSize c))
], ]
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
s3Setup mu mcreds c = do s3Setup mu mcreds c = do

50
Remote/Tahoe.hs
View file

@ -64,31 +64,31 @@ gen r u c gc = do
hdl <- liftIO $ TahoeHandle hdl <- liftIO $ TahoeHandle
<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc) <$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)
<*> newEmptyTMVarIO <*> newEmptyTMVarIO
return $ Just $ Remote { return $ Just $ Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = store u hdl, , storeKey = store u hdl
retrieveKeyFile = retrieve u hdl, , retrieveKeyFile = retrieve u hdl
retrieveKeyFileCheap = \_ _ -> return False, , retrieveKeyFileCheap = \_ _ -> return False
removeKey = remove, , removeKey = remove
checkPresent = checkKey u hdl, , checkPresent = checkKey u hdl
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
localpath = Nothing, , localpath = Nothing
readonly = False, , readonly = False
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = return Nothing, , mkUnavailable = return Nothing
getInfo = return [], , getInfo = return []
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)
tahoeSetup mu _ c = do tahoeSetup mu _ c = do

50
Remote/Web.hs
View file

@ -42,31 +42,31 @@ list = do
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
gen r _ c gc = gen r _ c gc =
return $ Just Remote { return $ Just Remote
uuid = webUUID, { uuid = webUUID
cost = expensiveRemoteCost, , cost = expensiveRemoteCost
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = uploadKey, , storeKey = uploadKey
retrieveKeyFile = downloadKey, , retrieveKeyFile = downloadKey
retrieveKeyFileCheap = downloadKeyCheap, , retrieveKeyFileCheap = downloadKeyCheap
removeKey = dropKey, , removeKey = dropKey
checkPresent = checkKey, , checkPresent = checkKey
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Just getWebUrls, , whereisKey = Just getWebUrls
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
gitconfig = gc, , gitconfig = gc
localpath = Nothing, , localpath = Nothing
repo = r, , repo = r
readonly = True, , readonly = True
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = return Nothing, , mkUnavailable = return Nothing
getInfo = return [], , getInfo = return []
claimUrl = Nothing, -- implicitly claims all urls , claimUrl = Nothing -- implicitly claims all urls
checkUrl = Nothing , checkUrl = Nothing
} }
downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
downloadKey key _file dest _p = get =<< getWebUrls key downloadKey key _file dest _p = get =<< getWebUrls key

52
Remote/WebDAV.hs
View file

@ -51,32 +51,32 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
(prepareDAV this $ checkKey this chunkconfig) (prepareDAV this $ checkKey this chunkconfig)
this this
where where
this = Remote { this = Remote
uuid = u, { uuid = u
cost = cst, , cost = cst
name = Git.repoDescribe r, , name = Git.repoDescribe r
storeKey = storeKeyDummy, , storeKey = storeKeyDummy
retrieveKeyFile = retreiveKeyFileDummy, , retrieveKeyFile = retreiveKeyFileDummy
retrieveKeyFileCheap = retrieveCheap, , retrieveKeyFileCheap = retrieveCheap
removeKey = removeKeyDummy, , removeKey = removeKeyDummy
checkPresent = checkPresentDummy, , checkPresent = checkPresentDummy
checkPresentCheap = False, , checkPresentCheap = False
whereisKey = Nothing, , whereisKey = Nothing
remoteFsck = Nothing, , remoteFsck = Nothing
repairRepo = Nothing, , repairRepo = Nothing
config = c, , config = c
repo = r, , repo = r
gitconfig = gc, , gitconfig = gc
localpath = Nothing, , localpath = Nothing
readonly = False, , readonly = False
availability = GloballyAvailable, , availability = GloballyAvailable
remotetype = remote, , remotetype = remote
mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc, , mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc
getInfo = includeCredsInfo c (davCreds u) $ , getInfo = includeCredsInfo c (davCreds u) $
[("url", fromMaybe "unknown" (M.lookup "url" c))], [("url", fromMaybe "unknown" (M.lookup "url" c))]
claimUrl = Nothing, , claimUrl = Nothing
checkUrl = Nothing , checkUrl = Nothing
} }
chunkconfig = getChunkConfig c chunkconfig = getChunkConfig c
webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID) webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)