new fromkey subcommand, for registering urls, etc

had to redo Annex monad's flag storage

Annex.hs

@@ -10,10 +10,12 @@ module Annex (
 	supportedBackends,
 	flagIsSet,
 	flagChange,
+	flagGet,
 	Flag(..)
 ) where
 
 import Control.Monad.State
+import qualified Data.Map as M
 
 import qualified GitRepo as Git
 import Types
@@ -27,7 +29,7 @@ new gitrepo allbackends = do
 		Internals.repo = gitrepo,
 		Internals.backends = [],
 		Internals.supportedBackends = allbackends,
-		Internals.flags = []
+		Internals.flags = M.empty
 	}
 	(_,s') <- Annex.run s (prep gitrepo)
 	return s'
@@ -63,15 +65,20 @@ supportedBackends :: Annex [Backend]
 supportedBackends = do
 	state <- get
 	return (Internals.supportedBackends state)
-flagIsSet :: Flag -> Annex Bool
-flagIsSet flag = do
+flagIsSet :: FlagName -> Annex Bool
+flagIsSet name = do
 	state <- get
-	return $ elem flag $ Internals.flags state
-flagChange :: Flag -> Bool -> Annex ()
-flagChange flag set = do
+	case (M.lookup name $ Internals.flags state) of
+		Just (FlagBool True) -> return True
+		_ -> return False 
+flagChange :: FlagName -> Flag -> Annex ()
+flagChange name val = do
 	state <- get
-	let f = filter (/= flag) $ Internals.flags state
-	if (set)
-		then put state { Internals.flags = (flag:f) }
-		else put state { Internals.flags = f }
+	put state { Internals.flags = M.insert name val $ Internals.flags state }
 	return ()
+flagGet :: FlagName -> Annex String
+flagGet name = do
+	state <- get
+	case (M.lookup name $ Internals.flags state) of
+		Just (FlagString s) -> return s
+		_ -> return ""

Backend.hs

@@ -14,6 +14,7 @@
  - -}
 
 module Backend (
+	list,
 	storeFileKey,
 	retrieveKeyFile,
 	removeKey,
@@ -36,24 +37,28 @@ import Types
 import qualified TypeInternals as Internals
 
 {- List of backends in the order to try them when storing a new key. -}
-backendList :: Annex [Backend]
-backendList = do
-	l <- Annex.backends
+list :: Annex [Backend]
+list = do
+	l <- Annex.backends -- list is cached here
 	if (0 < length l)
 		then return l
 		else do
 			all <- Annex.supportedBackends
 			g <- Annex.gitRepo
 			let l = parseBackendList all $ Git.configGet g "annex.backends" ""
-			Annex.backendsChange l
-			return l
+			backendflag <- Annex.flagGet "backend"
+			let l' = if (0 < length backendflag)
+				then (lookupBackendName all backendflag):l
+				else l
+			Annex.backendsChange $ l'
+			return l'
 	where
 		parseBackendList all s = 
 			if (length s == 0)
 				then all
 				else map (lookupBackendName all) $ words s
 
-{- Looks up a backend in the list of supportedBackends -}
+{- Looks up a backend in a list -}
 lookupBackendName :: [Backend] -> String -> Backend
 lookupBackendName all s =
 	if ((length matches) /= 1)
@@ -66,7 +71,7 @@ storeFileKey :: FilePath -> Annex (Maybe (Key, Backend))
 storeFileKey file = do
 	g <- Annex.gitRepo
 	let relfile = Git.relative g file
-	b <- backendList
+	b <- list
 	storeFileKey' b file relfile
 storeFileKey' [] _ _ = return Nothing
 storeFileKey' (b:bs) file relfile = do

Backend/File.hs

@@ -107,7 +107,7 @@ showTriedRemotes remotes =
  - error if not. -}
 checkRemoveKey :: Key -> Annex (Bool)
 checkRemoveKey key = do
