aboutsummaryrefslogtreecommitdiff
path: root/Annex/FileMatcher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-25 23:44:55 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-25 23:44:55 -0400
commit9831bc36f7981da230c9dbf3704377b3bf74f50f (patch)
tree021e13e365a1ad56e4b621a571f52e111b8b45b3 /Annex/FileMatcher.hs
parent62a272b330550a5db4836fd8104ca4b6a2032e39 (diff)
per-IA-item content directories
Diffstat (limited to 'Annex/FileMatcher.hs')
-rw-r--r--Annex/FileMatcher.hs26
1 files changed, 20 insertions, 6 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