[Haskell-cafe] web-routes and forms

Jeremy Shaw jeremy at n-heptane.com
Sat Jan 22 21:49:14 CET 2011


Hello,

I believe you problem is because you are trying to use 'dir' inside
RouteT after you have already consumed and decode the path info using
implSite.

There are two solutions here:

 1. just use web-routes for all your URLs instead of using a mixture
of type-safe routes and 'dir'.
 2. put the calls to dir outside the call to implSite.

For example, something like,

   simpleHTTP nullConf $ msum [ dir "Login" $ loginPage,
                                                , dir "postLogin" $ postLogin
                                                , implSite
"http://localhost:8000/" "" (nomicSite sh)
                                                ]

You to do that, you would also need to modified loginPage and
postLogin to not be in the RoutedNomicServer monad. Since they do not
appear to use the RouteT stuff anyway, that should not be hard ?

But, personally, I would just choose option #1. Can you explain why
you thought it was better to mix the web-routes stuff with the 'dir'
style guards? Maybe there is a short coming in web-routes that needs
to be addressed ?

- jeremy

On Fri, Jan 21, 2011 at 2:33 PM, Corentin Dupont
<corentin.dupont at gmail.com> wrote:
> 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\""
>>> >> >    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
>>> >> >> >
>>> >> >
>>> >> >
>>> >
>>> >
>>
>
>



More information about the Haskell-Cafe mailing list