summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--main.ur37
-rw-r--r--menu.ur57
-rw-r--r--menu.urs23
-rw-r--r--site.urp9
4 files changed, 90 insertions, 36 deletions
diff --git a/main.ur b/main.ur
index b498861..1d3483b 100644
--- a/main.ur
+++ b/main.ur
@@ -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 &ndash; 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>)
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 <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 &ndash; 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
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