-	force <- Annex.flagIsSet Force
+	force <- Annex.flagIsSet "force"
 	if (force)
 		then return True
 		else do

Commands.hs

@@ -8,6 +8,7 @@ import System.Posix.Files
 import System.Directory
 import System.Path
 import Data.String.Utils
+import Control.Monad (filterM)
 import List
 import IO
 
@@ -23,7 +24,8 @@ import Core
 import qualified Remotes
 import qualified TypeInternals
 
-data CmdWants = FilesInGit | FilesNotInGit | RepoName | SingleString
+data CmdWants = FilesInGit | FilesNotInGit | FilesMissing | 
+		RepoName | Description
 data Command = Command {
 	cmdname :: String,
 	cmdaction :: (String -> Annex ()),
@@ -41,26 +43,49 @@ cmds =  [
 		"indicate content of files not currently wanted")
 	, (Command "unannex"	unannexCmd	FilesInGit
 		"undo accidential add command")
-	, (Command "init"	initCmd		SingleString
+	, (Command "init"	initCmd		Description
 		"initialize git-annex with repository description")
 	, (Command "fix"	fixCmd		FilesInGit
 		"fix up files' symlinks to point to annexed content")
+	, (Command "fromkey"	fromKeyCmd	FilesMissing
+		"adds a file using a specific key")
 	]
 
+-- Each dashed command-line option results in generation of an action
+-- in the Annex monad that performs the necessary setting.
+options :: [OptDescr (Annex ())]
 options = [
-	    Option ['f'] ["force"] (NoArg Force) "allow actions that may lose annexed data"
+	    Option ['f'] ["force"] 
+		(NoArg (Annex.flagChange "force" $ FlagBool True))
+		"allow actions that may lose annexed data"
+	  , Option ['b'] ["backend"]
+		(ReqArg (\s -> Annex.flagChange "backend" $ FlagString s) "NAME")
+		"specify default key-value backend to use"
+	  , Option ['k'] ["key"]
+		(ReqArg (\s -> Annex.flagChange "key" $ FlagString s) "KEY")
+		"specify a key to use"
 	  ]
 
-header = "Usage: git-annex " ++ (join "|" $ map cmdname cmds) ++ " [path ...]"
+header = "Usage: git-annex " ++ (join "|" $ map cmdname cmds)
 
+usage :: String
 usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs
 	where
 		cmddescs = unlines $ map (\c -> indent $ showcmd c) cmds
 		showcmd c =
 			(cmdname c) ++
-			(take (10 - (length (cmdname c))) $ repeat ' ') ++ 
+			(pad 10 (cmdname c)) ++
+			(descWanted (cmdwants c)) ++
+			(pad 13 (descWanted (cmdwants c))) ++
 			(cmddesc c)
 		indent l = "  " ++ l
+		pad n s = take (n - (length s)) $ repeat ' '
+
+{- Generate descrioptions of wanted parameters for subcommands. -}
+descWanted :: CmdWants -> String
+descWanted Description = "DESCRIPTION"
+descWanted RepoName = "REPO"
+descWanted _ = "PATH ..."
 
 {- Finds the type of parameters a command wants, from among the passed
  - parameter list. -}
@@ -71,14 +96,23 @@ findWanted FilesNotInGit params repo = do
 findWanted FilesInGit params repo = do
 	files <- mapM (Git.inRepo repo) params
 	return $ foldl (++) [] files
-findWanted SingleString params _ = do
+findWanted FilesMissing params repo = do
+	files <- liftIO $ filterM missing params
+	return $ files
+	where
+		missing f = do
+			e <- doesFileExist f
+			if (e) then return False else return True
+findWanted Description params _ = do
 	return $ [unwords params]
 findWanted RepoName params _ = do
 	return $ params
 
-{- Parses command line and returns a list of flags and a list of
- - actions to be run in the Annex monad. -}
-parseCmd :: [String] -> AnnexState -> IO ([Flag], [Annex ()])
+{- Parses command line and returns two lists of actions to be 
+ - run in the Annex monad. The first actions configure it
+ - according to command line options, while the second actions
+ - handle subcommands. -}
+parseCmd :: [String] -> AnnexState -> IO ([Annex ()], [Annex ()])
 parseCmd argv state = do
 	(flags, params) <- getopt
 	case (length params) of
@@ -100,7 +134,7 @@ parseCmd argv state = do
 {- Annexes a file, storing it in a backend, and then moving it into
  - the annex directory and setting up the symlink pointing to its content. -}
 addCmd :: FilePath -> Annex ()
-addCmd file = inBackend file $ do
+addCmd file = notInBackend file $ do
 	s <- liftIO $ getSymbolicLinkStatus file
 	if ((isSymbolicLink s) || (not $ isRegularFile s))
 		then return ()
@@ -125,9 +159,9 @@ addCmd file = inBackend file $ do
 
 {- Undo addCmd. -}
 unannexCmd :: FilePath -> Annex ()
-unannexCmd file = notinBackend file $ \(key, backend) -> do
+unannexCmd file = inBackend file $ \(key, backend) -> do
 	showStart "unannex" file
-	Annex.flagChange Force True -- force backend to always remove
+	Annex.flagChange "force" $ FlagBool True -- force backend to always remove
 	Backend.removeKey backend key
 	logStatus key ValueMissing
 	g <- Annex.gitRepo
@@ -145,7 +179,7 @@ unannexCmd file = notinBackend file $ \(key, backend) -> do
 
 {- Gets an annexed file from one of the backends. -}
 getCmd :: FilePath -> Annex ()
-getCmd file = notinBackend file $ \(key, backend) -> do
+getCmd file = inBackend file $ \(key, backend) -> do
 	inannex <- inAnnex key
 	if (inannex)
 		then return ()
@@ -167,7 +201,7 @@ getCmd file = notinBackend file $ \(key, backend) -> do
 {- Indicates a file's content is not wanted anymore, and should be removed
  - if it's safe to do so. -}
 dropCmd :: FilePath -> Annex ()
-dropCmd file = notinBackend file $ \(key, backend) -> do
+dropCmd file = inBackend file $ \(key, backend) -> do
 	inbackend <- Backend.hasKey key
 	if (not inbackend)
 		then return () -- no-op
@@ -192,8 +226,8 @@ dropCmd file = notinBackend file $ \(key, backend) -> do
 				else return ()
 
 {- Fixes the symlink to an annexed file. -}
-fixCmd :: String -> Annex ()
-fixCmd file = notinBackend file $ \(key, backend) -> do
+fixCmd :: FilePath -> Annex ()
+fixCmd file = inBackend file $ \(key, backend) -> do
 	link <- calcGitLink file key
 	l <- liftIO $ readSymbolicLink file
 	if (link == l)
@@ -223,13 +257,36 @@ initCmd description = do
 			liftIO $ Git.run g ["commit", "-m", "git annex init", log]
 			liftIO $ putStrLn "description set"
 
+{- Adds a file pointing at a manually-specified key -}
+fromKeyCmd :: FilePath -> Annex ()
+fromKeyCmd file = do
+	keyname <- Annex.flagGet "key"
+	if (0 == length keyname)
+		then error "please specify the key with --key"
+		else return ()
+	backends <- Backend.list
+	let key = genKey (backends !! 0) keyname
+
+	inbackend <- Backend.hasKey key
+	if (not inbackend)
+		then error $ "key ("++keyname++") is not present in backend"
+		else return ()
+
+	link <- calcGitLink file key
+	showStart "fromkey" file
+	liftIO $ createDirectoryIfMissing True (parentDir file)
+	liftIO $ createSymbolicLink link file
+	g <- Annex.gitRepo
+	liftIO $ Git.run g ["add", file]
+	showEndOk
+
 -- helpers
-inBackend file a = do
+notInBackend file a = do
 	r <- Backend.lookupFile file
 	case (r) of
 		Just v -> return ()
 		Nothing -> a
-notinBackend file a = do
+inBackend file a = do
 	r <- Backend.lookupFile file
 	case (r) of
 		Just v -> a v

Core.hs

@@ -18,9 +18,8 @@ import qualified Annex
 import Utility
 			
 {- Sets up a git repo for git-annex. -}
-startup :: [Flag] -> Annex ()
-startup flags = do
-	mapM (\f -> Annex.flagChange f True) flags
+startup :: Annex ()
+startup = do
 	g <- Annex.gitRepo
 	liftIO $ gitAttributes g
 	prepUUID

Makefile

@@ -20,7 +20,7 @@ docs:
 	./mdwn2man git-annex 1 doc/git-annex.mdwn > git-annex.1
 	$(IKIWIKI) doc html -v --wikiname git-annex --plugin=goodstuff \
 		--no-usedirs --disable-plugin=openid --plugin=sidebar \
-		--underlaydir=/dev/null
+		--underlaydir=/dev/null --disable-plugin=shortcut
 
 clean:
 	rm -rf build git-annex git-annex.1

Remotes.hs

@@ -36,7 +36,7 @@ withKey key = do
 	-- mounted at their location). So unless it happens to find all
 	-- remotes, try harder, loading the remotes' configs.
 	remotes <- reposByUUID allremotes uuids
-	remotesread <- Annex.flagIsSet RemotesRead
+	remotesread <- Annex.flagIsSet "remotesread"
 	if ((length allremotes /= length remotes) && not remotesread)
 		then tryharder allremotes uuids
 		else return remotes
@@ -46,7 +46,7 @@ withKey key = do
 			eitherremotes <- mapM tryGitConfigRead allremotes
 			let allremotes' = map fromEither eitherremotes
 			remotes' <- reposByUUID allremotes' uuids
-			Annex.flagChange RemotesRead True
+			Annex.flagChange "remotesread" $ FlagBool True
 			return remotes'
 
 {- Cost Ordered list of remotes. -}

TypeInternals.hs

@@ -7,12 +7,15 @@ module TypeInternals where
 
 import Control.Monad.State (StateT)
 import Data.String.Utils
+import qualified Data.Map as M
 
 import qualified GitRepo as Git
 
-data Flag = 
-	Force |		-- command-line flags
-	RemotesRead	-- indicates that remote repo configs have been read
+-- command-line flags
+type FlagName = String
+data Flag =
+	FlagBool Bool |
+	FlagString String
 		deriving (Eq, Read, Show)
 
 -- git-annex's runtime state type doesn't really belong here,
@@ -21,7 +24,7 @@ data AnnexState = AnnexState {
 	repo :: Git.Repo,
 	backends :: [Backend],
 	supportedBackends :: [Backend],
-	flags :: [Flag]
+	flags :: M.Map FlagName Flag
 } deriving (Show)
 
 -- git-annex's monad
@@ -32,6 +35,10 @@ type KeyFrag = String
 type BackendName = String
 data Key = Key (BackendName, KeyFrag) deriving (Eq)
 
+-- constructs a key in a backend
+genKey :: Backend -> KeyFrag -> Key
+genKey b f = Key (name b,f)
+
 -- show a key to convert it to a string; the string includes the
 -- name of the backend to avoid collisions between key strings
 instance Show Key where
@@ -48,10 +55,6 @@ instance Read Key where
 backendName :: Key -> BackendName
 backendName (Key (b,k)) = b
 
--- pulls the key fragment out
-keyFrag :: Key -> KeyFrag
-keyFrag (Key (b,k)) = k
-
 -- this structure represents a key-value backend
 data Backend = Backend {
 	-- name of this backend

Types.hs

@@ -5,9 +5,10 @@ module Types (
 	AnnexState,
 	Backend,
 	Key,
+	genKey,
 	backendName,
-	keyFrag,
-	Flag(..),
+	FlagName,
+	Flag(..)
 ) where
 
 import TypeInternals

doc/bugs/using_url_backend.mdwn

@@ -7,3 +7,5 @@ For now, we have to manually make the symlink. Something like this:
 Note the escaping of slashes.
 
 A `git annex register <url>` command could do this..
+
+[[done]]

doc/git-annex.mdwn

@@ -4,7 +4,7 @@ git-annex - manage files with git, without checking their contents in
 
 # SYNOPSIS
 
-git annex subcommand [path ...]
+git annex subcommand [params ...]
 
 # DESCRIPTION
 
@@ -97,6 +97,16 @@ Many git-annex subcommands will stage changes for later `git commit` by you.
   Fixes up symlinks that have become broken to again point to annexed content.
   This is useful to run if you have been moving the symlinks around.
 
+* fromkey file
+
+  This can be used to maually set up a file to link to a specified key
+  in the key-value backend. How you determine an existing key in the backend
+  varies. For the URL backend, the key is just a URL to the content.
+
+  Example:
+
+	git annex fromkey --backend=URL --key=http://www.archive.org/somefile somefile
+
 # OPTIONS
 
 * --force
@@ -104,6 +114,15 @@ Many git-annex subcommands will stage changes for later `git commit` by you.
   Force unsafe actions, such as dropping a file's content when no other
   source of it can be verified to still exist. Use with care.
 
+* --backend=name
+
+  Specify the default key-value backend to use, adding it to the front
+  of the list normally configured by `annex.backends`.
+
+* --key=name
+
+  Specifies a key to operate on, for use with the addkey subcommand.
+
 ## CONFIGURATION
 
 Like other git commands, git-annex is configured via `.git/config`.

doc/walkthrough.mdwn

@@ -1,3 +1,7 @@
+A walkthrough of the basic features of git-annex.
+
+[[!toc]]
+
 ## creating a repository
 
 This is very straightforward. Just tell it a description of the repository.
@@ -130,3 +134,30 @@ Here you might --force it to drop `important_file` if you trust your backup.
 But `other.iso` looks to have never been copied to anywhere else, so if
 it's something you want to hold onto, you'd need to transfer it to
 some other repository before dropping it.
+
+## using other backends: manually adding a remote URL
+
+git-annex has multiple key-value [[backends]]. So far this walkthrough has
+demonstrated the default, WORM (Write Once, Read Many) backend. 
+
+Another handy backend is the URL backend, which can fetch file's content
+from remote URLs. Here's how to set up some files in your repository
+that use this backend:
+
+	# git annex fromkey --backend=URL --key=http://www.archive.org/somefile somefile
+	add somefile ok
+	# git commit -m "added a file from the Internet Archive"
+
+Now you if you ask git-annex to get that file, it will download it, 
+and cache it locally, until you have it drop it.
+
+	# git annex get somefile
+	get somefile (downloading)
+	#########################################################################100.0%
+	 ok
+
+You can always drop files downloaded by the URL backend. It is assumed
+that the URL is stable; no local backup is kept.
+
+	# git annex drop somefile
+	drop somefile (ok)

git-annex.hs

@@ -15,8 +15,8 @@ main = do
 	args <- getArgs
 	gitrepo <- Git.repoFromCwd
 	state <- Annex.new gitrepo allBackends
-	(flags, actions) <- parseCmd args state
-	tryRun state $ [startup flags] ++ actions ++ [shutdown]
+	(configure, actions) <- parseCmd args state
+	tryRun state $ [startup] ++ configure ++ actions ++ [shutdown]
 
 {- Runs a list of Annex actions. Catches IO errors and continues
  - (but explicitly thrown errors terminate the whole command).