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