{-# 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)))
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)'
Adrian.