[Haskell-cafe] web-routes and forms
Corentin Dupont
corentin.dupont at gmail.com
Fri Jan 21 21:33:56 CET 2011
Hello Jeremy,
I'm still trying to integrate web routes, but there is one thing I don't
understand:
how to deal with multiple forms?
In my former application, each forms used to redirect to a subdirectory of
the web site, and an appropriate handler was waiting there.
But now with web routes I don't see how to do that.
I've tried to push down the decision over subdirectories (with the guard
"dir") inside the RouteT monad:
type NomicServer = ServerPartT IO
type RoutedNomicServer = RouteT PlayerCommand NomicServer
nomicSite :: ServerHandle -> Site PlayerCommand (NomicServer Html)
nomicSite sh = setDefault (Noop 0) Site {
handleSite = \f url -> unRouteT (routedNomicHandle sh url) f
, formatPathSegments = \u -> (toPathSegments u, [])
, parsePathSegments = parseSegments fromPathSegments
}
routedNomicHandle :: ServerHandle -> PlayerCommand -> RoutedNomicServer Html
routedNomicHandle sh pc = do
d <- liftRouteT $ liftIO getDataDir
msum [dir "Login" $ loginPage,
dir "postLogin" $ postLogin,
--nullDir >> fileServe [] d,
dir "NewRule" $ newRule sh,
dir "NewGame" $ newGameWeb sh,
dir "Nomic" $ routedNomicCommands sh pc]
routedNomicCommands :: ServerHandle -> PlayerCommand -> RoutedNomicServer
Html
routedNomicCommands sh (Noop pn) = nomicPageComm pn sh
(return ())
routedNomicCommands sh (JoinGame pn game) = nomicPageComm pn sh
(joinGame game pn)
routedNomicCommands sh (LeaveGame pn) = nomicPageComm pn sh
(leaveGame pn)
routedNomicCommands sh (SubscribeGame pn game) = nomicPageComm pn sh
(subscribeGame game pn)
routedNomicCommands sh (UnsubscribeGame pn game) = nomicPageComm pn sh
(unsubscribeGame game pn)
routedNomicCommands sh (Amend pn) = nomicPageComm pn sh
(amendConstitution pn)
routedNomicCommands sh (DoAction pn an ar) = nomicPageComm pn sh
(doAction' an ar pn)
routedNomicCommands sh (NewRule pn name text code) = nomicPageComm pn sh
(submitRule name text code pn)
routedNomicCommands sh (NewGame pn game) = nomicPageComm pn sh
(newGame game pn)
loginPage :: RoutedNomicServer Html
loginPage = do
l <- loginForm
ok $ H.html $ do
H.head $ do
H.title (H.string "Login to Nomic")
H.link ! rel "stylesheet" ! type_ "text/css" ! href
"/static/css/nomic.css"
H.meta ! A.httpEquiv "Content-Type" ! content
"text/html;charset=utf-8"
H.meta ! A.name "keywords" ! A.content "Nomic, game, rules, Haskell,
auto-reference"
H.body $ do
H.div ! A.id "container" $ do
H.div ! A.id "header" $ "Login to Nomic"
H.div ! A.id "login" $ l
H.div ! A.id "footer" $ "footer"
loginForm :: RoutedNomicServer Html
loginForm = do
ok $ H.form ! A.method "POST" ! A.action "/postLogin" ! enctype
"multipart/form-data;charset=UTF-8" $ do
H.label ! for "login" $ "Login"
input ! type_ "text" ! name "login" ! A.id "login" ! tabindex "1" !
accesskey "L"
H.label ! for "password" $ "Password"
input ! type_ "text" ! name "password" ! A.id "password" ! tabindex
"2" ! accesskey "P"
input ! type_ "submit" ! tabindex "3" ! accesskey "S" ! value "Enter
Nomic!"
postLogin :: RoutedNomicServer Html
postLogin = do
methodM POST -- only accept a post method
mbEntry <- getData -- get the data
case mbEntry of
Nothing -> error $ "error: postLogin"
Just (LoginPass login password) -> do
mpn <- liftRouteT $ liftIO $ newPlayerWeb login password
case mpn of
Just pn -> do
link <- showURL $ Noop pn
seeOther link $ string "Redirecting..."
Nothing -> seeOther ("/Login?status=fail" :: String) $ string
"Redirecting..."
launchWebServer :: ServerHandle -> IO ()
launchWebServer sh = do
putStrLn "Starting web server...\nTo connect, drive your browser to \"
http://localhost:8000/Login\""
simpleHTTP nullConf $ implSite "http://localhost:8000/" "" (nomicSite sh)
But when I drive my browser to "http://localhost:8000/Login/", happstack
tell me there is nothing here.
Am I doing it right? If yes, I must have made a mistake.
(as you can see I'm still far from putting in disgestive functors ;)
If you need, the complete application can be found here (see file Web.hs):
https://github.com/cdupont/Nomic
Thanks,
Corentin
On Wed, Jan 19, 2011 at 5:12 PM, Corentin Dupont
<corentin.dupont at gmail.com>wrote:
> Thanks Jeremy.
> I had it to work now ;)
>
> Corentin
>
>
> On Tue, Jan 18, 2011 at 6:01 PM, Jeremy Shaw <jeremy at n-heptane.com> wrote:
>
>> Hello,
>>
>> trhsx will be installed in ~/.cabal/bin, so you will need to add that
>> to your PATH.
>>
>> In order to use the demo code I provided you would need the latest
>> happstack from darcs because it contains a few differences in the API.
>> The code can be made to work with what is on hackage though.
>>
>> The submit issue is actually a bug in digestive-functors-blaze. The
>> return type should be, Form m i e BlazeFormHtml (). jaspervdj is going
>> to patch it and upload a new version.
>>
>> - jeremy
>>
>>
>> On Thu, Jan 13, 2011 at 2:40 PM, Corentin Dupont
>> <corentin.dupont at gmail.com> wrote:
>> > Hello,
>> >
>> > I'm using the combination happstack + digestive-functors + web-routes +
>> > blazeHTML.
>> > I'm not finding any examples on the net...
>> >
>> > I've tried to adapt your example (thanks):
>> >
>> > type NomicForm a = HappstackForm IO String BlazeFormHtml a
>> >
>> > demoForm :: NomicForm (Text, Text)
>> > demoForm =
>> > (,) <$> ((TDB.label "greeting: " ++> inputNonEmpty Nothing) <* br)
>> > <*> ((TDB.label "noun: " ++> inputNonEmpty Nothing) <* br)
>> > <* (submit "submit")
>> > where
>> > br :: NomicForm ()
>> > br = view H.br
>> > -- make sure the fields are not blank, show errors in line if they
>> are
>> > inputNonEmpty :: Maybe Text -> NomicForm Text
>> > inputNonEmpty v =
>> > (inputText v `validate` (TD.check "You can not leave this
>> field
>> > blank." (not . T.null)) <++ errors)
>> >
>> >
>> > But I've got a problem on submit and inputText. I don't see how they are
>> > compatible with HappstackForm.
>> > NomicForm a reduces to:
>> > Form (ServerPartT IO) Input String BlazeFormHtml a
>> >
>> > whereas the type of submit is:
>> >
>> > submit :: Monad m
>> >
>> > => String -- ^ Text on the submit
>> button
>> >
>> > -> Form m String e BlazeFormHtml () -- ^ Submit button
>> >
>> >
>> > Maybe I miss some instance?
>> >
>> > BTW, I also tried to execute your exemple, but I can't install some
>> > packages.
>> >
>> >> cabal install digestive-functors-hsp
>> >
>> > cabal: Unknown build tool trhsx
>> >
>> > Whereas trhsx is in my PATH (under linux).
>> >
>> > You said I need the latest happstack from darcs, why?
>> >
>> > Cheers,
>> > Corentin
>> >
>> > On Sun, Jan 9, 2011 at 8:36 PM, Jeremy Shaw <jeremy at n-heptane.com>
>> wrote:
>> >>
>> >> Hello,
>> >>
>> >> newRule also needs to have the type, RoutedNomicServer. The
>> >> transformation of RoutedNomicServer into NomicServer is done in the
>> >> handleSite function. Something like this:
>> >>
>> >>
>> >> nomicSpec :: ServerHandle -> Site Route (ServerPartT IO Response)
>> >> nomicSpec sh =
>> >> Site { handleSite = \f url -> unRouteT (nomicSite sh url)
>> f
>> >> ...
>> >>
>> >> main =
>> >> do ...
>> >> simpleHTTP nullConf $ siteImpl (nomicSpec sh)
>> >>
>> >> Or something like that -- it's hard to tell exactly what is going on
>> >> in your app based on the snippets you provided.
>> >>
>> >> Also, I highly recommend using digestive functors instead of formlets.
>> >> It is the successor to formlets. Same core idea, better implementation
>> >> and actively maintained.
>> >>
>> >> I have attached a quick demo of using:
>> >>
>> >> happstack+digestive-functors+web-routes+HSP
>> >>
>> >> To use it you will need the latest happstack from darcs plus:
>> >>
>> >> hsp
>> >> web-routes
>> >> web-routes-hsp
>> >> web-routes-happstack
>> >> web-routes-mtl
>> >> digestive-functors
>> >> digestive-functors-hsp
>> >>
>> >> I plan to clean up this example and document it better in the crash
>> >> course for the upcoming release. Clearly things like the FormInput
>> >> instance and the formPart function belong a library.
>> >>
>> >> let me know if you have more questions.
>> >> - jeremy
>> >>
>> >> On Sat, Jan 8, 2011 at 6:44 PM, Corentin Dupont
>> >> <corentin.dupont at gmail.com> wrote:
>> >> > Hello,
>> >> >
>> >> > I have difficulties mixing web-routes and forms:
>> >> > I have put routes in all my site, except for forms which remains with
>> >> > the
>> >> > type ServerPartT IO Response.
>> >> > How to make them work together?
>> >> >
>> >> > I have:
>> >> > type NomicServer = ServerPartT IO
>> >> > type RoutedNomicServer = RouteT PlayerCommand NomicServer
>> >> >
>> >> > newRule :: ServerHandle -> NomicServer Response
>> >> > newRule sh = do
>> >> > methodM POST -- only accept a post method
>> >> > mbEntry <- getData -- get the data
>> >> > case mbEntry of
>> >> > Nothing -> error $ "error: newRule"
>> >> > Just (NewRule name text code pn) -> do
>> >> > html <- nomicPageComm pn sh (submitRule name text code pn))
>> >> > ok $ toResponse html
>> >> >
>> >> >
>> >> > nomicPageComm :: PlayerNumber -> ServerHandle -> Comm () ->
>> >> > RoutedNomicServer Html
>> >> > nomicPageComm pn sh comm =
>> >> > (..)
>> >> >
>> >> >
>> >> > launchWebServer :: ServerHandle -> IO ()
>> >> > launchWebServer sh = do
>> >> > putStrLn "Starting web server...\nTo connect, drive your browser
>> to
>> >> > \"http://localhost:8000/Login\ <http://localhost:8000/Login%5C>""
>> >> > d <- liftIO getDataDir
>> >> > simpleHTTP nullConf $ mconcat [dir "postLogin" $ postLogin,
>> >> > fileServe [] d,
>> >> > dir "Login" $ ok $ toResponse $
>> >> > loginPage,
>> >> > dir "NewRule" $ newRule sh,
>> >> > dir "NewGame" $ newGameWeb sh,
>> >> > dir "Nomic" $ do
>> >> > html <- implSite
>> >> > "http://localhost:8000/Nomic/" "" (nomicSite sh)
>> >> > ok $ toResponse html
>> >> > ]
>> >> >
>> >> >
>> >> > The red line doesn't compile. I don't know how to transform a
>> >> > RoutedNomicServer into a NomicServer.
>> >> >
>> >> > For the future I intend to use formlets: is these some examples of
>> >> > programs
>> >> > using happstack + web-routes + formlets?
>> >> >
>> >> > Thanks,
>> >> > Corentin
>> >> >
>> >> >
>> >> >
>> >> >
>> >> > On Fri, Jan 7, 2011 at 5:10 PM, Jeremy Shaw <jeremy at n-heptane.com>
>> >> > wrote:
>> >> >>
>> >> >> Hello,
>> >> >>
>> >> >> The [(String, String)] argument is for adding query parameters.
>> >> >>
>> >> >> > encodePathInfo ["foo", "bar", "baz"] [("key","value")]
>> >> >>
>> >> >> "foo/bar/baz?key=value"
>> >> >>
>> >> >> Instead of showURL you would use showURLParams.
>> >> >>
>> >> >> hope this helps!d
>> >> >> - jeremy
>> >> >>
>> >> >> On Fri, Jan 7, 2011 at 8:12 AM, Corentin Dupont
>> >> >> <corentin.dupont at gmail.com> wrote:
>> >> >> > Hello Jeremy,
>> >> >> > I'm using Web routes with happstack.
>> >> >> > I'm following this tutorial:
>> >> >> > http://tutorialpedia.org/tutorials/Happstack+type+safe+URLs.html
>> >> >> >
>> >> >> > But It seems out of synch with the latest version of web-routes:
>> >> >> > 0.23.2.
>> >> >> > The haddock documentation seems out of date also:
>> >> >> >
>> >> >> > encodePathInfo :: [String] -> [(String, String)] -> String
>> >> >> >
>> >> >> > For example:
>> >> >> >
>> >> >> > encodePathInfo [\"foo\", \"bar\", \"baz\"]
>> >> >> >
>> >> >> > "foo/bar/baz"
>> >> >> >
>> >> >> > And I can't figure out what this [(String, String)] is for ;)
>> >> >> >
>> >> >> > Thanks,
>> >> >> >
>> >> >> > Corentin
>> >> >> >
>> >> >
>> >> >
>> >
>> >
>>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110121/a3e3e32b/attachment-0001.htm>
More information about the Haskell-Cafe
mailing list