refactor magic

Annex/FileMatcher.hs

@@ -30,13 +30,9 @@ import Types.FileMatcher
 import Git.FilePath
 import Types.Remote (RemoteConfig)
 import Annex.CheckAttr
+import Annex.Magic
 import Git.CheckAttr (unspecifiedAttr)
 
-#ifdef WITH_MAGICMIME
-import Magic
-import Utility.Env
-#endif
-
 import Data.Either
 import qualified Data.Set as S
 
@@ -139,15 +135,7 @@ preferredContentParser matchstandard matchgroupwanted getgroupmap configmap mu e
 
 mkLargeFilesParser :: Annex (String -> [ParseResult])
 mkLargeFilesParser = do
-#ifdef WITH_MAGICMIME
+	magicmime <- liftIO initMagicMimeType
-	magicmime <- liftIO $ catchMaybeIO $ do
-		m <- magicOpen [MagicMimeType]
-		liftIO $ getEnv "GIT_ANNEX_DIR" >>= \case
-			Nothing -> magicLoadDefault m
-			Just d -> magicLoad m
-				(d </> "magic" </> "magic.mgc")
-		return m
-#endif
 	let parse = parseToken $ commonTokens
 #ifdef WITH_MAGICMIME
 		++ [ ValueToken "mimetype" (usev $ matchMagic magicmime) ]

Annex/Magic.hs

@@ -0,0 +1,45 @@
+{- Interface to libmagic
+ -
+ - Copyright 2019 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.Magic (
+	Magic,
+	MimeType,
+	initMagicMimeType,
+	getMagicMimeType,
+) where
+
+#ifdef WITH_MAGICMIME
+import Magic
+import Utility.Env
+import Common
+#else
+type Magic = ()
+#endif
+
+initMagicMimeType :: IO (Maybe Magic)
+#ifdef WITH_MAGICMIME
+initMagicMimeType = catchMaybeIO $ do
+	m <- magicOpen [MagicMimeType]
+	liftIO $ getEnv "GIT_ANNEX_DIR" >>= \case
+		Nothing -> magicLoadDefault m
+		Just d -> magicLoad m
+			(d </> "magic" </> "magic.mgc")
+	return m
+#else
+mkMagic = return Nothing
+#endif
+
+type MimeType = String
+
+getMagicMimeType :: Magic -> FilePath -> IO (Maybe MimeType)
+#ifdef WITH_MAGICMIME
+getMagicMimeType m f = Just <$> magicFile m f
+#else
+getMagicMimeType = return Nothing
+#endif

Limit.hs

@@ -5,8 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE CPP #-}
-
 module Limit where
 
 import Annex.Common
@@ -17,6 +15,7 @@ import Annex.Content
 import Annex.WorkTree
 import Annex.Action
 import Annex.UUID
+import Annex.Magic
 import Logs.Trust
 import Annex.NumCopies
 import Types.Key
@@ -34,10 +33,6 @@ import Utility.Glob
 import Utility.HumanTime
 import Utility.DataUnits
 
-#ifdef WITH_MAGICMIME
-import Magic
-#endif
-
 import Data.Time.Clock.POSIX
 import qualified Data.Set as S
 import qualified Data.Map as M
@@ -99,17 +94,16 @@ matchGlobFile glob = go
 	go (MatchingKey _ (AssociatedFile Nothing)) = pure False
 	go (MatchingKey _ (AssociatedFile (Just af))) = pure $ matchGlob cglob af
 
-#ifdef WITH_MAGICMIME
 matchMagic :: Maybe Magic -> MkLimit Annex
 matchMagic (Just magic) glob = Right $ const go
   where
  	cglob = compileGlob glob CaseSensative -- memoized
 	go (MatchingKey _ _) = pure False
 	go (MatchingFile fi) = liftIO $ catchBoolIO $
-		matchGlob cglob <$> magicFile magic (currFile fi)
+		maybe False (matchGlob cglob)
+			<$> getMagicMimeType magic (currFile fi)
 	go (MatchingInfo _ _ _ mimeval) = matchGlob cglob <$> getInfo mimeval
 matchMagic Nothing _ = Left "unable to load magic database; \"mimetype\" cannot be used"
-#endif
 
 {- Adds a limit to skip files not believed to be present
  - in a specfied repository. Optionally on a prior date. -}

git-annex.cabal

@@ -631,6 +631,7 @@ Executable git-annex
     Annex.LockFile
     Annex.LockPool
     Annex.LockPool.PosixOrPid
+    Annex.Magic
     Annex.MetaData
     Annex.MetaData.StandardFields
     Annex.Multicast