per-IA-item content directories

6 files changed, 87 insertions, 44 deletions

diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index 220fea286..cbf6f873b 100644
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -14,9 +14,11 @@ import Limit
 import Utility.Matcher
 import Types.Group
 import Logs.Group
+import Logs.Remote
 import Annex.UUID
 import qualified Annex
 import Git.FilePath
+import Types.Remote (RemoteConfig)
 
 import Data.Either
 import qualified Data.Set as S
@@ -45,10 +47,22 @@ parsedToMatcher parsed = case partitionEithers parsed of
 	([], vs) -> Right $ generate vs
 	(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
 
-parseToken :: MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
-parseToken checkpresent groupmap t
+exprParser :: GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
+exprParser groupmap configmap mu expr =
+	map parse $ tokenizeMatcher expr
+  where
+	parse = parseToken 
+		(limitPresent mu)
+		(limitInDir preferreddir)
+		groupmap
+	preferreddir = fromMaybe "public" $
+		M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
+
+parseToken :: MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
+parseToken checkpresent checkpreferreddir groupmap t
 	| t `elem` tokens = Right $ token t
 	| t == "present" = use checkpresent
+	| t == "inpreferreddir" = use checkpreferreddir
 	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k $
 		M.fromList
 			[ ("include", limitInclude)
@@ -78,9 +92,9 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
   where
   	go Nothing = return matchAll
 	go (Just expr) = do
-		m <- groupMap
+		gm <- groupMap
+		rc <- readRemoteLog
 		u <- getUUID
-		either badexpr return $ parsedToMatcher $
-			map (parseToken (limitPresent $ Just u) m)
-				(tokenizeMatcher expr)
+		either badexpr return $
+			parsedToMatcher $ exprParser gm rc (Just u) expr
 	badexpr e = error $ "bad annex.largefiles configuration: " ++ e
diff --git a/Limit.hs b/Limit.hs
index 9ce9d591e..679ebc199 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -1,6 +1,6 @@
 {- user-specified limits on files to act on
  -
- - Copyright 2011,2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -88,9 +88,9 @@ limitExclude glob = Right $ const $ return . not . matchglob glob
  - once. Also, we use regex-TDFA because it's less buggy in its support
  - of non-unicode characters. -}
 matchglob :: String -> Annex.FileInfo -> Bool
-matchglob glob (Annex.FileInfo { Annex.matchFile = f }) =
+matchglob glob fi =
 	case cregex of
-		Right r -> case execute r f of
+		Right r -> case execute r (Annex.matchFile fi) of
 			Right (Just _) -> True
 			_ -> False
 		Left _ -> error $ "failed to compile regex: " ++ regex
@@ -138,6 +138,11 @@ limitPresent u _ = Right $ const $ check $ \key -> do
 	handle _ Nothing = return False
 	handle a (Just (key, _)) = a key
 
+{- Limit to content that is in a directory, anywhere in the repository tree -}
+limitInDir :: FilePath -> MkLimit
+limitInDir dir = const $ Right $ const $ \fi -> return $
+	any (== dir) $ splitPath $ takeDirectory $ Annex.matchFile fi
+
 {- Adds a limit to skip files not believed to have the specified number
  - of copies. -}
 addCopies :: String -> Annex ()
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index d980cd373..8005fc0d3 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -30,7 +30,9 @@ import qualified Utility.Matcher
 import Annex.FileMatcher
 import Annex.UUID
 import Types.Group
+import Types.Remote (RemoteConfig)
 import Logs.Group
+import Logs.Remote
 import Types.StandardGroups
 
 {- Filename of preferred-content.log. -}
@@ -65,8 +67,9 @@ preferredContentMap = maybe preferredContentMapLoad return
 preferredContentMapLoad :: Annex Annex.PreferredContentMap
 preferredContentMapLoad = do
 	groupmap <- groupMap
+	configmap <- readRemoteLog
 	m <- simpleMap
-		. parseLogWithUUID ((Just .) . makeMatcher groupmap)
+		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap)
 		<$> Annex.Branch.get preferredContentLog
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 	return m
@@ -79,30 +82,30 @@ preferredContentMapRaw = simpleMap . parseLog Just
  - because the configuration is shared amoung repositories and newer
  - versions of git-annex may add new features. Instead, parse errors
  - result in a Matcher that will always succeed. -}
