[Haskell-cafe] web-routes and forms
Jasper Van der Jeugt
jaspervdj at gmail.com
Sat Jan 22 09:18:23 CET 2011
Hello,
I forgot to upload the version with the fixed type of `submit`. It is
on hackage now as digestive-functors-blaze-0.0.2.1.
Cheers,
Jasper
On Fri, Jan 21, 2011 at 9: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
>>> >> >> >
>>> >> >
>>> >> >
>>> >
>>> >
>>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
More information about the Haskell-Cafe
mailing list