-
Notifications
You must be signed in to change notification settings - Fork 44
/
ContractSetupForm.purs
160 lines (140 loc) · 4.54 KB
/
ContractSetupForm.purs
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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
module Component.ContractSetupForm where
import Prologue
import Data.Address (Address)
import Data.AddressBook (AddressBook)
import Data.AddressBook as AddressBook
import Data.ContractNickname (ContractNickname)
import Data.ContractNickname as CN
import Data.ContractTimeout (ContractTimeout)
import Data.ContractTimeout as CT
import Data.ContractValue (ContractValue)
import Data.ContractValue as CV
import Data.Either (note)
import Data.Lens (Lens')
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Map as Map
import Data.Set (Set)
import Data.Set as Set
import Data.Validation.Semigroup (V(..))
import Data.WalletNickname as WN
import Effect.Aff.Class (class MonadAff)
import Forms (InputSlots)
import Forms as Forms
import Halogen as H
import Halogen.Form (Form, subform, useForm)
import Halogen.Form as Form
import Halogen.Hooks as Hooks
import Marlowe.Semantics (TokenName)
import Polyform.Validator (liftFnV)
import Type.Proxy (Proxy(..))
type Input =
{ roles :: Set TokenName
, timeouts :: Set String
, values :: Set String
, addressBook :: AddressBook
}
type ContractInput =
{ nickname :: String
, roles :: Map TokenName String
, timeouts :: Map String String
, values :: Map String String
}
_nickname :: Lens' ContractInput String
_nickname = prop (Proxy :: _ "nickname")
_roles :: Lens' ContractInput (Map TokenName String)
_roles = prop (Proxy :: _ "roles")
_timeouts :: Lens' ContractInput (Map String String)
_timeouts = prop (Proxy :: _ "timeouts")
_values :: Lens' ContractInput (Map String String)
_values = prop (Proxy :: _ "values")
data ContractParams =
ContractParams
ContractNickname
(Map TokenName Address)
(Map String ContractTimeout)
(Map String ContractValue)
derive instance Eq ContractParams
data Msg
= Back
| Next ContractParams
type Component q m =
H.Component q Input Msg m
contractNicknameForm
:: forall s m. Monad m => Form (InputSlots s) m String ContractNickname
contractNicknameForm =
Forms.input "contract-nickname" "Contract title" CN.validator case _ of
CN.Empty -> "Required."
roleAssignmentForm
:: forall s m
. Monad m
=> AddressBook
-> TokenName
-> Form (InputSlots s) m String Address
roleAssignmentForm addressBook roleName =
Forms.input ("role-input-" <> roleName) roleName validator case _ of
WN.Empty -> "Required."
WN.Exists -> "Already exists."
WN.DoesNotExist -> "Not found."
WN.ContainsNonAlphaNumeric -> "Can only contain letters and digits."
where
validator =
liftFnV $
V <<<
( note WN.DoesNotExist <<< flip AddressBook.lookupAddress addressBook
<=< WN.fromString
)
roleForms
:: forall s m
. Monad m
=> AddressBook
-> Form (InputSlots s) m (Map TokenName String) (Map TokenName Address)
roleForms addressBook =
Form.multiWithIndex $ roleAssignmentForm $ addressBook
timeoutForm
:: forall s m
. Monad m
=> String
-> Form (InputSlots s) m String ContractTimeout
timeoutForm name =
Forms.input ("slot-input-" <> name) name CT.validator case _ of
CT.Empty -> "Required."
CT.Past -> "Must be in the future."
CT.Invalid -> "Must be a number of slots from contract start."
valueForm
:: forall s m
. Monad m
=> String
-> Form (InputSlots s) m String ContractValue
valueForm name =
Forms.input ("value-input-" <> name) name CV.validator case _ of
CV.Empty -> "Required."
CV.Negative -> "Must by positive."
CV.Invalid -> "Must by a number."
mkForm
:: forall slots m
. Monad m
=> AddressBook
-> Form (InputSlots slots) m ContractInput ContractParams
mkForm addressBook =
ContractParams
<$> subform _nickname contractNicknameForm
<*> subform _roles (roleForms addressBook)
<*> subform _timeouts (Form.multiWithIndex timeoutForm)
<*> subform _values (Form.multiWithIndex valueForm)
initialFormInput :: Set TokenName -> Set String -> Set String -> ContractInput
initialFormInput roles timeouts values =
{ nickname: ""
, roles: Map.fromFoldable $ Set.map (flip Tuple "") roles
, timeouts: Map.fromFoldable $ Set.map (flip Tuple "") timeouts
, values: Map.fromFoldable $ Set.map (flip Tuple "") values
}
component :: forall q m. MonadAff m => Component q m
component = Hooks.component \{ outputToken } input -> Hooks.do
let { addressBook, roles, timeouts, values } = input
form <- Hooks.captures { addressBook } Hooks.useMemo \_ -> mkForm addressBook
{ result, html } <- useForm form (initialFormInput roles timeouts values)
let _back = Hooks.raise outputToken Back
let _next = Hooks.raise outputToken <<< Next <$> result
Hooks.pure do
html []