diff options
| -rw-r--r-- | main.ur | 37 | ||||
| -rw-r--r-- | menu.ur | 57 | ||||
| -rw-r--r-- | menu.urs | 23 | ||||
| -rw-r--r-- | site.urp | 9 |
4 files changed, 90 insertions, 36 deletions
@@ -30,7 +30,7 @@ fun generic (pageName : option string) (content : xbody) : xhtml [] [] = <xml> <head> <title>{[titleString]}</title> - <link rel="stylesheet" type="text/css" href="//bbaren.scripts.mit.edu/urweb/6.947/site.css"/> + <link rel="stylesheet" type="text/css" href="//bbaren.scripts.mit.edu/urweb/6.947-static/site.css"/> </head> <body> {content} @@ -53,42 +53,11 @@ fun generic (pageName : option string) (content : xbody) : xhtml [] [] = end -(******************************* Page headings *******************************) - -(* 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. The link -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]) - -(* 'getName' generates the link text given a 'pageName'. *) -fun getName (n : pageName) : xbody = - match n { Main = fn () => <xml>Main</xml>, - Forum = fn () => <xml>Forum</xml> } - -(* Now we can do the actual title and menu generation code. *) -fun header (current : pageName) : xbody = - let fun item (target : pageName) (page : unit -> transaction page) = - if Variant.eq current target - then <xml><li class={active}>{getName target}</li></xml> - else <xml><li><a link={page ()}>{getName target}</a></li></xml> - in - <xml> - <h1 class={siteTitle}><a link={main ()}>6.947 – Functional Programming Project Laboratory</a></h1> - <ul class={navBar}> - {item (make [#Main] ()) main} - {item (make [#Forum] ()) forum} - </ul> - </xml> - end - - (*********************************** Pages ***********************************) and main () = return (generic None <xml> - {header (make [#Main] ())} + {Menu.header (make [#Main] ())} <div class={content}> <p> Like <a href="//web.mit.edu/6.115/www/">6.115</a>, 6.947 is a chance to remember why you came to <span class={smallCaps}>mit</span>: 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") <xml> - {header (make [#Forum] ())} + {Menu.header (make [#Forum] ())} {f ()} </xml>) @@ -0,0 +1,57 @@ +(* Menu -- site menu +Copyright (C) 2013 Benjamin Barenblat <bbaren@mit.edu> + +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 <http://www.gnu.org/licenses/>. *) + +(* 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 () => <xml>Main</xml>, + Forum = fn () => <xml>Forum</xml> } + +(* 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 <xml><li class={active}>{getName target}</li></xml> + else <xml><li><a href={getUrl target}>{getName target}</a></li></xml> + in + <xml> + <h1 class={siteTitle}><a href={getUrl (make [#Main] ())}>6.947 – Functional Programming Project Laboratory</a></h1> + <ul class={navBar}> + {item (make [#Main] ())} + {item (make [#Forum] ())} + </ul> + </xml> + 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 <bbaren@mit.edu> + +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 <http://www.gnu.org/licenses/>. *) + +(* 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 @@ -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 |