Added --mimetype and --mimeencoding file matching options.

Already had these for largefiles matching, but I forgot to add them as
command-line options.

Annex/Magic.hs

@@ -17,6 +17,7 @@ module Annex.Magic (
 ) where
 
 import Types.Mime
+import Control.Monad.IO.Class
 #ifdef WITH_MAGICMIME
 import Magic
 import Utility.Env
@@ -52,8 +53,8 @@ getMagicMime m f = Just . parse <$> magicFile m f
 getMagicMime _ _ = return Nothing
 #endif
 
-getMagicMimeType :: Magic -> FilePath -> IO (Maybe MimeType)
+getMagicMimeType :: MonadIO m => Magic -> FilePath -> m (Maybe MimeType)
-getMagicMimeType m f = fmap fst <$> getMagicMime m f
+getMagicMimeType m f = liftIO $ fmap fst <$> getMagicMime m f
 
-getMagicMimeEncoding :: Magic -> FilePath -> IO (Maybe MimeEncoding)
+getMagicMimeEncoding :: MonadIO m => Magic -> FilePath -> m(Maybe MimeEncoding)
-getMagicMimeEncoding m f = fmap snd <$> getMagicMime m f
+getMagicMimeEncoding m f = liftIO $ fmap snd <$> getMagicMime m f

CHANGELOG

@@ -1,3 +1,9 @@
+git-annex (7.20190913) UNRELEASED; urgency=medium
+
+  * Added --mimetype and --mimeencoding file matching options.
+
+ -- Joey Hess <id@joeyh.name>  Thu, 19 Sep 2019 11:11:19 -0400
+
 git-annex (7.20190912) upstream; urgency=medium
 
   * Default to v7 for new repositories.

CmdLine/GitAnnex/Options.hs

@@ -282,6 +282,16 @@ keyMatchingOptions' =
 		<> help "match files accessed within a time interval"
 		<> hidden
 		)
+	, globalSetter Limit.addMimeType $ strOption
+		( long "mimetype" <> metavar paramGlob
+		<> help "match files by mime type"
+		<> hidden
+		)
+	, globalSetter Limit.addMimeEncoding $ strOption
+		( long "mimeencoding" <> metavar paramGlob
+		<> help "match files by mime encoding"
+		<> hidden
+		)
 	]
 
 -- Options to match files which may not yet be annexed.

Limit.hs

@@ -1,6 +1,6 @@
 {- user-specified limits on files to act on
  -
- - Copyright 2011-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -16,6 +16,7 @@ import Annex.WorkTree
 import Annex.Action
 import Annex.UUID
 import Annex.Magic
+import Annex.Link
 import Logs.Trust
 import Annex.NumCopies
 import Types.Key
@@ -94,12 +95,33 @@ matchGlobFile glob = go
 	go (MatchingKey _ (AssociatedFile Nothing)) = pure False
 	go (MatchingKey _ (AssociatedFile (Just af))) = pure $ matchGlob cglob af
 
-matchMagic :: String -> (Magic -> FilePath -> IO (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> Maybe Magic -> MkLimit Annex
+addMimeType :: String -> Annex ()
+addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType
+
+addMimeEncoding :: String -> Annex ()
+addMimeEncoding = addMagicLimit "mimeencoding" getMagicMimeEncoding providedMimeEncoding
+
+addMagicLimit :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> String -> Annex ()
+addMagicLimit limitname querymagic selectprovidedinfo glob = do
+	magic <- liftIO initMagicMime
+	addLimit $ matchMagic limitname querymagic' selectprovidedinfo magic glob
+  where
+	querymagic' magic f = liftIO (isPointerFile f) >>= \case
+		-- Avoid getting magic of a pointer file, which would
+		-- wrongly be detected as text.
+		Just _ -> return Nothing
+		-- When the file is an annex symlink, get magic of the
+		-- object file.
+		Nothing -> isAnnexLink f >>= \case
+			Just k -> withObjectLoc k $ querymagic magic
+			Nothing -> querymagic magic f
+
+matchMagic :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> Maybe Magic -> MkLimit Annex
 matchMagic _limitname querymagic selectprovidedinfo (Just magic) glob = Right $ const go
   where
  	cglob = compileGlob glob CaseSensative -- memoized
 	go (MatchingKey _ _) = pure False
-	go (MatchingFile fi) = liftIO $ catchBoolIO $
+	go (MatchingFile fi) = catchBoolIO $
 		maybe False (matchGlob cglob)
 			<$> querymagic magic (currFile fi)
 	go (MatchingInfo p) =

doc/git-annex-matching-options.mdwn

@@ -159,6 +159,35 @@ in either of two repositories.
   If the OS or filesystem does not support access times, this will not
   match any files.
 
+* `--mimetype=glob`
+
+  Looks up the MIME type of a file, and checks if the glob matches it.
+
+  For example, `--mimetype="text/*"` will match many varieties of text files,
+  including "text/plain", but also "text/x-shellscript", "text/x-makefile",
+  etc.
+
+  The MIME types are the same that are displayed by running `file --mime-type`
+
+  If the file's annexed content is not present, the file will not match.
+
+  This is only available to use when git-annex was built with the
+  MagicMime build flag.
+
+* `--mimeencoding=glob`
+
+  Looks up the MIME encoding of a file, and checks if the glob matches it.
+
+  For example, `--mimeencoding=binary` will match many kinds of binary
+  files.
+
+  The MIME encodings are the same that are displayed by running `file --mime-encoding`
+
+  If the file's annexed content is not present, the file will not match.
+
+  This is only available to use when git-annex was built with the
+  MagicMime build flag.
+
 * `--not`
 
   Inverts the next matching option. For example, to only act on