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

Jeremy Shaw jeremy at n-heptane.com
Tue Jun 18 07:17:29 CEST 2013


Hello,

label has the type:

label :: (Monad m, ToMarkup children) => children -> Form m input error
Html () ()

Meaning the argument to 'label' can be anything which can be embedded as
markup. Unfortunately, when you use OverloadedStrings and write:


label "username: "

It doesn't know if it should treat "username: " as a String value or an
Html value -- as both have IsString instances. You can fix it by typing:

label ("username: " :: String)

So that it knows. That is pretty annoying, and so we should probably have a
function like:


labelString :: (Monad m) => String -> Form m input error Html () ()

which is not ambiguous, and you can do:

labelString "username: "

I believe I have added that to the reform-hsp library, but not reform-blaze.

In your second attempt, you imported the functions from .Common. But
inputtext takes an extra parameter there:

inputText :: (Monad<http://hackage.haskell.org/packages/archive/base/4.6.0.1/doc/html/Control-Monad.html#t:Monad>
 m, FormError<http://hackage.haskell.org/packages/archive/reform/0.1.2/doc/html/Text-Reform-Backend.html#t:FormError>
 error, ToValue<http://hackage.haskell.org/packages/archive/blaze-markup/0.5.1.4/doc/html/Text-Blaze.html#t:ToValue>
text)
=> (input -> Either<http://hackage.haskell.org/packages/archive/base/4.6.0.1/doc/html/Data-Either.html#t:Either>
error
text) -> text ->
Form<http://hackage.haskell.org/packages/archive/reform/0.1.2/doc/html/Text-Reform-Core.html#t:Form>
m
input error Html<http://hackage.haskell.org/packages/archive/blaze-html/0.6.0.0/doc/html/Text-Blaze-Html.html#t:Html>
()
text

The .Common module is really only for common code that is shared between
.String, .Text, and whatever may come in the future. It should have a
comment at the top explaining its purpose. Sorry about that.

- jeremy




On Sat, Jun 15, 2013 at 4:19 AM, Adrian May
<adrian.alexander.may at 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.
>
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130618/a696eb73/attachment-0001.htm>


More information about the Beginners mailing list