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

[Adrian May]

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 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/20130615/b1bc633a/attachment-0001.htm>