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
|
{- git-annex assistant webapp form utilities
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module Assistant.WebApp.Form where
import Assistant.WebApp.Types
import Assistant.Gpg
import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F
import Yesod.Form.Bootstrap3 as Y hiding (bfs)
import Data.Text (Text)
{- Yesod's textField sets the required attribute for required fields.
- We don't want this, because many of the forms used in this webapp
- display a modal dialog when submitted, which interacts badly with
- required field handling by the browser.
-
- Required fields are still checked by Yesod.
-}
textField :: MkField Text
textField = F.textField
{ fieldView = \theId name attrs val _isReq -> [whamlet|
<input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}">
|]
}
readonlyTextField :: MkField Text
readonlyTextField = F.textField
{ fieldView = \theId name attrs val _isReq -> [whamlet|
<input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}" readonly="true">
|]
}
{- Also without required attribute. -}
passwordField :: MkField Text
passwordField = F.passwordField
{ fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
<input id="#{theId}" name="#{name}" *{attrs} type="password" value="#{either id id val}">
|]
}
{- Makes a note widget be displayed after a field. -}
withNote :: (ToWidget (HandlerSite m) a) => Field m v -> a -> Field m v
withNote field note = field { fieldView = newview }
where
newview theId name attrs val isReq =
let fieldwidget = (fieldView field) theId name attrs val isReq
in [whamlet|^{fieldwidget} <span>^{note}</span>|]
{- Note that the toggle string must be unique on the form. -}
withExpandableNote :: (ToWidget (HandlerSite m) w) => Field m v -> (String, w) -> Field m v
withExpandableNote field (toggle, note) = withNote field $ [whamlet|
<a .btn .btn-default data-toggle="collapse" data-target="##{ident}">#{toggle}</a>
<div ##{ident} .collapse>
^{note}
|]
where
ident = "toggle_" ++ toggle
{- Adds a check box to an AForm to control encryption. -}
#if MIN_VERSION_yesod_core(1,6,0)
enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerFor site) EnableEncryption
#else
enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT site IO) EnableEncryption
#endif
enableEncryptionField = areq (selectFieldList choices) (bfs "Encryption") (Just SharedEncryption)
where
choices :: [(Text, EnableEncryption)]
choices =
[ ("Encrypt all data", SharedEncryption)
, ("Disable encryption", NoEncryption)
]
{- Defines the layout used by the Bootstrap3 form helper -}
bootstrapFormLayout :: BootstrapFormLayout
bootstrapFormLayout = BootstrapHorizontalForm (ColSm 0) (ColSm 2) (ColSm 0) (ColSm 10)
{- Adds the form-control class used by Bootstrap3 for layout to a field
- This is the same as Yesod.Form.Bootstrap3.bfs except it takes just a Text
- parameter as I couldn't get the original bfs to compile due to type ambiguities.
-}
bfs :: Text -> FieldSettings master
bfs msg = FieldSettings
{ fsLabel = SomeMessage msg
, fsName = Nothing
, fsId = Nothing
, fsAttrs = [("class", "form-control")]
, fsTooltip = Nothing
}
|
