blob: 7b9662c958cb458269a927aae38321be351d641d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
{- git-annex remote config types
-
- Copyright 2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE GADTs #-}
module Types.RemoteConfig where
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Typeable
import Types.ProposedAccepted
type RemoteConfigField = ProposedAccepted String
{- What the user provides to configure the remote, and what is stored for
- later; a bunch of fields and values. -}
type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
{- Before being used a RemoteConfig has to be parsed. -}
data ParsedRemoteConfig = ParsedRemoteConfig
{ parsedRemoteConfigMap :: M.Map RemoteConfigField RemoteConfigValue
, unparsedRemoteConfig :: RemoteConfig
}
{- Remotes can have configuration values of many types, so use Typeable
- to let them all be stored in here. -}
data RemoteConfigValue where
RemoteConfigValue :: Typeable v => v -> RemoteConfigValue
{- Parse a field's value provided by the user into a RemoteConfigValue.
-
- The RemoteConfig is provided to the parser function for cases
- where multiple fields need to be looked at. However, it's important
- that, when a parser looks at an additional field in that way, the
- parser list contains a dedicated parser for that field as well.
- Presence of fields that are not included in this list will cause
- a parse failure.
-}
data RemoteConfigFieldParser = RemoteConfigFieldParser
{ parserForField :: RemoteConfigField
, valueParser :: Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue)
, fieldDesc :: FieldDesc
, valueDesc :: Maybe ValueDesc
}
data FieldDesc
= FieldDesc String
| HiddenField
newtype ValueDesc = ValueDesc String
data RemoteConfigParser = RemoteConfigParser
{ remoteConfigFieldParsers :: [RemoteConfigFieldParser]
, remoteConfigRestPassthrough :: Maybe (RemoteConfigField -> Bool, [(String, FieldDesc)])
}
mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> RemoteConfig -> m RemoteConfigParser
mkRemoteConfigParser l _ = pure (RemoteConfigParser l Nothing)
addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
addRemoteConfigParser l rpc = rpc
{ remoteConfigFieldParsers =
remoteConfigFieldParsers rpc ++ filter isnew l
}
where
s = S.fromList (map parserForField (remoteConfigFieldParsers rpc))
isnew p = not (S.member (parserForField p) s)
|
