<div dir="ltr">Now I fixed it in a slightly different way:<div><br></div><div><br></div><div><div><font face="courier new, monospace">{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-}</font></div>
<div><font face="courier new, monospace">module Main where</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">import Control.Applicative</font></div><div><font face="courier new, monospace">import Control.Applicative.Indexed</font></div>
<div><font face="courier new, monospace">import Control.Monad</font></div><div><font face="courier new, monospace">import qualified Data.ByteString.Char8 as C</font></div><div><font face="courier new, monospace">import Text.Blaze </font></div>
<div><font face="courier new, monospace">import Text.Blaze.Html </font></div><div><font face="courier new, monospace">import qualified Text.Blaze.Html5 as H</font></div><div><font face="courier new, monospace">import qualified Text.Blaze.Html5.Attributes as A</font></div>
<div><font face="courier new, monospace">import Text.Blaze.Renderer.Utf8 (renderHtml)</font></div><div><font face="courier new, monospace">import Text.Reform</font></div><div><font face="courier new, monospace">import Text.Reform.Blaze.Common</font></div>
<div><span style="font-family:'courier new',monospace">import Text.Reform.Happstack</span><br></div><div><font face="courier new, monospace">import Happstack.Server</font></div><div><font face="courier new, monospace">import SharedForm</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">instance ToMarkup (DemoFormError [Input]) where</font></div><div><font face="courier new, monospace"> toMarkup InvalidEmail = "Email address must contain a @."</font></div>
<div><font face="courier new, monospace"> toMarkup InvalidUsername = "Username must not be blank."</font></div><div><font face="courier new, monospace"> toMarkup (CommonError (InputMissing fid)) = H.toHtml $ "Internal Error. Input missing: " ++ show fid</font></div>
<div><font face="courier new, monospace"> toMarkup (CommonError (NoStringFound input)) = H.toHtml $ "Internal Error. Could not extract a String from: " ++ show input</font></div><div><font face="courier new, monospace"> toMarkup (CommonError (MultiStringsFound input)) = H.toHtml $ "Internal Error. Found more than one String in: " ++ show input</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">usernameForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =></font></div><div><font face="courier new, monospace"> String</font></div>
<div><font face="courier new, monospace"> -> Form m input (DemoFormError input) Html () Username</font></div><div><font face="courier new, monospace">usernameForm initialValue =</font></div><div><font face="courier new, monospace"> Username <$> <b>inputText initialValue</b> </font></div>
<div><font face="courier new, monospace"> </font></div><div><font face="courier new, monospace">emailForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =></font></div><div><font face="courier new, monospace"> String</font></div>
<div><font face="courier new, monospace"> -> Form m input (DemoFormError input) Html ValidEmail Email</font></div><div><font face="courier new, monospace">emailForm initialValue =</font></div><div><font face="courier new, monospace"> errorList ++> (label "email: " ++> (Email <<$>> <b>inputText initialValue</b> `prove` (validEmailProof InvalidEmail)))</font></div>
</div><div><font face="courier new, monospace"><br></font></div><div><br></div><div> and got something even stranger:</div><div><br></div><div><br></div><div><div><font face="courier new, monospace">Taser.hs:32:18:</font></div>
<div><font face="courier new, monospace"> Couldn't match expected type `Form</font></div><div><font face="courier new, monospace"> m input (DemoFormError input) Html () String'</font></div>
<div><font face="courier new, monospace"> with actual type `text0 -> Form m0 input0 error0 Html () text0'</font></div><div><font face="courier new, monospace"> In the return type of a call of `inputText'</font></div>
<div><font face="courier new, monospace"> Probable cause: `inputText' is applied to too few arguments</font></div><div><font face="courier new, monospace"> In the second argument of `(<$>)', namely `inputText initialValue'</font></div>
<div><font face="courier new, monospace"> In the expression: Username <$> inputText initialValue</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">Taser.hs:38:56:</font></div>
<div><font face="courier new, monospace"> Couldn't match expected type `Form</font></div><div><font face="courier new, monospace"> m input (DemoFormError input) Html q0 a0'</font></div>
<div><font face="courier new, monospace"> with actual type `text0 -> Form m0 input0 error0 Html () text0'</font></div><div><font face="courier new, monospace"> In the return type of a call of `inputText'</font></div>
<div><font face="courier new, monospace"> Probable cause: `inputText' is applied to too few arguments</font></div><div><font face="courier new, monospace"> In the first argument of `prove', namely `inputText initialValue'</font></div>
<div><font face="courier new, monospace"> In the second argument of `(<<$>>)', namely</font></div><div><font face="courier new, monospace"> `inputText initialValue `prove` (validEmailProof InvalidEmail)'</font></div>
</div><div><br></div><div><br></div><div style>Please would somebody explain what's going on?</div><div style>Adrian.</div><div style><br></div><div style><br></div><div><br></div></div><div class="gmail_extra"><br><br>
<div class="gmail_quote">On 15 June 2013 17:19, Adrian May <span dir="ltr"><<a href="mailto:adrian.alexander.may@gmail.com" target="_blank">adrian.alexander.may@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<div dir="ltr"><div>Hi All,</div><div><br></div><div>I'm trying to get this example working:</div><div><br></div><div><font face="courier new, monospace"><a href="http://patch-tag.com/r/stepcut/reform/snapshot/current/content/pretty/examples/BlazeMain.hs" target="_blank">http://patch-tag.com/r/stepcut/reform/snapshot/current/content/pretty/examples/BlazeMain.hs</a></font></div>
<div><br></div><div>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:</div><div><br></div><div><font face="courier new, monospace"> {-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-}</font></div>
<div><font face="courier new, monospace"> module Main where</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> import Control.Applicative.Indexed</font></div>
<div><font face="courier new, monospace"> import Control.Monad</font></div><div><font face="courier new, monospace"> import qualified Data.ByteString.Char8 as C</font></div><div><font face="courier new, monospace"><i> import Text.Blaze </i></font></div>
<div><font face="courier new, monospace"> import qualified Text.Blaze.Html5 as H</font></div><div><font face="courier new, monospace"> import qualified Text.Blaze.Html5.Attributes as A</font></div><div><font face="courier new, monospace"> import Text.Blaze.Renderer.Utf8 (renderHtml)</font></div>
<div><font face="courier new, monospace"> import Text.Reform</font></div><div><font face="courier new, monospace"><i> --import Text.Reform.Blaze.Common</i></font></div><div><font face="courier new, monospace"><i> --import Text.Reform.Blaze.Text</i></font></div>
<div><font face="courier new, monospace"><i> import Text.Reform.Blaze.String</i></font></div><div><font face="courier new, monospace"> import Text.Reform.Happstack</font></div><div><font face="courier new, monospace"> import Happstack.Server</font></div>
<div><font face="courier new, monospace"> import SharedForm</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> instance <i>ToMarkup</i> (DemoFormError [Input]) where</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span><i>toMarkup</i> InvalidEmail = "Email address must contain a @."</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span><i>toMarkup</i> InvalidUsername = "Username must not be blank."</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span><i>toMarkup</i> (CommonError (InputMissing fid)) = H.toHtml $ "Internal Error. Input missing: " ++ show fid</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span><i>toMarkup</i> (CommonError (NoStringFound input)) = H.toHtml $ "Internal Error. Could not extract a String from: " ++ show input</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span><i>toMarkup</i> (CommonError (MultiStringsFound input)) = H.toHtml $ "Internal Error. Found more than one String in: " ++ show input</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> usernameForm :: (Monad m, FormInput input, <i>ToMarkup</i> (DemoFormError input)) =></font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>String</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> -> Form m input (DemoFormError input) <i>Markup</i> NotNull Username</font></div><div><font face="courier new, monospace"> usernameForm initialValue =</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>( <b>label "username: " ++></b> (Username <<$>> inputText initialValue `prove` (notNullProof InvalidUsername)))</font></div>
<div><font face="courier new, monospace"> {-</font></div><div><font face="courier new, monospace"> usernameForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =></font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>String</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> -> Form m input (DemoFormError input) Markup NotNull Username</font></div><div><font face="courier new, monospace"> usernameForm initialValue =</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>errorList ++> (<b>label "username: " ++> </b>(Username <<$>> inputText initialValue `prove` (notNullProof InvalidUsername)))</font></div>
<div><font face="courier new, monospace"> -}</font></div><div><font face="courier new, monospace"> blazeResponse :: <i>Markup</i> -> Response</font></div><div><font face="courier new, monospace"> blazeResponse html = toResponseBS (C.pack "text/html;charset=UTF-8") $ renderHtml html</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> blazeForm :: <i>Markup</i> -> <i>Markup</i></font></div><div><font face="courier new, monospace"> blazeForm html =</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>H.form ! A.action "/"</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> ! A.method "POST"</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> ! A.enctype "multipart/form-data" $</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>do html</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> H.input ! A.type_ "submit"</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> formHandler :: (<i>ToMarkup</i> error, Show a) => Form (ServerPartT IO) [Input] error <i>Markup</i> proof a -> ServerPart Response</font></div>
<div><font face="courier new, monospace"> formHandler form =</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> msum [ do method GET</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> html <- viewForm "user" form</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> ok $ blazeResponse $ blazeForm html</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>, do method POST</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> r <- eitherForm environment "user" form</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> case r of</font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>(Right a) -> ok $ toResponse $ show a</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>(Left view) -></font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> ok $ blazeResponse $ blazeForm view</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>]</font></div>
<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace"> main :: IO ()</font></div><div><font face="courier new, monospace"> main =</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span>do let form = usernameForm "" </font></div>
<div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> simpleHTTP nullConf $ do decodeBody (defaultBodyPolicy "/tmp" 0 10000 10000)</font></div><div><font face="courier new, monospace"><span style="white-space:pre-wrap"> </span> formHandler form</font></div>
<div><br></div><div><br></div><div>where <i>italics</i> indicate the bits I changed, but now I'm stumped by the <b>bold</b> bit barfing with: </div><div><br></div><div><font face="courier new, monospace">Taser.hs:30:13:</font></div>
<div><font face="courier new, monospace"> Ambiguous type variable `children0' in the constraints:</font></div><div><font face="courier new, monospace"> (Data.String.IsString children0)</font></div><div><font face="courier new, monospace"> arising from the literal `"username: "' at Taser.hs:30:13-24</font></div>
<div><font face="courier new, monospace"> (ToMarkup children0)</font></div><div><font face="courier new, monospace"> arising from a use of `label' at Taser.hs:30:7-11</font></div><div><font face="courier new, monospace"> Probable fix: add a type signature that fixes these type variable(s)</font></div>
<div><font face="courier new, monospace"> In the first argument of `label', namely `"username: "'</font></div><div><font face="courier new, monospace"> In the first argument of `(++>)', namely `label "username: "'</font></div>
<div><font face="courier new, monospace"> In the expression:</font></div><div><font face="courier new, monospace"> (label "username: "</font></div><div><font face="courier new, monospace"> ++></font></div>
<div><font face="courier new, monospace"> (Username</font></div><div><font face="courier new, monospace"> <<$>></font></div><div><font face="courier new, monospace"> inputText initialValue `prove` (notNullProof InvalidUsername)))</font></div>
<div><br></div><div>If I take out <font face="courier new, monospace">label "username: " ++></font>, 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.</div>
<div><br></div><div>I have the following versions installed:</div><div><br></div><div><font face="courier new, monospace">* blaze-markup (library)</font></div><div><font face="courier new, monospace"> Versions installed: 0.5.1.5</font></div>
<div><font face="courier new, monospace">* blaze-html (library)</font></div><div><font face="courier new, monospace"> Versions installed: 0.6.1.1</font></div><div><font face="courier new, monospace">* reform (library)</font></div>
<div><font face="courier new, monospace"> Versions installed: 0.1.2</font></div><div><font face="courier new, monospace">* reform-blaze (library)</font></div><div><font face="courier new, monospace"> Versions installed: 0.1.2</font></div>
<div><font face="courier new, monospace">The Glorious Glasgow Haskell Compilation System, version 7.4.2</font></div><div><br></div><div>Perhaps the markup thing is what broke it, but I can't see ToHtml in any of those modules.</div>
<div><br></div><div>Thanks in advance,</div><div>Adrian.</div><div><br></div><div><br></div><div><br></div></div>
</blockquote></div><br></div>