update page

Author: ranjitjhala

README.md

@@ -4,7 +4,7 @@ LiquidHaskell is a static verifier for Haskell, based on **Liquid Types**
 
 See [about](about.md) for more details.
 
-## Build 
+## Build
 
 To add a new post:
 
@@ -13,8 +13,10 @@ To add a new post:
 
 ## TODO
 
-1. Posts
-2. Archive
-3. Disqus
-4. [Tags](https://javran.github.io/posts/2014-03-01-add-tags-to-your-hakyll-blog.html)
-5. [Teasers](https://jaspervdj.be/hakyll/tutorials/using-teasers-in-hakyll.html)
++ Posts
++ Index
++ Archive
++ Error
+- Disqus
+- [Teasers](https://jaspervdj.be/hakyll/tutorials/using-teasers-in-hakyll.html)
+- [Tags](https://javran.github.io/posts/2014-03-01-add-tags-to-your-hakyll-blog.html)

about.md

@@ -4,6 +4,7 @@ comments: false
 sharing: true
 footer: true
 headerImg: sea.jpg
+demo: SimpleRefinements.hs
 ---
 
 LiquidHaskell is a static verifier for Haskell, based on **Liquid Types**

blog.hs

@@ -1,8 +1,13 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE OverloadedStrings #-}
-import Data.Monoid (mappend)
-import Hakyll
-import Text.Pandoc
+import           Text.Pandoc
+import           Data.Maybe (fromMaybe)
+import           Data.Monoid (mappend)
+import           Hakyll
+import           System.FilePath ( (</>), (<.>)
+                                 , splitExtension, splitFileName
+                                 , takeDirectory )
+
 
 --------------------------------------------------------------------------------
 main :: IO ()
@@ -11,40 +16,116 @@ main = hakyll $ do
     route idRoute
     compile copyFileCompiler
 
-  match (fromList tops) $ do
+  match (fromList [{- "index.md", -} "about.md"]) $ do
     route   $ setExtension "html"
     compile $ pandocCompiler
             >>= loadAndApplyTemplate "templates/page.html"    siteCtx
             >>= loadAndApplyTemplate "templates/default.html" siteCtx
             >>= relativizeUrls
 
+
+  -- create ["archive.html"] $ do
+    -- route idRoute
+    -- compile $ do
+      -- posts <- recentFirst =<< loadAll "posts/*"
+      -- let archiveCtx = listField "posts" postCtx (return posts) `mappend`
+                       -- constField "title" "Archives"            `mappend`
+                       -- siteCtx
+
+      -- makeItem ""
+            -- >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
+            -- >>= loadAndApplyTemplate "templates/default.html" archiveCtx
+            -- >>= relativizeUrls
+
+
   match "posts/*" $ do
-    route $ setExtension "html"
+    route $ setExtension "html" `composeRoutes`
+            dateFolders         `composeRoutes`
+            dropPostsPrefix     `composeRoutes`
+            -- prependCategory     `composeRoutes`
+            appendIndex
     compile $ pandocCompiler
-            >>= loadAndApplyTemplate "templates/post.html"    postCtx
-            >>= loadAndApplyTemplate "templates/default.html" postCtx
-            >>= relativizeUrls
+        >>= loadAndApplyTemplate "templates/post.html"    postCtx
+        >>= loadAndApplyTemplate "templates/default.html" postCtx
+        >>= relativizeUrls
 
   create ["archive.html"] $ do
-    route idRoute
+    route appendIndex
     compile $ do
       posts <- recentFirst =<< loadAll "posts/*"
       let archiveCtx = listField "posts" postCtx (return posts) `mappend`
                        constField "title" "Archives"            `mappend`
+                       constField "demo"  "SimpleRefinements.hs"      `mappend`
+                       dropIndexHtml "url"                      `mappend`
                        siteCtx
 
       makeItem ""
-            >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
-            >>= loadAndApplyTemplate "templates/default.html" archiveCtx
+        >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
+        >>= loadAndApplyTemplate "templates/default.html" archiveCtx
+        >>= relativizeUrls
+
+  match (fromList [{- "index.md", -} "about.md"]) $ do
+    route   $ setExtension "html"
+    compile $ pandocCompiler
+            >>= loadAndApplyTemplate "templates/page.html"    siteCtx
+            >>= loadAndApplyTemplate "templates/default.html" siteCtx
             >>= relativizeUrls
 
+  match "index.md" $ do
+    route   $ setExtension "html"
+    compile $ do
+      posts <- fmap (take 5) . recentFirst =<< loadAll "posts/*"
+      let indexCtx = listField "posts" postCtx (return posts) `mappend`
+                     -- constField "title" "Home"                `mappend`
+                     constField "demo"  "SimpleRefinements.hs"      `mappend`
+                     dropIndexHtml "url"                      `mappend`
+                     siteCtx
+
+      -- getResourceBody
+      pandocCompiler
+        >>= applyAsTemplate indexCtx
+        >>= loadAndApplyTemplate "templates/index.html"   indexCtx
+        >>= loadAndApplyTemplate "templates/default.html" indexCtx
+        >>= relativizeUrls
+
   match "templates/*" $ compile templateCompiler
 
+
+
+appendIndex :: Routes
+appendIndex = customRoute $ (\(p, e) -> p </> "index" <.> e) . splitExtension . toFilePath
+
+transform :: String -> String
+transform url = case splitFileName url of
+                  (p, "index.html") -> takeDirectory p
+                  _                 -> url
+
+dropIndexHtml :: String -> Context a
+dropIndexHtml key = mapContext transform (urlField key)
+  where
+    transform url = case splitFileName url of
+                      (p, "index.html") -> takeDirectory p
+                      _                 -> url
+
+dateFolders :: Routes
+dateFolders =
+  gsubRoute "/[0-9]{4}-[0-9]{2}-[0-9]{2}-" $ replaceAll "-" (const "/")
+
+dropPostsPrefix :: Routes
+dropPostsPrefix = gsubRoute "posts/" $ const ""
+
+-- prependCategory :: Routes
+-- prependCategory = metadataRoute $ \md -> customRoute $
+--     let mbCategory = lookupString "category" md
+--        category   = fromMaybe (error "Posts: Post without category") mbCategory
+--    in  (category </>) . toFilePath
+
 --------------------------------------------------------------------------------
 postCtx :: Context String
 postCtx =
-    dateField "date" "%B %e, %Y" `mappend`
-    siteCtx
+  dateField "date" "%b %e, %Y" `mappend`
+  dropIndexHtml "url"          `mappend`
+  siteCtx
 
 
 -- http://goto.ucsd.edu:8090/index.html#?demo=ANF.hs
@@ -63,9 +144,8 @@ siteCtx =
     constField "github_username"    "ucsd-progsys"              `mappend`
     constField "google_username"    "[email protected]"       `mappend`
     constField "google_userid"      "u/0/106612421534244742464" `mappend`
-    constField "demo"               "SimpleRefinements.hs"      `mappend`
+    -- constField "demo"               "SimpleRefinements.hs"      `mappend`
     constField "headerImg"          "sea.jpg"                   `mappend`
+    constField "summary"            "todo"                      `mappend`
+    constField "disqus_short_name"  "liquidhaskell"             `mappend`
     defaultContext
-
-tops :: [Identifier]
-tops = [ "index.md" , "about.md" ]