Hi All,

I'm trying to get this example working:

http://patch-tag.com/r/stepcut/reform/snapshot/current/content/pretty/examples/BlazeMain.hs

It emitted what I took to be bitrot about ToHtml having apparently been generallised to ToMarkup and similar stuff, so I banged it into this form:

{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-}

module Main where

import Control.Applicative.Indexed

import Control.Monad

import qualified Data.ByteString.Char8 as C

import Text.Blaze

import qualified Text.Blaze.Html5 as H

import qualified Text.Blaze.Html5.Attributes as A

import Text.Blaze.Renderer.Utf8 (renderHtml)

import Text.Reform

--import Text.Reform.Blaze.Common

--import Text.Reform.Blaze.Text

import Text.Reform.Blaze.String

import Text.Reform.Happstack

import Happstack.Server

import SharedForm

instance ToMarkup (DemoFormError [Input]) where

toMarkup InvalidEmail = "Email address must contain a @."

toMarkup InvalidUsername = "Username must not be blank."

toMarkup (CommonError (InputMissing fid)) = H.toHtml $ "Internal Error. Input missing: " ++ show fid

toMarkup (CommonError (NoStringFound input)) = H.toHtml $ "Internal Error. Could not extract a String from: " ++ show input

toMarkup (CommonError (MultiStringsFound input)) = H.toHtml $ "Internal Error. Found more than one String in: " ++ show input

usernameForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =>

String

-> Form m input (DemoFormError input) Markup NotNull Username

usernameForm initialValue =

( label "username: " ++> (Username <<$>> inputText initialValue `prove` (notNullProof InvalidUsername)))

usernameForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =>

String

-> Form m input (DemoFormError input) Markup NotNull Username

usernameForm initialValue =

errorList ++> (label "username: " ++> (Username <<$>> inputText initialValue `prove` (notNullProof InvalidUsername)))

blazeResponse :: Markup -> Response

blazeResponse html = toResponseBS (C.pack "text/html;charset=UTF-8") $ renderHtml html

blazeForm :: Markup -> Markup

blazeForm html =

H.form ! A.action "/"

! A.method "POST"

! A.enctype "multipart/form-data" $

do html

H.input ! A.type_ "submit"

formHandler :: (ToMarkup error, Show a) => Form (ServerPartT IO) [Input] error Markup proof a -> ServerPart Response

formHandler form =

msum [ do method GET

html <- viewForm "user" form

ok $ blazeResponse $ blazeForm html

, do method POST

r <- eitherForm environment "user" form

case r of

(Right a) -> ok $ toResponse $ show a

(Left view) ->

ok $ blazeResponse $ blazeForm view

]

main :: IO ()

main =

do let form = usernameForm ""

simpleHTTP nullConf $ do decodeBody (defaultBodyPolicy "/tmp" 0 10000 10000)

formHandler form

where italics indicate the bits I changed, but now I'm stumped by the bold bit barfing with:

Taser.hs:30:13:

Ambiguous type variable `children0' in the constraints:

(Data.String.IsString children0)

arising from the literal `"username: "' at Taser.hs:30:13-24

(ToMarkup children0)

arising from a use of `label' at Taser.hs:30:7-11

Probable fix: add a type signature that fixes these type variable(s)

In the first argument of `label', namely `"username: "'

In the first argument of `(++>)', namely `label "username: "'

In the expression:

(label "username: "

++>

(Username

<<$>>

inputText initialValue `prove` (notNullProof InvalidUsername)))

If I take out label "username: " ++>, then it all works fine, except I don't have a label. I also tried putting the label inside the Username constructor with the same result.

I have the following versions installed:

* blaze-markup (library)

Versions installed: 0.5.1.5

* blaze-html (library)

Versions installed: 0.6.1.1

* reform (library)

Versions installed: 0.1.2

* reform-blaze (library)

Versions installed: 0.1.2

The Glorious Glasgow Haskell Compilation System, version 7.4.2

Perhaps the markup thing is what broke it, but I can't see ToHtml in any of those modules.

Thanks in advance,

Adrian.