fromkey, and url backend download work now
This commit is contained in:
parent
27472710c7
commit
da504f647f
2 changed files with 11 additions and 14 deletions
|
@ -8,12 +8,12 @@
|
||||||
module Backend.URL (backends) where
|
module Backend.URL (backends) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import Control.Monad.State (liftIO)
|
||||||
import Data.String.Utils
|
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import BackendClass
|
import BackendClass
|
||||||
import Utility
|
import Utility
|
||||||
import Messages
|
import Messages
|
||||||
|
import Key
|
||||||
|
|
||||||
backends :: [Backend Annex]
|
backends :: [Backend Annex]
|
||||||
backends = [backend]
|
backends = [backend]
|
||||||
|
@ -52,8 +52,8 @@ dummyOk _ = return True
|
||||||
|
|
||||||
downloadUrl :: Key -> FilePath -> Annex Bool
|
downloadUrl :: Key -> FilePath -> Annex Bool
|
||||||
downloadUrl key file = do
|
downloadUrl key file = do
|
||||||
showNote "downloading"
|
showNote $ "downloading"
|
||||||
showProgress -- make way for curl progress bar
|
showProgress -- make way for curl progress bar
|
||||||
liftIO $ boolSystem "curl" [Params "-# -o", File file, File url]
|
liftIO $ boolSystem "curl" [Params "-# -o", File file, File url]
|
||||||
where
|
where
|
||||||
url = join ":" $ drop 1 $ split ":" $ show key
|
url = keyName key
|
||||||
|
|
19
Command.hs
19
Command.hs
|
@ -17,7 +17,6 @@ import Data.List
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import qualified Backend
|
import qualified Backend
|
||||||
import qualified BackendClass
|
|
||||||
import Messages
|
import Messages
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
|
@ -230,20 +229,18 @@ paramName = "NAME"
|
||||||
paramNothing :: String
|
paramNothing :: String
|
||||||
paramNothing = ""
|
paramNothing = ""
|
||||||
|
|
||||||
{- The Key specified by the --key and --backend parameters. -}
|
{- The Key specified by the --key parameter. -}
|
||||||
cmdlineKey :: Annex Key
|
cmdlineKey :: Annex Key
|
||||||
cmdlineKey = do
|
cmdlineKey = do
|
||||||
k <- Annex.getState Annex.defaultkey
|
k <- Annex.getState Annex.defaultkey
|
||||||
backends <- Backend.list
|
case k of
|
||||||
return $ stubKey {
|
Nothing -> nokey
|
||||||
keyName = kname k,
|
Just "" -> nokey
|
||||||
keyBackendName = BackendClass.name $ head backends
|
Just kstring -> case readKey kstring of
|
||||||
}
|
Nothing -> error "bad key"
|
||||||
|
Just key -> return key
|
||||||
where
|
where
|
||||||
kname Nothing = badkey
|
nokey = error "please specify the key with --key"
|
||||||
kname (Just "") = badkey
|
|
||||||
kname (Just n) = n
|
|
||||||
badkey = error "please specify the key with --key"
|
|
||||||
|
|
||||||
{- Given an original list of files, and an expanded list derived from it,
|
{- Given an original list of files, and an expanded list derived from it,
|
||||||
- ensures that the original list's ordering is preserved.
|
- ensures that the original list's ordering is preserved.
|
||||||
|
|
Loading…
Reference in a new issue