/usr/share/doc/libghc-reform-doc/html/src/Text-Reform-Core.html is in libghc-reform-doc 0.2.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>Text/Reform/Core.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}</span>
<a name="line-2"></a><span class='hs-comment'>{- |
<a name="line-3"></a>This module defines the 'Form' type, its instances, core manipulation functions, and a bunch of helper utilities.
<a name="line-4"></a>-}</span>
<a name="line-5"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Reform</span><span class='hs-varop'>.</span><span class='hs-conid'>Core</span> <span class='hs-keyword'>where</span>
<a name="line-6"></a>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span> <span class='hs-layout'>(</span><span class='hs-conid'>Applicative</span><span class='hs-layout'>(</span><span class='hs-varid'>pure</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varop'><*></span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Applicative</span><span class='hs-varop'>.</span><span class='hs-conid'>Indexed</span> <span class='hs-layout'>(</span><span class='hs-conid'>IndexedApplicative</span><span class='hs-layout'>(</span><span class='hs-varid'>ipure</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varop'><<*>></span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>IndexedFunctor</span> <span class='hs-layout'>(</span><span class='hs-varid'>imap</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Arrow</span> <span class='hs-layout'>(</span><span class='hs-varid'>first</span><span class='hs-layout'>,</span> <span class='hs-varid'>second</span><span class='hs-layout'>)</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Reader</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadReader</span><span class='hs-layout'>(</span><span class='hs-varid'>ask</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>ReaderT</span><span class='hs-layout'>,</span> <span class='hs-varid'>runReaderT</span><span class='hs-layout'>)</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadState</span><span class='hs-layout'>(</span><span class='hs-varid'>get</span><span class='hs-layout'>,</span><span class='hs-varid'>put</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>StateT</span><span class='hs-layout'>,</span> <span class='hs-varid'>evalStateT</span><span class='hs-layout'>)</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Trans</span> <span class='hs-layout'>(</span><span class='hs-varid'>lift</span><span class='hs-layout'>)</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Monoid</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monoid</span><span class='hs-layout'>(</span><span class='hs-varid'>mempty</span><span class='hs-layout'>,</span> <span class='hs-varid'>mappend</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Lazy</span> <span class='hs-layout'>(</span><span class='hs-conid'>Text</span><span class='hs-layout'>,</span> <span class='hs-varid'>unpack</span><span class='hs-layout'>)</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Text</span><span class='hs-varop'>.</span><span class='hs-conid'>Reform</span><span class='hs-varop'>.</span><span class='hs-conid'>Result</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormId</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>FormRange</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Result</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>unitRange</span><span class='hs-layout'>,</span> <span class='hs-varid'>zeroId</span><span class='hs-layout'>)</span>
<a name="line-16"></a>
<a name="line-17"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-18"></a><span class='hs-comment'>-- * Proved</span>
<a name="line-19"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-20"></a>
<a name="line-21"></a><a name="Proved"></a><span class='hs-comment'>-- | Proved records a value, the location that value came from, and something that was proved about the value.</span>
<a name="line-22"></a><a name="Proved"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Proved</span> <span class='hs-varid'>proofs</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span>
<a name="line-23"></a> <span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>proofs</span>
<a name="line-24"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FormRange</span>
<a name="line-25"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span>
<a name="line-26"></a> <span class='hs-layout'>}</span>
<a name="line-27"></a>
<a name="line-28"></a><a name="instance%20Functor%20(Proved%20())"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Functor</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-29"></a> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-conid'>()</span> <span class='hs-varid'>pos</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Proved</span> <span class='hs-conid'>()</span> <span class='hs-varid'>pos</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-30"></a>
<a name="line-31"></a><a name="unitProved"></a><span class='hs-comment'>-- | Utility Function: trivially prove nothing about ()</span>
<a name="line-32"></a><span class='hs-definition'>unitProved</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FormId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Proved</span> <span class='hs-conid'>()</span> <span class='hs-conid'>()</span>
<a name="line-33"></a><span class='hs-definition'>unitProved</span> <span class='hs-varid'>formId</span> <span class='hs-keyglyph'>=</span>
<a name="line-34"></a> <span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-35"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitRange</span> <span class='hs-varid'>formId</span>
<a name="line-36"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-37"></a> <span class='hs-layout'>}</span>
<a name="line-38"></a>
<a name="line-39"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-40"></a><span class='hs-comment'>-- * FormState</span>
<a name="line-41"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-42"></a>
<a name="line-43"></a><a name="FormState"></a><span class='hs-comment'>-- | inner state used by 'Form'.</span>
<a name="line-44"></a><a name="FormState"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ReaderT</span> <span class='hs-layout'>(</span><span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>StateT</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span>
<a name="line-45"></a>
<a name="line-46"></a><a name="Value"></a><span class='hs-comment'>-- | used to represent whether a value was found in the form</span>
<a name="line-47"></a><a name="Value"></a><span class='hs-comment'>-- submission data, missing from the form submission data, or expected</span>
<a name="line-48"></a><a name="Value"></a><span class='hs-comment'>-- that the default value should be used</span>
<a name="line-49"></a><a name="Value"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Value</span> <span class='hs-varid'>a</span>
<a name="line-50"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Default</span>
<a name="line-51"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Missing</span>
<a name="line-52"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Found</span> <span class='hs-varid'>a</span>
<a name="line-53"></a>
<a name="line-54"></a><a name="getFormInput"></a><span class='hs-comment'>-- | Utility function: Get the current input</span>
<a name="line-55"></a><span class='hs-comment'>--</span>
<a name="line-56"></a><span class='hs-definition'>getFormInput</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-layout'>(</span><span class='hs-conid'>Value</span> <span class='hs-varid'>input</span><span class='hs-layout'>)</span>
<a name="line-57"></a><span class='hs-definition'>getFormInput</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getFormId</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>getFormInput'</span>
<a name="line-58"></a>
<a name="line-59"></a><a name="getFormInput'"></a><span class='hs-comment'>-- | Utility function: Gets the input of an arbitrary 'FormId'.</span>
<a name="line-60"></a><span class='hs-comment'>--</span>
<a name="line-61"></a><span class='hs-definition'>getFormInput'</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormId</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-layout'>(</span><span class='hs-conid'>Value</span> <span class='hs-varid'>input</span><span class='hs-layout'>)</span>
<a name="line-62"></a><span class='hs-definition'>getFormInput'</span> <span class='hs-varid'>id'</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-63"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>ask</span>
<a name="line-64"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>env</span> <span class='hs-keyword'>of</span>
<a name="line-65"></a> <span class='hs-conid'>NoEnvironment</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Default</span>
<a name="line-66"></a> <span class='hs-conid'>Environment</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>-></span>
<a name="line-67"></a> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>f</span> <span class='hs-varid'>id'</span>
<a name="line-68"></a>
<a name="line-69"></a><a name="getFormRange"></a><span class='hs-comment'>-- | Utility function: Get the current range</span>
<a name="line-70"></a><span class='hs-comment'>--</span>
<a name="line-71"></a><span class='hs-definition'>getFormRange</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>i</span> <span class='hs-conid'>FormRange</span>
<a name="line-72"></a><span class='hs-definition'>getFormRange</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>get</span>
<a name="line-73"></a>
<a name="line-74"></a><a name="Environment"></a><span class='hs-comment'>-- | The environment is where you get the actual input per form.</span>
<a name="line-75"></a><a name="Environment"></a><span class='hs-comment'>--</span>
<a name="line-76"></a><a name="Environment"></a><span class='hs-comment'>-- The 'NoEnvironment' constructor is typically used when generating a</span>
<a name="line-77"></a><a name="Environment"></a><span class='hs-comment'>-- view for a GET request, where no data has yet been submitted. This</span>
<a name="line-78"></a><a name="Environment"></a><span class='hs-comment'>-- will cause the input elements to use their supplied default values.</span>
<a name="line-79"></a><a name="Environment"></a><span class='hs-comment'>--</span>
<a name="line-80"></a><a name="Environment"></a><span class='hs-comment'>-- Note that 'NoEnviroment' is different than supplying an empty environment.</span>
<a name="line-81"></a><a name="Environment"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span>
<a name="line-82"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Environment</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormId</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Value</span> <span class='hs-varid'>input</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-83"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>NoEnvironment</span>
<a name="line-84"></a>
<a name="line-85"></a><a name="instance%20Monoid%20(Environment%20m%20input)"></a><span class='hs-comment'>-- | Not quite sure when this is useful and so hard to say if the rules for combining things with Missing/Default are correct</span>
<a name="line-86"></a><a name="instance%20Monoid%20(Environment%20m%20input)"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monoid</span> <span class='hs-varid'>input</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Monoid</span> <span class='hs-layout'>(</span><span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-87"></a> <span class='hs-varid'>mempty</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>NoEnvironment</span>
<a name="line-88"></a> <span class='hs-conid'>NoEnvironment</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>
<a name="line-89"></a> <span class='hs-varid'>x</span> <span class='hs-varop'>`mappend`</span> <span class='hs-conid'>NoEnvironment</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>x</span>
<a name="line-90"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Environment</span> <span class='hs-varid'>env1</span><span class='hs-layout'>)</span> <span class='hs-varop'>`mappend`</span> <span class='hs-layout'>(</span><span class='hs-conid'>Environment</span> <span class='hs-varid'>env2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-91"></a> <span class='hs-conid'>Environment</span> <span class='hs-varop'>$</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>id'</span> <span class='hs-keyglyph'>-></span>
<a name="line-92"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>r1</span> <span class='hs-keyglyph'><-</span> <span class='hs-layout'>(</span><span class='hs-varid'>env1</span> <span class='hs-varid'>id'</span><span class='hs-layout'>)</span>
<a name="line-93"></a> <span class='hs-varid'>r2</span> <span class='hs-keyglyph'><-</span> <span class='hs-layout'>(</span><span class='hs-varid'>env2</span> <span class='hs-varid'>id'</span><span class='hs-layout'>)</span>
<a name="line-94"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>r1</span><span class='hs-layout'>,</span> <span class='hs-varid'>r2</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-95"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Missing</span><span class='hs-layout'>,</span> <span class='hs-conid'>Missing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Missing</span>
<a name="line-96"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Default</span><span class='hs-layout'>,</span> <span class='hs-conid'>Missing</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Default</span>
<a name="line-97"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Missing</span><span class='hs-layout'>,</span> <span class='hs-conid'>Default</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>Default</span>
<a name="line-98"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Found</span> <span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-conid'>Found</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Found</span> <span class='hs-layout'>(</span><span class='hs-varid'>x</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span>
<a name="line-99"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Found</span> <span class='hs-varid'>x</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span> <span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Found</span> <span class='hs-varid'>x</span>
<a name="line-100"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-layout'>,</span> <span class='hs-conid'>Found</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Found</span> <span class='hs-varid'>y</span>
<a name="line-101"></a>
<a name="line-102"></a><a name="getFormId"></a><span class='hs-comment'>-- | Utility function: returns the current 'FormId'. This will only make sense</span>
<a name="line-103"></a><span class='hs-comment'>-- if the form is not composed</span>
<a name="line-104"></a><span class='hs-comment'>--</span>
<a name="line-105"></a><span class='hs-definition'>getFormId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>i</span> <span class='hs-conid'>FormId</span>
<a name="line-106"></a><span class='hs-definition'>getFormId</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-107"></a> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-108"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span>
<a name="line-109"></a>
<a name="line-110"></a><a name="incFormId"></a><span class='hs-comment'>-- | Utility function: increment the current 'FormId'.</span>
<a name="line-111"></a><span class='hs-definition'>incFormId</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>i</span> <span class='hs-conid'>()</span>
<a name="line-112"></a><span class='hs-definition'>incFormId</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-113"></a> <span class='hs-conid'>FormRange</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>endF1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-114"></a> <span class='hs-varid'>put</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unitRange</span> <span class='hs-varid'>endF1</span>
<a name="line-115"></a>
<a name="line-116"></a><a name="View"></a><span class='hs-comment'>-- | A view represents a visual representation of a form. It is composed of a</span>
<a name="line-117"></a><a name="View"></a><span class='hs-comment'>-- function which takes a list of all errors and then produces a new view</span>
<a name="line-118"></a><a name="View"></a><span class='hs-comment'>--</span>
<a name="line-119"></a><a name="View"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>View</span> <span class='hs-varid'>error</span> <span class='hs-varid'>v</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>View</span>
<a name="line-120"></a> <span class='hs-layout'>{</span> <span class='hs-varid'>unView</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>FormRange</span><span class='hs-layout'>,</span> <span class='hs-varid'>error</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>v</span>
<a name="line-121"></a> <span class='hs-layout'>}</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monoid</span><span class='hs-layout'>)</span>
<a name="line-122"></a>
<a name="line-123"></a><a name="instance%20Functor%20(View%20e)"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Functor</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varid'>e</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-124"></a> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varid'>g</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>View</span> <span class='hs-varop'>$</span> <span class='hs-varid'>f</span> <span class='hs-varop'>.</span> <span class='hs-varid'>g</span>
<a name="line-125"></a>
<a name="line-126"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-127"></a><span class='hs-comment'>-- * Form</span>
<a name="line-128"></a><span class='hs-comment'>------------------------------------------------------------------------------</span>
<a name="line-129"></a>
<a name="line-130"></a><a name="Form"></a><span class='hs-comment'>-- | a 'Form' contains a 'View' combined with a validation function</span>
<a name="line-131"></a><a name="Form"></a><span class='hs-comment'>-- which will attempt to extract a value from submitted form data.</span>
<a name="line-132"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-133"></a><a name="Form"></a><span class='hs-comment'>-- It is highly parameterized, allowing it work in a wide variety of</span>
<a name="line-134"></a><a name="Form"></a><span class='hs-comment'>-- different configurations. You will likely want to make a type alias</span>
<a name="line-135"></a><a name="Form"></a><span class='hs-comment'>-- that is specific to your application to make type signatures more</span>
<a name="line-136"></a><a name="Form"></a><span class='hs-comment'>-- manageable.</span>
<a name="line-137"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-138"></a><a name="Form"></a><span class='hs-comment'>-- [@m@] A monad which can be used by the validator</span>
<a name="line-139"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-140"></a><a name="Form"></a><span class='hs-comment'>-- [@input@] A framework specific type for representing the raw key/value pairs from the form data</span>
<a name="line-141"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-142"></a><a name="Form"></a><span class='hs-comment'>-- [@error@] A application specific type for error messages</span>
<a name="line-143"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-144"></a><a name="Form"></a><span class='hs-comment'>-- [@view@] The type of data being generated for the view (HSP, Blaze Html, Heist, etc)</span>
<a name="line-145"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-146"></a><a name="Form"></a><span class='hs-comment'>-- [@proof@] A type which names what has been proved about the return value. @()@ means nothing has been proved.</span>
<a name="line-147"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-148"></a><a name="Form"></a><span class='hs-comment'>-- [@a@] Value return by form when it is successfully decoded, validated, etc.</span>
<a name="line-149"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-150"></a><a name="Form"></a><span class='hs-comment'>--</span>
<a name="line-151"></a><a name="Form"></a><span class='hs-comment'>-- This type is very similar to the 'Form' type from</span>
<a name="line-152"></a><a name="Form"></a><span class='hs-comment'>-- @digestive-functors <= 0.2@. If @proof@ is @()@, then 'Form' is an</span>
<a name="line-153"></a><a name="Form"></a><span class='hs-comment'>-- applicative functor and can be used almost exactly like</span>
<a name="line-154"></a><a name="Form"></a><span class='hs-comment'>-- @digestive-functors <= 0.2@.</span>
<a name="line-155"></a><a name="Form"></a><span class='hs-keyword'>newtype</span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Form</span> <span class='hs-layout'>{</span> <span class='hs-varid'>unForm</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Result</span> <span class='hs-varid'>error</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>}</span>
<a name="line-156"></a>
<a name="line-157"></a><a name="instance%20IndexedFunctor%20(Form%20m%20input%20view%20error)"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>IndexedFunctor</span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>view</span> <span class='hs-varid'>error</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-158"></a> <span class='hs-varid'>imap</span> <span class='hs-varid'>f</span> <span class='hs-varid'>g</span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>frm</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-159"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>mval</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>frm</span>
<a name="line-160"></a> <span class='hs-varid'>val</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mval</span>
<a name="line-161"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>val</span> <span class='hs-keyword'>of</span>
<a name="line-162"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>p</span> <span class='hs-varid'>pos</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-layout'>(</span><span class='hs-varid'>f</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varid'>pos</span> <span class='hs-layout'>(</span><span class='hs-varid'>g</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-163"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Error</span> <span class='hs-varid'>errs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varid'>errs</span><span class='hs-layout'>)</span>
<a name="line-164"></a>
<a name="line-165"></a><a name="instance%20IndexedApplicative%20(Form%20m%20input%20error%20view)"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monoid</span> <span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>IndexedApplicative</span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-166"></a> <span class='hs-varid'>ipure</span> <span class='hs-varid'>p</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getFormId</span>
<a name="line-167"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>mempty</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-varid'>unitRange</span> <span class='hs-varid'>i</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-168"></a>
<a name="line-169"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>frmF</span><span class='hs-layout'>)</span> <span class='hs-varop'><<*>></span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>frmA</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-170"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>view1</span><span class='hs-layout'>,</span> <span class='hs-varid'>mfok</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>maok</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bracketState</span> <span class='hs-varop'>$</span>
<a name="line-171"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>res1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>frmF</span>
<a name="line-172"></a> <span class='hs-varid'>incFormId</span>
<a name="line-173"></a> <span class='hs-varid'>res2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>frmA</span>
<a name="line-174"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>res1</span><span class='hs-layout'>,</span> <span class='hs-varid'>res2</span><span class='hs-layout'>)</span>
<a name="line-175"></a> <span class='hs-varid'>fok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mfok</span>
<a name="line-176"></a> <span class='hs-varid'>aok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>maok</span>
<a name="line-177"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>fok</span><span class='hs-layout'>,</span> <span class='hs-varid'>aok</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-178"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Error</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>,</span> <span class='hs-conid'>Error</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span>
<a name="line-179"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Error</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>)</span>
<a name="line-180"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-layout'>,</span> <span class='hs-conid'>Error</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span>
<a name="line-181"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormRange</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>q</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormRange</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-182"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>p</span> <span class='hs-varid'>q</span>
<a name="line-183"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span>
<a name="line-184"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span>
<a name="line-185"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-186"></a>
<a name="line-187"></a><a name="bracketState"></a><span class='hs-definition'>bracketState</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>a</span>
<a name="line-188"></a><span class='hs-definition'>bracketState</span> <span class='hs-varid'>k</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-189"></a> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>startF1</span> <span class='hs-keyword'>_</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-190"></a> <span class='hs-varid'>res</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>k</span>
<a name="line-191"></a> <span class='hs-conid'>FormRange</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>endF2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>get</span>
<a name="line-192"></a> <span class='hs-varid'>put</span> <span class='hs-varop'>$</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>startF1</span> <span class='hs-varid'>endF2</span>
<a name="line-193"></a> <span class='hs-varid'>return</span> <span class='hs-varid'>res</span>
<a name="line-194"></a>
<a name="line-195"></a>
<a name="line-196"></a><a name="instance%20Functor%20(Form%20m%20input%20error%20view%20())"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Functor</span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-197"></a> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span> <span class='hs-varid'>form</span> <span class='hs-keyglyph'>=</span>
<a name="line-198"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>second</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>unForm</span> <span class='hs-varid'>form</span><span class='hs-layout'>)</span>
<a name="line-199"></a>
<a name="line-200"></a>
<a name="line-201"></a><a name="instance%20Applicative%20(Form%20m%20input%20error%20view%20())"></a><span class='hs-keyword'>instance</span> <span class='hs-layout'>(</span><span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monoid</span> <span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Applicative</span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-202"></a> <span class='hs-varid'>pure</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>=</span>
<a name="line-203"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span>
<a name="line-204"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getFormId</span>
<a name="line-205"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varop'>$</span> <span class='hs-varid'>const</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mempty</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-206"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>i</span> <span class='hs-varid'>i</span>
<a name="line-207"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>a</span>
<a name="line-208"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-209"></a> <span class='hs-comment'>-- this coud be defined in terms of <<*>> if we just changed the proof of frmF to (() -> ())</span>
<a name="line-210"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>frmF</span><span class='hs-layout'>)</span> <span class='hs-varop'><*></span> <span class='hs-layout'>(</span><span class='hs-conid'>Form</span> <span class='hs-varid'>frmA</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
<a name="line-211"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span>
<a name="line-212"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>view1</span><span class='hs-layout'>,</span> <span class='hs-varid'>mfok</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-layout'>(</span><span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>maok</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>bracketState</span> <span class='hs-varop'>$</span>
<a name="line-213"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>res1</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>frmF</span>
<a name="line-214"></a> <span class='hs-varid'>incFormId</span>
<a name="line-215"></a> <span class='hs-varid'>res2</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>frmA</span>
<a name="line-216"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>res1</span><span class='hs-layout'>,</span> <span class='hs-varid'>res2</span><span class='hs-layout'>)</span>
<a name="line-217"></a> <span class='hs-varid'>fok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>mfok</span>
<a name="line-218"></a> <span class='hs-varid'>aok</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>lift</span> <span class='hs-varop'>$</span> <span class='hs-varid'>maok</span>
<a name="line-219"></a> <span class='hs-keyword'>case</span> <span class='hs-layout'>(</span><span class='hs-varid'>fok</span><span class='hs-layout'>,</span> <span class='hs-varid'>aok</span><span class='hs-layout'>)</span> <span class='hs-keyword'>of</span>
<a name="line-220"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Error</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>,</span> <span class='hs-conid'>Error</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs1</span> <span class='hs-varop'>++</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span>
<a name="line-221"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Error</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs1</span><span class='hs-layout'>)</span>
<a name="line-222"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span> <span class='hs-layout'>,</span> <span class='hs-conid'>Error</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Error</span> <span class='hs-varop'>$</span> <span class='hs-varid'>errs2</span><span class='hs-layout'>)</span>
<a name="line-223"></a> <span class='hs-layout'>(</span><span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>p</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormRange</span> <span class='hs-varid'>x</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>q</span> <span class='hs-layout'>(</span><span class='hs-conid'>FormRange</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>y</span><span class='hs-layout'>)</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span>
<a name="line-224"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>view1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>view2</span><span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-225"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>x</span> <span class='hs-varid'>y</span>
<a name="line-226"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>f</span> <span class='hs-varid'>a</span>
<a name="line-227"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-228"></a>
<a name="line-229"></a><span class='hs-comment'>-- ** Ways to evaluate a Form</span>
<a name="line-230"></a>
<a name="line-231"></a><a name="runForm"></a><span class='hs-comment'>-- | Run a form</span>
<a name="line-232"></a><span class='hs-comment'>--</span>
<a name="line-233"></a><span class='hs-definition'>runForm</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-234"></a> <span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span>
<a name="line-235"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Text</span>
<a name="line-236"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-237"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Result</span> <span class='hs-varid'>error</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-238"></a><span class='hs-definition'>runForm</span> <span class='hs-varid'>env</span> <span class='hs-varid'>prefix'</span> <span class='hs-varid'>form</span> <span class='hs-keyglyph'>=</span>
<a name="line-239"></a> <span class='hs-varid'>evalStateT</span> <span class='hs-layout'>(</span><span class='hs-varid'>runReaderT</span> <span class='hs-layout'>(</span><span class='hs-varid'>unForm</span> <span class='hs-varid'>form</span><span class='hs-layout'>)</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-varid'>unitRange</span> <span class='hs-layout'>(</span><span class='hs-varid'>zeroId</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unpack</span> <span class='hs-varid'>prefix'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-240"></a>
<a name="line-241"></a><a name="runForm'"></a><span class='hs-comment'>-- | Run a form</span>
<a name="line-242"></a><span class='hs-comment'>--</span>
<a name="line-243"></a><span class='hs-definition'>runForm'</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-244"></a> <span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span>
<a name="line-245"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Text</span>
<a name="line-246"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-247"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-varid'>view</span> <span class='hs-layout'>,</span> <span class='hs-conid'>Maybe</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span>
<a name="line-248"></a><span class='hs-definition'>runForm'</span> <span class='hs-varid'>env</span> <span class='hs-varid'>prefix</span> <span class='hs-varid'>form</span> <span class='hs-keyglyph'>=</span>
<a name="line-249"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>view'</span><span class='hs-layout'>,</span> <span class='hs-varid'>mresult</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runForm</span> <span class='hs-varid'>env</span> <span class='hs-varid'>prefix</span> <span class='hs-varid'>form</span>
<a name="line-250"></a> <span class='hs-varid'>result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mresult</span>
<a name="line-251"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>result</span> <span class='hs-keyword'>of</span>
<a name="line-252"></a> <span class='hs-conid'>Error</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>unView</span> <span class='hs-varid'>view'</span> <span class='hs-varid'>e</span> <span class='hs-layout'>,</span> <span class='hs-conid'>Nothing</span><span class='hs-layout'>)</span>
<a name="line-253"></a> <span class='hs-conid'>Ok</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>unView</span> <span class='hs-varid'>view'</span> <span class='hs-conid'>[]</span><span class='hs-layout'>,</span> <span class='hs-conid'>Just</span> <span class='hs-layout'>(</span><span class='hs-varid'>unProved</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-254"></a>
<a name="line-255"></a><a name="viewForm"></a><span class='hs-comment'>-- | Just evaluate the form to a view. This usually maps to a GET request in the</span>
<a name="line-256"></a><span class='hs-comment'>-- browser.</span>
<a name="line-257"></a><span class='hs-comment'>--</span>
<a name="line-258"></a><span class='hs-definition'>viewForm</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-259"></a> <span class='hs-conid'>Text</span> <span class='hs-comment'>-- ^ form prefix</span>
<a name="line-260"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^ form to view</span>
<a name="line-261"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>view</span>
<a name="line-262"></a><span class='hs-definition'>viewForm</span> <span class='hs-varid'>prefix</span> <span class='hs-varid'>form</span> <span class='hs-keyglyph'>=</span>
<a name="line-263"></a> <span class='hs-keyword'>do</span> <span class='hs-layout'>(</span><span class='hs-varid'>v</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runForm</span> <span class='hs-conid'>NoEnvironment</span> <span class='hs-varid'>prefix</span> <span class='hs-varid'>form</span>
<a name="line-264"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>unView</span> <span class='hs-varid'>v</span> <span class='hs-conid'>[]</span><span class='hs-layout'>)</span>
<a name="line-265"></a>
<a name="line-266"></a><a name="eitherForm"></a><span class='hs-comment'>-- | Evaluate a form</span>
<a name="line-267"></a><span class='hs-comment'>--</span>
<a name="line-268"></a><span class='hs-comment'>-- Returns:</span>
<a name="line-269"></a><span class='hs-comment'>--</span>
<a name="line-270"></a><span class='hs-comment'>-- [@Left view@] on failure. The @view@ will have already been applied to the errors.</span>
<a name="line-271"></a><span class='hs-comment'>--</span>
<a name="line-272"></a><span class='hs-comment'>-- [@Right a@] on success.</span>
<a name="line-273"></a><span class='hs-comment'>--</span>
<a name="line-274"></a><span class='hs-definition'>eitherForm</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-275"></a> <span class='hs-conid'>Environment</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-comment'>-- ^ Input environment</span>
<a name="line-276"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Text</span> <span class='hs-comment'>-- ^ Identifier for the form</span>
<a name="line-277"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^ Form to run</span>
<a name="line-278"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Either</span> <span class='hs-varid'>view</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ Result</span>
<a name="line-279"></a><span class='hs-definition'>eitherForm</span> <span class='hs-varid'>env</span> <span class='hs-varid'>id'</span> <span class='hs-varid'>form</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-280"></a> <span class='hs-layout'>(</span><span class='hs-varid'>view'</span><span class='hs-layout'>,</span> <span class='hs-varid'>mresult</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>runForm</span> <span class='hs-varid'>env</span> <span class='hs-varid'>id'</span> <span class='hs-varid'>form</span>
<a name="line-281"></a> <span class='hs-varid'>result</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>mresult</span>
<a name="line-282"></a> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>result</span> <span class='hs-keyword'>of</span>
<a name="line-283"></a> <span class='hs-conid'>Error</span> <span class='hs-varid'>e</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Left</span> <span class='hs-varop'>$</span> <span class='hs-varid'>unView</span> <span class='hs-varid'>view'</span> <span class='hs-varid'>e</span>
<a name="line-284"></a> <span class='hs-conid'>Ok</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Right</span> <span class='hs-layout'>(</span><span class='hs-varid'>unProved</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
<a name="line-285"></a>
<a name="line-286"></a><a name="view"></a><span class='hs-comment'>-- | create a 'Form' from some @view@.</span>
<a name="line-287"></a><span class='hs-comment'>--</span>
<a name="line-288"></a><span class='hs-comment'>-- This is typically used to turn markup like @\<br\>@ into a 'Form'.</span>
<a name="line-289"></a><span class='hs-definition'>view</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-290"></a> <span class='hs-varid'>view</span> <span class='hs-comment'>-- ^ View to insert</span>
<a name="line-291"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-conid'>()</span> <span class='hs-conid'>()</span> <span class='hs-comment'>-- ^ Resulting form</span>
<a name="line-292"></a><span class='hs-definition'>view</span> <span class='hs-varid'>view'</span> <span class='hs-keyglyph'>=</span>
<a name="line-293"></a> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span>
<a name="line-294"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getFormId</span>
<a name="line-295"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-conid'>View</span> <span class='hs-layout'>(</span><span class='hs-varid'>const</span> <span class='hs-varid'>view'</span><span class='hs-layout'>)</span>
<a name="line-296"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-297"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FormRange</span> <span class='hs-varid'>i</span> <span class='hs-varid'>i</span>
<a name="line-298"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-299"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-300"></a>
<a name="line-301"></a><a name="++%3e"></a><span class='hs-comment'>-- | Append a unit form to the left. This is useful for adding labels or error</span>
<a name="line-302"></a><span class='hs-comment'>-- fields.</span>
<a name="line-303"></a><span class='hs-comment'>--</span>
<a name="line-304"></a><span class='hs-comment'>-- The 'Forms' on the left and right hand side will share the same</span>
<a name="line-305"></a><span class='hs-comment'>-- 'FormId'. This is useful for elements like @\<label</span>
<a name="line-306"></a><span class='hs-comment'>-- for=\"someid\"\>@, which need to refer to the id of another</span>
<a name="line-307"></a><span class='hs-comment'>-- element.</span>
<a name="line-308"></a><span class='hs-layout'>(</span><span class='hs-varop'>++></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monoid</span> <span class='hs-varid'>view</span><span class='hs-layout'>)</span>
<a name="line-309"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-conid'>()</span> <span class='hs-conid'>()</span>
<a name="line-310"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-311"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-312"></a><a name="f1"></a><span class='hs-definition'>f1</span> <span class='hs-varop'>++></span> <span class='hs-varid'>f2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-313"></a> <span class='hs-comment'>-- Evaluate the form that matters first, so we have a correct range set</span>
<a name="line-314"></a> <span class='hs-layout'>(</span><span class='hs-varid'>v2</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unForm</span> <span class='hs-varid'>f2</span>
<a name="line-315"></a> <span class='hs-layout'>(</span><span class='hs-varid'>v1</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unForm</span> <span class='hs-varid'>f1</span>
<a name="line-316"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>v1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>v2</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-317"></a>
<a name="line-318"></a><span class='hs-keyword'>infixl</span> <span class='hs-num'>6</span> <span class='hs-varop'>++></span>
<a name="line-319"></a>
<a name="line-320"></a><a name="%3c++"></a><span class='hs-comment'>-- | Append a unit form to the right. See '++>'.</span>
<a name="line-321"></a><span class='hs-comment'>--</span>
<a name="line-322"></a><span class='hs-layout'>(</span><span class='hs-varop'><++</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Monoid</span> <span class='hs-varid'>view</span><span class='hs-layout'>)</span>
<a name="line-323"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-324"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-conid'>()</span> <span class='hs-conid'>()</span>
<a name="line-325"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span>
<a name="line-326"></a><span class='hs-definition'>f1</span> <span class='hs-varop'><++</span> <span class='hs-varid'>f2</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Form</span> <span class='hs-varop'>$</span> <span class='hs-keyword'>do</span>
<a name="line-327"></a> <span class='hs-comment'>-- Evaluate the form that matters first, so we have a correct range set</span>
<a name="line-328"></a> <span class='hs-layout'>(</span><span class='hs-varid'>v1</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unForm</span> <span class='hs-varid'>f1</span>
<a name="line-329"></a> <span class='hs-layout'>(</span><span class='hs-varid'>v2</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>unForm</span> <span class='hs-varid'>f2</span>
<a name="line-330"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>v1</span> <span class='hs-varop'>`mappend`</span> <span class='hs-varid'>v2</span><span class='hs-layout'>,</span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span>
<a name="line-331"></a>
<a name="line-332"></a><span class='hs-keyword'>infixr</span> <span class='hs-num'>5</span> <span class='hs-varop'><++</span>
<a name="line-333"></a>
<a name="line-334"></a><a name="mapView"></a><span class='hs-comment'>-- | Change the view of a form using a simple function</span>
<a name="line-335"></a><span class='hs-comment'>--</span>
<a name="line-336"></a><span class='hs-comment'>-- This is useful for wrapping a form inside of a \<fieldset\> or other markup element.</span>
<a name="line-337"></a><span class='hs-definition'>mapView</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>,</span> <span class='hs-conid'>Functor</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span>
<a name="line-338"></a> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>view</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>view'</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ Manipulator</span>
<a name="line-339"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^ Initial form</span>
<a name="line-340"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Form</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view'</span> <span class='hs-varid'>proof</span> <span class='hs-varid'>a</span> <span class='hs-comment'>-- ^ Resulting form</span>
<a name="line-341"></a><span class='hs-definition'>mapView</span> <span class='hs-varid'>f</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Form</span> <span class='hs-varop'>.</span> <span class='hs-varid'>fmap</span> <span class='hs-layout'>(</span><span class='hs-varid'>first</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>f</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>unForm</span>
<a name="line-342"></a>
<a name="line-343"></a><a name="mkOk"></a><span class='hs-comment'>-- | Utility Function: turn a view and return value into a successful 'FormState'</span>
<a name="line-344"></a><span class='hs-definition'>mkOk</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span>
<a name="line-345"></a> <span class='hs-conid'>FormId</span>
<a name="line-346"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>view</span>
<a name="line-347"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span>
<a name="line-348"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FormState</span> <span class='hs-varid'>m</span> <span class='hs-varid'>input</span> <span class='hs-layout'>(</span><span class='hs-conid'>View</span> <span class='hs-varid'>error</span> <span class='hs-varid'>view</span><span class='hs-layout'>,</span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Result</span> <span class='hs-varid'>error</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-conid'>()</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-349"></a><span class='hs-definition'>mkOk</span> <span class='hs-varid'>i</span> <span class='hs-varid'>view</span> <span class='hs-varid'>val</span> <span class='hs-keyglyph'>=</span>
<a name="line-350"></a> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span> <span class='hs-conid'>View</span> <span class='hs-varop'>$</span> <span class='hs-varid'>const</span> <span class='hs-varop'>$</span> <span class='hs-varid'>view</span>
<a name="line-351"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Ok</span> <span class='hs-layout'>(</span><span class='hs-conid'>Proved</span> <span class='hs-layout'>{</span> <span class='hs-varid'>proofs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>()</span>
<a name="line-352"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>pos</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>unitRange</span> <span class='hs-varid'>i</span>
<a name="line-353"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>unProved</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>val</span>
<a name="line-354"></a> <span class='hs-layout'>}</span><span class='hs-layout'>)</span>
<a name="line-355"></a> <span class='hs-layout'>)</span>
</pre></body>
</html>
|