Re: [Haskell-beginners] Reform and blaze: trouble with example code

15 Jun 2013

      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  wrote:
...
Hi All,
I'm trying to get this example working:
http://patch-tag.com/r/stepcut/reform/snapshot/current/content/pretty/exampl...
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.