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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
<!doctype html>
<title>CodeMirror: Haskell-literate mode</title>
<meta charset="utf-8"/>
<link rel=stylesheet href="../../doc/docs.css">
<link rel="stylesheet" href="../../lib/codemirror.css">
<script src="../../lib/codemirror.js"></script>
<script src="haskell-literate.js"></script>
<script src="../haskell/haskell.js"></script>
<style>.CodeMirror {
border-top : 1px solid #DDDDDD;
border-bottom : 1px solid #DDDDDD;
}</style>
<div id=nav>
<a href="http://codemirror.net"><h1>CodeMirror</h1><img id=logo
src="../../doc/logo.png"></a>
<ul>
<li><a href="../../index.html">Home</a>
<li><a href="../../doc/manual.html">Manual</a>
<li><a href="https://github.com/codemirror/codemirror">Code</a>
</ul>
<ul>
<li><a href="../index.html">Language modes</a>
<li><a class=active href="#">Haskell-literate</a>
</ul>
</div>
<article>
<h2>Haskell literate mode</h2>
<form>
<textarea id="code" name="code">
> {-# LANGUAGE OverloadedStrings #-}
> {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
> import Control.Applicative ((<$>), (<*>))
> import Data.Maybe (isJust)
> import Data.Text (Text)
> import Text.Blaze ((!))
> import qualified Data.Text as T
> import qualified Happstack.Server as Happstack
> import qualified Text.Blaze.Html5 as H
> import qualified Text.Blaze.Html5.Attributes as A
> import Text.Digestive
> import Text.Digestive.Blaze.Html5
> import Text.Digestive.Happstack
> import Text.Digestive.Util
Simple forms and validation
---------------------------
Let's start by creating a very simple datatype to represent a user:
> data User = User
> { userName :: Text
> , userMail :: Text
> } deriving (Show)
And dive in immediately to create a `Form` for a user. The `Form v m a` type
has three parameters:
- `v`: the type for messages and errors (usually a `String`-like type, `Text` in
this case);
- `m`: the monad we are operating in, not specified here;
- `a`: the return type of the `Form`, in this case, this is obviously `User`.
> userForm :: Monad m => Form Text m User
We create forms by using the `Applicative` interface. A few form types are
provided in the `Text.Digestive.Form` module, such as `text`, `string`,
`bool`...
In the `digestive-functors` library, the developer is required to label each
field using the `.:` operator. This might look like a bit of a burden, but it
allows you to do some really useful stuff, like separating the `Form` from the
actual HTML layout.
> userForm = User
> <$> "name" .: text Nothing
> <*> "mail" .: check "Not a valid email address" checkEmail (text Nothing)
The `check` function enables you to validate the result of a form. For example,
we can validate the email address with a really naive `checkEmail` function.
> checkEmail :: Text -> Bool
> checkEmail = isJust . T.find (== '@')
More validation
---------------
For our example, we also want descriptions of Haskell libraries, and in order to
do that, we need package versions...
> type Version = [Int]
We want to let the user input a version number such as `0.1.0.0`. This means we
need to validate if the input `Text` is of this form, and then we need to parse
it to a `Version` type. Fortunately, we can do this in a single function:
`validate` allows conversion between values, which can optionally fail.
`readMaybe :: Read a => String -> Maybe a` is a utility function imported from
`Text.Digestive.Util`.
> validateVersion :: Text -> Result Text Version
> validateVersion = maybe (Error "Cannot parse version") Success .
> mapM (readMaybe . T.unpack) . T.split (== '.')
A quick test in GHCi:
ghci> validateVersion (T.pack "0.3.2.1")
Success [0,3,2,1]
ghci> validateVersion (T.pack "0.oops")
Error "Cannot parse version"
It works! This means we can now easily add a `Package` type and a `Form` for it:
> data Category = Web | Text | Math
> deriving (Bounded, Enum, Eq, Show)
> data Package = Package Text Version Category
> deriving (Show)
> packageForm :: Monad m => Form Text m Package
> packageForm = Package
> <$> "name" .: text Nothing
> <*> "version" .: validate validateVersion (text (Just "0.0.0.1"))
> <*> "category" .: choice categories Nothing
> where
> categories = [(x, T.pack (show x)) | x <- [minBound .. maxBound]]
Composing forms
---------------
A release has an author and a package. Let's use this to illustrate the
composability of the digestive-functors library: we can reuse the forms we have
written earlier on.
> data Release = Release User Package
> deriving (Show)
> releaseForm :: Monad m => Form Text m Release
> releaseForm = Release
> <$> "author" .: userForm
> <*> "package" .: packageForm
Views
-----
As mentioned before, one of the advantages of using digestive-functors is
separation of forms and their actual HTML layout. In order to do this, we have
another type, `View`.
We can get a `View` from a `Form` by supplying input. A `View` contains more
information than a `Form`, it has:
- the original form;
- the input given by the user;
- any errors that have occurred.
It is this view that we convert to HTML. For this tutorial, we use the
[blaze-html] library, and some helpers from the `digestive-functors-blaze`
library.
[blaze-html]: http://jaspervdj.be/blaze/
Let's write a view for the `User` form. As you can see, we here refer to the
different fields in the `userForm`. The `errorList` will generate a list of
errors for the `"mail"` field.
> userView :: View H.Html -> H.Html
> userView view = do
> label "name" view "Name: "
> inputText "name" view
> H.br
>
> errorList "mail" view
> label "mail" view "Email address: "
> inputText "mail" view
> H.br
Like forms, views are also composable: let's illustrate that by adding a view
for the `releaseForm`, in which we reuse `userView`. In order to do this, we
take only the parts relevant to the author from the view by using `subView`. We
can then pass the resulting view to our own `userView`.
We have no special view code for `Package`, so we can just add that to
`releaseView` as well. `childErrorList` will generate a list of errors for each
child of the specified form. In this case, this means a list of errors from
`"package.name"` and `"package.version"`. Note how we use `foo.bar` to refer to
nested forms.
> releaseView :: View H.Html -> H.Html
> releaseView view = do
> H.h2 "Author"
> userView $ subView "author" view
>
> H.h2 "Package"
> childErrorList "package" view
>
> label "package.name" view "Name: "
> inputText "package.name" view
> H.br
>
> label "package.version" view "Version: "
> inputText "package.version" view
> H.br
>
> label "package.category" view "Category: "
> inputSelect "package.category" view
> H.br
The attentive reader might have wondered what the type parameter for `View` is:
it is the `String`-like type used for e.g. error messages.
But wait! We have
releaseForm :: Monad m => Form Text m Release
releaseView :: View H.Html -> H.Html
... doesn't this mean that we need a `View Text` rather than a `View Html`? The
answer is yes -- but having `View Html` allows us to write these views more
easily with the `digestive-functors-blaze` library. Fortunately, we will be able
to fix this using the `Functor` instance of `View`.
fmap :: Monad m => (v -> w) -> View v -> View w
A backend
---------
To finish this tutorial, we need to be able to actually run this code. We need
an HTTP server for that, and we use [Happstack] for this tutorial. The
`digestive-functors-happstack` library gives about everything we need for this.
[Happstack]: http://happstack.com/
> site :: Happstack.ServerPart Happstack.Response
> site = do
> Happstack.decodeBody $ Happstack.defaultBodyPolicy "/tmp" 4096 4096 4096
> r <- runForm "test" releaseForm
> case r of
> (view, Nothing) -> do
> let view' = fmap H.toHtml view
> Happstack.ok $ Happstack.toResponse $
> template $
> form view' "/" $ do
> releaseView view'
> H.br
> inputSubmit "Submit"
> (_, Just release) -> Happstack.ok $ Happstack.toResponse $
> template $ do
> css
> H.h1 "Release received"
> H.p $ H.toHtml $ show release
>
> main :: IO ()
> main = Happstack.simpleHTTP Happstack.nullConf site
Utilities
---------
> template :: H.Html -> H.Html
> template body = H.docTypeHtml $ do
> H.head $ do
> H.title "digestive-functors tutorial"
> css
> H.body body
> css :: H.Html
> css = H.style ! A.type_ "text/css" $ do
> "label {width: 130px; float: left; clear: both}"
> "ul.digestive-functors-error-list {"
> " color: red;"
> " list-style-type: none;"
> " padding-left: 0px;"
> "}"
</textarea>
</form>
<p><strong>MIME types
defined:</strong> <code>text/x-literate-haskell</code>.</p>
<p>Parser configuration parameters recognized: <code>base</code> to
set the base mode (defaults to <code>"haskell"</code>).</p>
<script>
var editor = CodeMirror.fromTextArea(document.getElementById("code"), {mode: "haskell-literate"});
</script>
</article>
|