-makeMatcher :: GroupMap -> UUID -> String -> FileMatcher
-makeMatcher groupmap u s
-	| s == "standard" = standardMatcher groupmap u
+makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> String -> FileMatcher
+makeMatcher groupmap configmap u expr
+	| expr == "standard" = standardMatcher groupmap configmap u
 	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
 	| otherwise = matchAll
   where
-	tokens = map (parseToken (limitPresent $ Just u) groupmap) (tokenizeMatcher s)
+	tokens = exprParser groupmap configmap (Just u) expr
 
 {- Standard matchers are pre-defined for some groups. If none is defined,
  - or a repository is in multiple groups with standard matchers, match all. -}
-standardMatcher :: GroupMap -> UUID -> FileMatcher
-standardMatcher m u = maybe matchAll (makeMatcher m u . preferredContent) $
-	getStandardGroup =<< u `M.lookup` groupsByUUID m
+standardMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> FileMatcher
+standardMatcher groupmap configmap u = 
+	maybe matchAll (makeMatcher groupmap configmap u . preferredContent) $
+		getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
 
 {- Checks if an expression can be parsed, if not returns Just error -}
 checkPreferredContentExpression :: String -> Maybe String
-checkPreferredContentExpression s
-	| s == "standard" = Nothing
-	| otherwise = case parsedToMatcher vs of
+checkPreferredContentExpression expr
+	| expr == "standard" = Nothing
+	| otherwise = case parsedToMatcher tokens of
 		Left e -> Just e
 		Right _ -> Nothing
   where
-	vs = map (parseToken (limitPresent Nothing) emptyGroupMap)
-		(tokenizeMatcher s)
+	tokens = exprParser emptyGroupMap M.empty Nothing expr
 
 {- Puts a UUID in a standard group, and sets its preferred content to use
  - the standard expression for that group, unless something is already set. -}
diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs
index 055dffe6e..e7764d387 100644
--- a/Types/StandardGroups.hs
+++ b/Types/StandardGroups.hs
@@ -7,6 +7,11 @@
 
 module Types.StandardGroups where
 
+import Types.Remote (RemoteConfig)
+
+import qualified Data.Map as M
+import Data.Maybe
+
 data StandardGroup
 	= ClientGroup
 	| TransferGroup
@@ -45,17 +50,25 @@ toStandardGroup "public" = Just PublicGroup
 toStandardGroup "unwanted" = Just UnwantedGroup
 toStandardGroup _ = Nothing
 
-descStandardGroup :: StandardGroup -> String
-descStandardGroup ClientGroup = "client: a repository on your computer"
-descStandardGroup TransferGroup = "transfer: distributes files to clients"
-descStandardGroup BackupGroup = "full backup: backs up all files"
-descStandardGroup IncrementalBackupGroup = "incremental backup: backs up files not backed up elsewhere"
-descStandardGroup SmallArchiveGroup = "small archive: archives files located in \"archive\" directories"
-descStandardGroup FullArchiveGroup = "full archive: archives all files not archived elsewhere"
-descStandardGroup SourceGroup = "file source: moves files on to other repositories"
-descStandardGroup ManualGroup = "manual mode: only stores files you manually choose"
-descStandardGroup PublicGroup = "public: only stores files located in \"public\" directories"
-descStandardGroup UnwantedGroup = "unwanted: remove content from this repository"
+descStandardGroup :: Maybe RemoteConfig -> StandardGroup -> String
+descStandardGroup _ ClientGroup = "client: a repository on your computer"
+descStandardGroup _ TransferGroup = "transfer: distributes files to clients"
+descStandardGroup _ BackupGroup = "full backup: backs up all files"
+descStandardGroup _ IncrementalBackupGroup = "incremental backup: backs up files not backed up elsewhere"
+descStandardGroup _ SmallArchiveGroup = "small archive: archives files located in \"archive\" directories"
+descStandardGroup _ FullArchiveGroup = "full archive: archives all files not archived elsewhere"
+descStandardGroup _ SourceGroup = "file source: moves files on to other repositories"
+descStandardGroup _ ManualGroup = "manual mode: only stores files you manually choose"
+descStandardGroup _ UnwantedGroup = "unwanted: remove content from this repository"
+descStandardGroup c PublicGroup = "public: only stores files located in \"" ++ fromJust (specialDirectory c PublicGroup) ++ "\" directories"
+
+specialDirectory :: Maybe RemoteConfig -> StandardGroup -> Maybe FilePath
+specialDirectory _ SmallArchiveGroup = Just "archive"
+specialDirectory _ FullArchiveGroup = Just "archive"
+specialDirectory (Just c) PublicGroup = Just $
+	fromMaybe "public" $ M.lookup "preferreddir" c
+specialDirectory Nothing PublicGroup = Just "public"
+specialDirectory _ _ = Nothing
 
 {- See doc/preferred_content.mdwn for explanations of these expressions. -}
 preferredContent :: StandardGroup -> String
