Generalize some names and hide implementation details.

CCWF.hs

@@ -0,0 +1,11 @@
+-- | Chalmers course 
+module CCWF
+  ( -- * Configuring and updating pages
+    Website (..), Info (..), Materials (..)
+  , URL, Teacher (..), Lecture (..)
+
+    -- * Building the website
+  , mkWebsite
+  ) where
+import CCWF.Config
+import CCWF.Impl

CCWF/Config.hs

@@ -0,0 +1,75 @@
+-- | Per-website configuration for CCWF.
+module CCWF.Config where
+
+type URL = String
+
+-- | A course website consists of relatively static course information, and
+--   relatively static course materials.
+data Website = Website
+  { courseInfo      :: Info
+  , courseMaterials :: Materials
+  }
+
+-- | Lectures, files and news items: course materials that will likely be
+--   updated frequently.
+data Materials = Materials
+  { -- | Latest news for the course, in order from newest to latest.
+    --   Can contain markdown.
+    newsItems      :: [String]
+    -- | All lectures for the course. These make up the table on the @lectures@
+    --   page.
+  , lectures       :: [Lecture]
+    -- | Files that are related to the course, but not tied to any particular
+    --   lecture.
+  , miscFiles      :: [FilePath]
+  }
+
+-- | Course information: this should change only about once per year.
+data Info = Info
+  { -- | The main teacher of the course.
+    teacher        :: Teacher
+    -- | The examiner of the course, if different from the main teacher.
+  , examiner       :: Maybe Teacher
+    -- | Any assistants working on the course.
+    --   The name, email, etc. of the first assistant in the list are accessible
+    --   as @assistant@, @assistantemail@, etc.
+  , assistants     :: [Teacher]
+    -- | URL of the course syllabus. This is mandatory for all Chalmers courses.
+  , syllabusURL    :: URL
+    -- | URL of the course's Google group, if any.
+  , googleGroupURL :: Maybe URL
+    -- | URL of the course's lab submission system, if any.
+  , submissionURL  :: Maybe URL
+    -- | URL of external schedule for course, if any.
+  , scheduleURL    :: Maybe URL
+    -- | All lab deadlines.
+  , labDeadlines   :: [String]
+  }
+
+-- | Bio for the teacher responsible for the course.
+--   Name, phone and email are mandatory.
+data Teacher = Teacher
+  { -- | Full name of teacher.
+    teacherName   :: String
+    -- | Work email.
+  , teacherEmail  :: String
+    -- | Work phone.
+  , teacherPhone  :: String
+    -- | Does the teacher have a biography?
+  , teacherBioURL :: Maybe URL
+    -- | Room number of/directions to teacher's office.
+  , teacherOffice :: Maybe String
+    -- | Office hours, when the teacher is available for answering questions.
+  , teacherHours  :: Maybe String
+  }
+
+-- | An entry in the list of course lectures.
+data Lecture = Lecture
+  { -- | When did the lecture take place?
+    lectureDate        :: String
+    -- | What was it about? Preferably one (short) sentence.
+  , lectureDescription :: String
+    -- | Any auxilliary material associated with the course.
+    --   These files need to be present in the @files@ directory.
+  , lectureFiles       :: [(String, FilePath)]
+  }

CCWF/Impl.hs

