Now I fixed it in a slightly different way:


{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeFamilies, OverloadedStrings #-}
module Main where

import Control.Applicative
import Control.Applicative.Indexed
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Text.Blaze 
import Text.Blaze.Html 
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.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) Html () Username
usernameForm initialValue =
    Username <$> inputText initialValue  
 
emailForm :: (Monad m, FormInput input, ToMarkup (DemoFormError input)) =>
                  String
               -> Form m input (DemoFormError input) Html ValidEmail Email
emailForm initialValue    =
    errorList ++> (label "email: " ++> (Email    <<$>> inputText initialValue `prove` (validEmailProof InvalidEmail)))


 and got something even stranger:


Taser.hs:32:18:
    Couldn't match expected type `Form
                                    m input (DemoFormError input) Html () String'
                with actual type `text0 -> Form m0 input0 error0 Html () text0'
    In the return type of a call of `inputText'
    Probable cause: `inputText' is applied to too few arguments
    In the second argument of `(<$>)', namely `inputText initialValue'
    In the expression: Username <$> inputText initialValue

Taser.hs:38:56:
    Couldn't match expected type `Form
                                    m input (DemoFormError input) Html q0 a0'
                with actual type `text0 -> Form m0 input0 error0 Html () text0'
    In the return type of a call of `inputText'
    Probable cause: `inputText' is applied to too few arguments
    In the first argument of `prove', namely `inputText initialValue'
    In the second argument of `(<<$>>)', namely
      `inputText initialValue `prove` (validEmailProof InvalidEmail)'


Please would somebody explain what's going on?
Adrian.





On 15 June 2013 17:19, Adrian May <adrian.alexander.may@gmail.com> wrote:
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.