Like 6.115, 6.947 is a chance to remember why you came to mit: to learn and to build. @@ -101,7 +70,7 @@ and main () = and forum () = forumWorker Forum.main and forumWorker (f : unit -> xbody) = return (generic (Some "Forum") - {header (make [#Forum] ())} + {Menu.header (make [#Forum] ())} {f ()} ) diff --git a/menu.ur b/menu.ur new file mode 100644 index 0000000..4be6d3d --- /dev/null +++ b/menu.ur @@ -0,0 +1,57 @@ +(* Menu -- site menu +Copyright (C) 2013 Benjamin Barenblat + +This file is a part of 6.947. + +6.947 is is free software: you can redistribute it and/or modify it under the +terms of the GNU Affero General Public License as published by the Free +Software Foundation, either version 3 of the License, or (at your option) any +later version. + +6.947 is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. See the GNU Affero General Public License for more +details. + +You should have received a copy of the GNU Affero General Public License along +with 6.947. If not, see . *) + +(* Generating nice headings and menus is quite difficult in Ur/Web--there are a +lot of links that the compiler needs to be convinced aren't broken. I tried +for multiple weeks to get a nice, typesafe solution to this; however, it was +just too brittle. I've instead settled for a simpler solution--pass the URLs +of the pages the menu links to to 'bless'. It's a bit sketchy, but it works, +and it's no more unsafe than anything you'd do in a "normal" Web framework. *) + +open Styles + +con pageName = variant (mapU unit [Main, Forum]) + +(* Generates the link text *) +fun getName (n : pageName) : xbody = + match n { Main = fn () => Main, + Forum = fn () => Forum } + +(* Generates the link URL *) +fun getUrl (n : pageName) : url = + let val base = "/urweb/6.947" + in + match n { Main = fn () => bless (base ^ "/index"), + Forum = fn () => bless (base ^ "/forum") } + end + +(* Actual title and menu generation code *) +fun header (current : pageName) : xbody = + let fun item (target : pageName) = + if Variant.eq current target + then

{getName target}

+ else

+ in + +

6.947 – Functional Programming Project Laboratory

+ + + end diff --git a/menu.urs b/menu.urs new file mode 100644 index 0000000..0372aab --- /dev/null +++ b/menu.urs @@ -0,0 +1,23 @@ +(* Menu -- site menu +Copyright (C) 2013 Benjamin Barenblat + +This file is a part of 6.947. + +6.947 is is free software: you can redistribute it and/or modify it under the +terms of the GNU Affero General Public License as published by the Free +Software Foundation, either version 3 of the License, or (at your option) any +later version. + +6.947 is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. See the GNU Affero General Public License for more +details. + +You should have received a copy of the GNU Affero General Public License along +with 6.947. If not, see . *) + +(* The menu scheme in this app is based on a variant 'pageName', which +describes the name of the page. There's one value for each page. *) +con pageName = variant (mapU unit [Main, Forum]) + +val header : pageName -> xbody diff --git a/site.urp b/site.urp index 287c010..03d4efe 100644 --- a/site.urp +++ b/site.urp @@ -1,7 +1,9 @@ -prefix /urweb/6.947/site.exe/ +prefix /urweb/6.947/ +allow url /urweb/6.947/index +allow url /urweb/6.947/forum allow url file:///afs/athena.mit.edu/user/b/b/bbaren/web_scripts/urweb/6.947/ allow url //www.youtube.com/watch?v=OyRW9uFSmh0 -allow url //bbaren.scripts.mit.edu/urweb/6.947/site.css +allow url //bbaren.scripts.mit.edu/urweb/6.947-static/site.css allow url //web.mit.edu/6.115/www/ allow url //gnu.org/licenses/agpl rewrite style Styles/smallCaps smallCaps @@ -10,8 +12,11 @@ rewrite style Styles/navBar navBar rewrite style Styles/active active rewrite style Styles/content content rewrite style Styles/footer footer +rewrite url Main/main index +rewrite url Main/* library meta library forum styles +menu main -- cgit v1.2.3