@@ -0,0 +1,217 @@
+{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections #-}
+module CCWF.Impl where
+import Hakyll
+import Control.Monad
+import Data.Char
+import Data.List
+import Data.Time
+import Data.Function (on)
+import System.Directory (doesFileExist)
+import System.FilePath (takeBaseName)
+import Text.Read
+import CCWF.Config
+
+-- | Build a website from a configuration.
+mkWebsite :: Website -> IO ()
+mkWebsite (Website (Info{..}) (Materials{..})) = do
+  -- Check that all lecture files are present
+  (courseYear, _, _) <- toGregorian . utctDay <$> getCurrentTime
+  let files = [ "./files/" ++ file
+              | fs <- map lectureFiles lectures
+              , (_, file) <- fs
+              ] ++ map ("./files/" ++) miscFiles
+  files' <- filterM (fmap not . doesFileExist) files
+  unless (null files') $ do
+    putStrLn $ "The following essential files could not be found:"
+    forM_ files' $ putStrLn . ("  " ++)
+    error "Some files were missing from the ./files directory!"
+
+  hakyll $ do
+    -- CSS files are just compressed
+    match "css/*" $ do
+      route idRoute
+      compile compressCssCompiler
+
+    -- JS files are just copied
+    match "js/*" $ do
+      route idRoute
+      compile copyFileCompiler
+
+    -- Images too
+    match "images/*" $ do
+      route idRoute
+      compile copyFileCompiler
+
+    -- Lectures files are copied into files/
+    match "files/*" $ do
+      route idRoute
+      compile copyFileCompiler
+
+    -- Don't do anything fancy with templates
+    match "templates/*" $ do
+      compile templateCompiler
+
+    -- Add an explicit dependency on this file
+    match "website.hs" $ do
+      compile $ makeItem ()
+    hsdep <- makePatternDependency "website.hs"
+
+    -- Pages are read from the @pages@ subdirectory.
+    rulesExtraDependencies [hsdep] $ match "pages/*.md" $ do
+      route $ gsubRoute "pages/" (const "")
+            `composeRoutes` gsubRoute ".md" (const "")
+            `composeRoutes` customRoute (mkPath . toFilePath)
+      compile $ do
+        metas <- getAllMetadata "pages/*.md"
+        self <- takeBaseName <$> getResourceFilePath
+        let -- Menu items, sorted by their menuorder metadata entry.
+            -- Items without menuorder are sorted randomly among themselves,
+            -- after any entries with a specified order.
+            menuitems = map snd $ sortBy (\a b -> compare (fst a) (fst b)) $
+              [ (menuOrder meta, Item (noIndex ident) title)
+              | (ident, meta) <- metas
+              , Just title <- [lookupString "title" meta]
+              ]
+            -- Context for the page content; contains metadata set in the
+            -- markdown file for each page, as well as some info set at the
+            -- top of this file.
+            ctx = mconcat
+              [ constField "year" (show courseYear)
+              , constField "syllabus" syllabusURL
+              , constField "group" (maybe "" id googleGroupURL)
+              , constField "submissions" (maybe "" id submissionURL)
+              , constField "schedule" (maybe "" id scheduleURL)
+              , constField "S" "$"
+              , mconcat
+                  [ constField ("deadline" ++ show num) date
+                  | (date, num) <- zip labDeadlines [1..]
+                  ]
+              , teacherFields "teacher" teacher
+              , maybe mempty (teacherFields "examiner") examiner
+              , case assistants of
+                  (ass:_) -> teacherFields "assistant" ass
+                  _       -> mempty
+              , listField "assistants" mkTeacherListItemCtx (pure assistantItems)
+              , listField "menuitems" (mkMenuCtx self)
+                                      (pure menuitems)
+              , listField "lectures" mkLectureCtx
+                                     (zipWithM (curry makeItem) [1..] lectures)
+              , if length newsItems > 3
+                  then listField "news" defaultContext (pure newsItemItems)
+                  else mempty
+              , listField "latestnews" defaultContext (pure $ take 3 newsItemItems)
+              , defaultContext
+              ]
+        applyMeAsTemplate ctx ctx
+  where
+    newsItemItems = map (Item (fromFilePath "")) newsItems
+    assistantItems = map (Item (fromFilePath "")) assistants
+
+-- | Create a list item context for a teacher.
+--   Used for the list of assistants.
+mkTeacherListItemCtx :: Context Teacher
+mkTeacherListItemCtx = mconcat
+  [ field "full" $ \(Item _ t) -> pure $ teacherName t
+  , field "email" $ \(Item _ t) -> pure $ teacherEmail t
+  , field "bio" $ \(Item _ t) -> pure $ maybe "" id $ teacherBioURL t
+  , field "phone" $ \(Item _ t) -> pure $ teacherPhone t
+  , field "office" $ \(Item _ t) -> pure $ maybe "" id $ teacherOffice t
+  , field "hours" $ \(Item _ t) -> pure $ maybe "" id $ teacherHours t
+  ]
+
+-- | Create context fields for a teacher.
+teacherFields :: String -> Teacher -> Context a
+teacherFields prefix (Teacher {..}) = mconcat
+  [ constField prefix (head $ words teacherName)
+  , constField (prefix ++ "full") teacherName
+  , constField (prefix ++ "email") teacherEmail
+  , constField (prefix ++ "bio") (maybe "" id teacherBioURL)
+  , constField (prefix ++ "phone") teacherPhone
+  , maybe mempty (constField (prefix ++ "office")) teacherOffice
+  , maybe mempty (constField (prefix ++ "hours")) teacherHours
+  ]
+
+-- | Get the menu order from a piece of metadata.
+menuOrder :: Metadata -> Int
+menuOrder meta =
+  maybe 1000000
+    (round :: Double -> Int)
+    (readMaybe =<< lookupString "menuorder" meta)
+
+-- | Set the CSS class of a menu item based on its identifier and the
+--   identifier of the current page. If the identifier matches the current
+--   page, the item should be displayed as selected.
+menuItemClass :: String -> Item a -> String
+menuItemClass current itm
+  | current == takeBaseName (toFilePath (itemIdentifier itm)) =
+    "selected"
+  | current == "index" && null (toFilePath (itemIdentifier itm)) =
+    "selected"
+  | otherwise =
+    "unselected"
+
+mkLectureCtx :: Context (Int, Lecture)
+mkLectureCtx = mconcat
+  [ field "date" $ \(Item _ (_, l)) -> do
+      pure $ lectureDate l
+  , field "description" $ \(Item _ (_, l)) -> do
+      pure $ show $ lectureDescription l
+  , listFieldWith "lecturefiles" defaultContext $ \(Item _ (_, l)) -> do
+      pure $ [ Item (fromFilePath file) name
+             | (name, file) <- lectureFiles l]
+  , field "number" $ \(Item _ (n, _)) -> 
+      pure $ show n
+  ]
+
+-- | Build the context for the menu. The @submenuitems@ field will contain all
+--   sub-menu items for the currently active page.
+--   Note that URLs are relativized in a horrible, hacky way, which needs to
+--   be changed if the directory hierarchy of the course homepage changes.
+mkMenuCtx :: String
+          -> Context String
+mkMenuCtx self = mconcat
+  [ field "selected" (pure . menuItemClass self)
+  , listFieldWith "submenuitems" defaultContext $ \itm -> do
+      when (takeBaseName (toFilePath (itemIdentifier itm)) /= self) $ do
+        fail "not my submenu"
+      submenuitems <- words <$> getMetadataField' (itemIdentifier itm) "submenu"
+      forM (zip (mkTitles submenuitems) submenuitems) $ \(title, ident) -> do
+        pure $ Item (fromFilePath $ "#" ++ ident) title
+  , field "url" $ pure . itemToUrl
+  , defaultContext
+  ]
+  where
+    itemToUrl = ("/" ++) . takeBaseName . toFilePath . itemIdentifier
+    mkTitles = map capitalize . map toSpaces
+
+    capitalize (x:xs) = toUpper x : xs
+
+    toSpaces = map toSpace
+
+    toSpace '_' = ' '
+    toSpace c   = c
+
+-- | Render the current page as markdown, then use the current page as a
+--   template (i.e. it may include substitutions), and render it as markdown
+--   again. Finally, apply the default template to the end result and
+--   relativize all URLs.
+applyMeAsTemplate :: Context String -> Context String -> Compiler (Item String)
+applyMeAsTemplate pageCtx topCtx = do
+  getResourceBody
+    >>= renderPandoc
+    >>= applyAsTemplate pageCtx
+    >>= renderPandoc
+    >>= loadAndApplyTemplate "templates/default.html" topCtx
+    >>= relativizeUrls
+
+-- | Turn a path @p@ (stripped of prefix and extension) into @p/index.html@.
+mkPath :: FilePath -> FilePath
+mkPath "index" = "index.html"
+mkPath p       = p ++ "/index.html"
+
+-- | Turn an identifier into an empty identifier if the identifier is @index@,
+--   otherwise return the identifier unchanged.
+noIndex :: Identifier -> Identifier
+noIndex ident
+  | takeBaseName (toFilePath ident) == "index" = fromFilePath ""
+  | otherwise                                  = ident

pages/about.md

@@ -100,4 +100,4 @@ instructions. Two things should be noted:
     The second step is to actually submit your solution, by clicking the
     *Submit* button. **It is not enough to only upload; you must also submit!**
 
-[Go to the submission system](\$fire\$)
+[Go to the submission system](\$submissions\$)

pages/lectures.md

@@ -9,7 +9,7 @@ Lectures
 
 Lectures take place on Tuesdays 13-15 in EL41 and Fridays 13-15 in EL42.
 Not all available times are used. The complete schedule is available in
-[TimeEdit](\$timeedit\$). Note that if you use an iCal or vCal-compatible
+[TimeEdit](\$schedule\$). Note that if you use an iCal or vCal-compatible
 calendar, you can download the course schedule from TimeEdit.
 
 The following is a preliminary plan for the lectures. Changes will be announced

pages/project.md

@@ -25,7 +25,6 @@ submenu: deadlines grading javalette frontend extensions testing code_generation
     * [x86 generation](#x86)
     * [Optimization study](#optstudy)
     * [Other extensions](#moreextensions)
-* [Testing](#testing)
 </div>
 
 
@@ -1351,7 +1350,7 @@ declare i32 @printf(i8*, ...) nounwind
 ```
 
 What remains is a definition of the format string `@fstr` as a global constant
-(`\0A` is `\n`), the `getelementpointer` instruction that returns a pointer to
+(`\\0A` is `\\n`), the `getelementpointer` instruction that returns a pointer to
 the beginning of the format string and a call to `printf` with the result value.
 Note that the call to `printInt` has been inlined, i.e. replaced by a call to
 `printf`; so linking includes optimizations across files.
@@ -1360,17 +1359,17 @@ We can now run `a.out.bc` using the just-in-time compiler `lli`.
 Or, if we prefer, we can produce native assembly code
 with `llc`. On my x86 machine, this gives
 
-```asm
+```
         .text
         .align  4,0x90
         .globl  _main
 _main:
-        subl    $$12, %esp
-        movl    $$5040, 4(%esp)
-        movl    $$_fstr, (%esp)
+        subl    $S$12, %esp
+        movl    $S$5040, 4(%esp)
+        movl    $S$_fstr, (%esp)
         call    _printf
         xorl    %eax, %eax
-        addl    $$12, %esp
+        addl    $S$12, %esp
         ret
         .cstring
 _fstr:                          ## fstr

pages/schedule.md

@@ -3,9 +3,9 @@ title: Schedule
 menuorder: 5
 ---
 
-<script>window.location.href = "$timeedit$";</script>
+<script>window.location.href = "$schedule$";</script>
 
 Schedule
 ========
 
-The official schedule for the course is available on [TimeEdit](\$timeedit\$).
+The official schedule for the course is available on [TimeEdit](\$schedule\$).