283 lines
		
	
	
		
			9.2 KiB
		
	
	
	
		
			HTML
		
	
	
	
	
	
			
		
		
	
	
			283 lines
		
	
	
		
			9.2 KiB
		
	
	
	
		
			HTML
		
	
	
	
	
	
<!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>
 |