1{- git-annex file matcher types
2 -
3 - Copyright 2013-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Types.FileMatcher where
9
10import Types.UUID (UUID)
11import Types.Key (Key)
12import Types.Link (LinkType)
13import Types.Mime
14import Utility.Matcher (Matcher, Token)
15import Utility.FileSize
16import Utility.FileSystemEncoding
17
18import Control.Monad.IO.Class
19import qualified Data.Map as M
20import qualified Data.Set as S
21
22-- Information about a file and/or a key that can be matched on.
23data MatchInfo
24	= MatchingFile FileInfo
25	| MatchingInfo ProvidedInfo
26	| MatchingUserInfo UserProvidedInfo
27
28data FileInfo = FileInfo
29	{ contentFile :: RawFilePath
30	-- ^ path to a file containing the content, for operations
31	-- that examine it
32	, matchFile :: RawFilePath
33	-- ^ filepath to match on; may be relative to top of repo or cwd,
34	-- depending on how globs in preferred content expressions
35	-- are intended to be matched
36	, matchKey :: Maybe Key
37	-- ^ provided if a key is already known
38	}
39
40data ProvidedInfo = ProvidedInfo
41	{ providedFilePath :: Maybe RawFilePath
42	-- ^ filepath to match on, should not be accessed from disk.
43	, providedKey :: Maybe Key
44	, providedFileSize :: Maybe FileSize
45	, providedMimeType :: Maybe MimeType
46	, providedMimeEncoding :: Maybe MimeEncoding
47	, providedLinkType :: Maybe LinkType
48	}
49
50keyMatchInfoWithoutContent :: Key -> RawFilePath -> MatchInfo
51keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo
52	{ providedFilePath = Just file
53	, providedKey = Just key
54	, providedFileSize = Nothing
55	, providedMimeType = Nothing
56	, providedMimeEncoding = Nothing
57	, providedLinkType = Nothing
58	}
59
60-- This is used when testing a matcher, with values to match against
61-- provided by the user.
62data UserProvidedInfo = UserProvidedInfo
63	{ userProvidedFilePath :: UserInfo FilePath
64	, userProvidedKey :: UserInfo Key
65	, userProvidedFileSize :: UserInfo FileSize
66	, userProvidedMimeType :: UserInfo MimeType
67	, userProvidedMimeEncoding :: UserInfo MimeEncoding
68	}
69
70-- This may fail if the user did not provide the information.
71type UserInfo a = Either (IO a) a
72
73-- If the UserInfo is not available, accessing it may result in eg an
74-- exception being thrown.
75getUserInfo :: MonadIO m => UserInfo a -> m a
76getUserInfo (Right i) = return i
77getUserInfo (Left e) = liftIO e
78
79type FileMatcherMap a = M.Map UUID (FileMatcher a)
80
81type MkLimit a = String -> Either String (MatchFiles a)
82
83type AssumeNotPresent = S.Set UUID
84
85data MatchFiles a = MatchFiles
86	{ matchAction :: AssumeNotPresent -> MatchInfo -> a Bool
87	, matchNeedsFileName :: Bool
88	-- ^ does the matchAction need a filename in order to match?
89	, matchNeedsFileContent :: Bool
90	-- ^ does the matchAction need the file content to be present in
91	-- order to succeed?
92	, matchNeedsKey :: Bool
93	-- ^ does the matchAction look at information about the key?
94	, matchNeedsLocationLog :: Bool
95	-- ^ does the matchAction look at the location log?
96	}
97
98type FileMatcher a = Matcher (MatchFiles a)
99
100-- This is a matcher that can have tokens added to it while it's being
101-- built, and once complete is compiled to an unchangable matcher.
102data ExpandableMatcher a
103	= BuildingMatcher [Token (MatchFiles a)]
104	| CompleteMatcher (Matcher (MatchFiles a))
105