@@ -71,7 +84,7 @@ preferredContent SmallArchiveGroup = lastResort $
 preferredContent FullArchiveGroup = lastResort notArchived
 preferredContent SourceGroup = "not (copies=1)"
 preferredContent ManualGroup = "present and (" ++ preferredContent ClientGroup ++ ")"
-preferredContent PublicGroup = "include=*/public/* or include=public/*"
+preferredContent PublicGroup = "inpreferreddir"
 preferredContent UnwantedGroup = "exclude=*"
 
 notArchived :: String
diff --git a/debian/changelog b/debian/changelog
index 322f58023..4dde2760b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -32,11 +32,12 @@ git-annex (4.20130418) UNRELEASED; urgency=low
   * initremote: If two existing remotes have the same name,
     prefer the one with a higher trust level.
   * Add public repository group.
+    (And inpreferreddir to preferred content expressions.)
   * webapp: Can now set up Internet Archive repositories.
   * S3: Dropping content from the Internet Archive doesn't work, but
     their API indicates it does. Always refuse to drop from there.
-  * webapp: Display some additional information about a repository on its edit
-    page.
+  * webapp: Display some additional information about a repository on
+    its edit page.
   * Automatically register public urls for files uploaded to the
     Internet Archive.
 
diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn
index de28d0729..23081fc30 100644
--- a/doc/preferred_content.mdwn
+++ b/doc/preferred_content.mdwn
@@ -72,14 +72,17 @@ Note that `not present` is a very bad thing to put in a preferred content
 expression. It'll make it prefer to get content that's not present, and
 drop content that is present! Don't go there..
 
-### difference: "inmydir"
+### difference: "inpreferreddir"
 
-There's a special "inmydir" keyword you can use in a preferred content
-expression of a special remote. This means that the content is preferred
-if it's in a directory (located anywhere in the tree) with a special name.
+There's a special "inpreferreddir" keyword you can use in a
+preferred content expression of a special remote. This means that the
+content is preferred if it's in a directory (located anywhere in the tree)
+with a special name.
 
 The name of the directory can be configured using 
-`git annex initremote $remote mydir=$dirname`
+`git annex initremote $remote preferreddir=$dirname`
+
+(If no directory name is configured, it uses "public" by default.)
 
 ## standard expressions
 
@@ -178,10 +181,14 @@ reached an archive repository.
 ### public
 
 This is used for publishing information to a repository that can be
-publically accessed. Only files inside `public` directories will be
-stored in a public repository.
+publically accessed. Only files in a directory with a particular name
+will be published. (The directory can be located anywhere in the
+repository.)
+
+The name of the directory can be configured using
+`git annex initremote $remote preferreddir=$dirname`
 
-`include=*/public/* or include=public/*`
+`inpreferreddir`
 
 ### unwanted