Insert rudimentary revision history into each article. Generate a dif…

…f to last version correctly (still needs pandoc rendering). Wrote some very basic templates.

.gitignore

@@ -6,3 +6,5 @@ cabal-dev
 *.chs.h
 _site
 _cache
+*.*~
+src/site

src/site.hs

@@ -1,12 +1,12 @@
 {-# LANGUAGE DeriveDataTypeable, Arrows, OverloadedStrings #-}
-import Control.Arrow (returnA, (>>>), arr)
+import Control.Arrow (returnA, (>>>), arr, (***))
 import Data.FileStore hiding (create)
 import Hakyll
 import Text.Blaze.Renderer.String (renderHtml)
 import Text.Blaze.Html5 ((!),toValue)
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
-import Data.Monoid (mempty, mconcat, mempty)
+import Data.Monoid (mempty, mconcat, mempty, mappend)
 import Data.List (elemIndex)
 import Data.Maybe (fromMaybe)
 import System.FilePath (combine, dropExtension, takeFileName)
@@ -16,17 +16,14 @@ type Diff = [(DI, [String])]
 fileStore :: FileStore
 fileStore = gitFileStore "/home/irv/Projects/whistlepig/articles"
 
-getRevisionList :: Compiler (String) (FilePath, [(Revision, Revision)])
+getRevisionList :: Compiler String (FilePath, [(Revision, Revision)])
 getRevisionList = unsafeCompiler $ \path -> do
-    revs <- getRevisions $ takeFileName path
-    return (path, makePairList revs)
-    -- makePairList [1..4] => [(1,2),(2,3),(3,4)]
-    where makePairList xs = [(y, x) | x <- xs, y <- xs, y == getListPrev x (reverse xs), x /= y]
+    lst <- getRevisions $ takeFileName path
+    putStrLn $ show $ lst
+    return (path, lst)
 
 getDiff :: Compiler (FilePath, [(Revision, Revision)]) Diff
 getDiff = unsafeCompiler $ \(page,rl) -> do
-    putStrLn page
-    putStrLn $ show $ rl
     diffs <- mapM (getFileDiff (takeFileName page) ) rl
     return $ concat diffs
 
@@ -43,20 +40,24 @@ renderDiff l = renderHtml $ H.pre ! A.class_ (attrCls (fst l)) $ diffCnt l
 getFileDiff :: FilePath -> (Revision, Revision) -> IO Diff
 getFileDiff f a = diff fileStore f (Just $ revId $ fst a) (Just $ revId $ snd a)
 
-getRevisions :: FilePath -> IO [Revision]
-getRevisions f = history fileStore [f] (TimeRange Nothing Nothing)
+getRevisions :: FilePath -> IO [(Revision, Revision)]
+getRevisions f = do
+    revList <- history fileStore [f] (TimeRange Nothing Nothing)
+    return $ makePairList revList
+    -- makePairList [1..4] => [(1,2),(2,3),(3,4)]
+    where makePairList xs = [(y, x) | x <- xs, y <- xs, y == getListPrev x (reverse xs), x /= y]
 
 getListPrev :: Eq a => a -> [a] -> a
 getListPrev i l = l !! checkBounds (fromMaybe 0 (i `elemIndex` l) +1 )
     where checkBounds x | x > length l -1 = length l-1 | otherwise = x
 
 constructDiff :: String -> Diff -> Compiler () (Page String)
-constructDiff i d = constA (mempty)
+constructDiff i d = constA mempty
     >>> arr (setField "diff" (diff' d))
     >>> arr (setField "title" ("Changes " ++ i))
     >>> applyTemplateCompiler "templates/diff.html"
     >>> applyTemplateCompiler "templates/default.html"
-    where diff' l =  concatMap renderDiff l
+    where diff' =  concatMap renderDiff
 
 makeRevisionCompiler ::
         Compiler (Page String)
@@ -66,7 +67,7 @@ makeRevisionCompiler = proc page -> do
         diff' <- getDiff -< revisionList
         let gd = constructDiff (getField "path" page) diff'
         returnA -< (diff_ident revisionList, gd)
-    where diff_ident i = parseIdentifier $ ("diffs/" ++   (revId ( fst $ head $ snd i))) ++ ("_" ++  (revId ( fst $ head $ snd i))) ++ ".markdown"
+    where diff_ident i = parseIdentifier $ ("diffs/" ++ revId ( fst $ head $ snd i)) ++ ("_" ++ revId ( snd $ head $ snd i)) ++ ".markdown"
 --     where diff_ident (_, (b,c):_) =  parseIdentifier $ "diffs/" ++ (show $ revId b) ++ "_" ++ (show $ revId c)
 --           diff_ident (a, []) = parseIdentifier $ a
 
@@ -76,37 +77,29 @@ routePage = customRoute fileToDirectory
 fileToDirectory :: Identifier a -> FilePath
 fileToDirectory = flip combine "index.html" . dropExtension . toFilePath
 
-makeTagList :: String
-            -> [Page String]
-            -> Compiler () (Page String)
-makeTagList tag posts =
-    constA (mempty, posts)
-        >>> addPostList
-        >>> arr (setField "title" ("Posts tagged &#8216;" ++ tag ++ "&#8217;"))
-        >>> applyTemplateCompiler "templates/posts.html"
-        >>> applyTemplateCompiler "templates/default.html"
-        >>> relativizeUrlsCompiler
-
-addPostList :: Compiler (Page String, [Page String]) (Page String)
-addPostList = setFieldA "posts" $
-    arr (reverse . chronological)
-        >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p)
-        >>> arr mconcat
-        >>> arr pageBody
-
--- addRevisionList :: Compiler (Page String) (Page String)
--- addRevisionList = unsafeCompiler $ \path -> do
---     -- helpfully, returns empty list if filepath can't be found
---     let rev = path >>> getRevisionList  
---     --let rev' = applyRender rev
---     return $ arr( setField "history" $ concatMap renderRevision rev)
---     --where applyRender rev = concatMap renderRevision rev
+-- makeTagList :: String
+--             -> [Page String]
+--             -> Compiler () (Page String)
+-- makeTagList tag posts =
+--     constA (mempty, posts)
+--         >>> addPostList
+--         >>> arr (setField "title" ("Posts tagged &#8216;" ++ tag ++ "&#8217;"))
+--         >>> applyTemplateCompiler "templates/posts.html"
+--         >>> applyTemplateCompiler "templates/default.html"
+--         >>> relativizeUrlsCompiler
+
+-- addPostList :: Compiler (Page String, [Page String]) (Page String)
+-- addPostList = setFieldA "posts" $
+--     arr (reverse . chronological)
+--         >>> require "templates/postitem.html" (\p t -> map (applyTemplate t) p)
+--         >>> arr mconcat
+--         >>> arr pageBody
 
 addRevisionList :: Compiler (Page String) (Page String)
-addRevisionList = proc page -> do
-    (_,rev) <- getRevisionList -< (getField "path" page)
-    let h = concatMap renderRevision rev
-    returnA -< ( setFieldA "history" h )
+addRevisionList = unsafeCompiler $ \page -> do
+    let path = getField "path" page
+    lst <- getRevisions $ takeFileName path
+    return $ setField "history" (concatMap renderRevision lst) page
 
 renderRevision :: (Revision, Revision) -> String
 renderRevision rl = renderHtml $ H.tr $ do
@@ -117,6 +110,19 @@ renderRevision rl = renderHtml $ H.tr $ do
 
 main :: IO ()
 main = hakyll $ do
+    match "files/*" $ do
+        route idRoute
+        compile copyFileCompiler
+    -- Compress CSS
+    match "css/*" $ do
+        route   idRoute
+        compile compressCssCompiler
+
+    match "about/*" $ do
+        route $ setExtension ".html"
+        compile $ pageCompiler
+            >>> applyTemplateCompiler "templates/default.html"
+            >>> relativizeUrlsCompiler
     -- Render articles
     _ <- ($) match "articles/*" $ do
         route   $ setExtension ".html"
@@ -130,19 +136,29 @@ main = hakyll $ do
     group "diffs" $ match "articles/*" $
         metaCompile $ requireAll_ "articles/*"
             >>> mapCompiler makeRevisionCompiler
-    match "diffs/*" $ route $ setExtension ".html" 
-    _ <- ($) match "templates/*" $ compile templateCompiler
-
+    match "diffs/*" $ route $ gsubRoute "diffs/" (const "articles/diffs/") `composeRoutes` setExtension "html"
+    match "templates/*" $ compile templateCompiler
+   -- Index
+--     match "index.html" $ route idRoute
+--     create "index.html" $ constA mempty
+--         >>> arr (setField "title" "Home")
+--         >>> requireA "tags" (setFieldA "tagcloud" renderTagCloud')
+--         >>> requireAllA ("articles/*" `mappend` inGroup Nothing) (id *** arr (take 3 . reverse . chronological) >>> addPostList)
+--         >>> applyTemplateCompiler "templates/index.html"
+--         >>> applyTemplateCompiler "templates/default.html"
+--         >>> relativizeUrlsCompiler
         -- Tags
-    _ <- ($) create "tags" $
-        requireAll "articles/*" (\_ ps -> readTags ps :: Tags String)
-
-    -- Add a tag list compiler for every tag
-    match "tags/*" $ route $ setExtension ".html"
-    metaCompile $ require_ "tags"
-        >>> arr tagsMap
-        >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p)))
+--     _ <- ($) create "tags" $
+--         requireAll "articles/*" (\_ ps -> readTags ps :: Tags String)
+-- 
+--     -- Add a tag list compiler for every tag
+--     match "tags/*" $ route $ setExtension ".html"
+--     metaCompile $ require_ "tags"
+--         >>> arr tagsMap
+--         >>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p)))
     where
         tagIdentifier :: String -> Identifier (Page String)
         tagIdentifier = fromCapture "tags/*"
+        renderTagCloud' :: Compiler (Tags String) String
+        renderTagCloud' = renderTagCloud tagIdentifier 100 120
 

templates/404.html

@@ -0,0 +1,38 @@
+<!doctype html>
+<html>
+<head>
+  <meta charset="utf-8">
+  <title>Page Not Found :(</title>
+  <style>
+	  body { text-align: center;}
+	  h1 { font-size: 50px; text-align: center }
+	  span[frown] { transform: rotate(90deg); display:inline-block; color: #bbb; }
+	  body { font: 20px Constantia, 'Hoefler Text',  "Adobe Caslon Pro", Baskerville, Georgia, Times, serif; color: #999; text-shadow: 2px 2px 2px rgba(200, 200, 200, 0.5); }
+	  ::-moz-selection{ background:#FF5E99; color:#fff; }
+	  ::selection { background:#FF5E99; color:#fff; } 
+	  article {display:block; text-align: left; width: 500px; margin: 0 auto; }
+
+	  a { color: rgb(36, 109, 56); text-decoration:none; }
+	  a:hover { color: rgb(96, 73, 141) ; text-shadow: 2px 2px 2px rgba(36, 109, 56, 0.5); }
+  </style>
+</head>
+<body>
+     <article>
+	  <h1>Not found <span frown>:(</span></h1>
+	   <div>
+	       <p>Sorry, but the page you were trying to view does not exist.</p>
+	       <p>It looks like this was the result of either:</p>
+	       <ul>
+		   <li>a mistyped address</li>
+		   <li>an out-of-date link</li>
+	       </ul>
+	   </div>
+
+	    <script>
+	    var GOOG_FIXURL_LANG = (navigator.language || '').slice(0,2),
+		GOOG_FIXURL_SITE = location.host;
+	    </script>
+	    <script src="http://linkhelp.clients.google.com/tbproxy/lh/wm/fixurl.js"></script>
+     </article>
+</body>
+</html>

templates/default.html

@@ -0,0 +1,65 @@
+<!doctype html>
+<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
+<!--[if IE 7]>    <html class="no-js ie7 oldie" lang="en"> <![endif]-->
+<!--[if IE 8]>    <html class="no-js ie8 oldie" lang="en"> <![endif]-->
+<!--[if gt IE 8]><!--> <html class="no-js" lang="en"> <!--<![endif]-->
+<head>
+    <meta charset="utf-8">
+    <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1">
+
+    <title>Blah - $title$</title>
+    <meta name="description" content="">
+    <meta name="author" content="">
+
+    <meta name="viewport" content="width=device-width,initial-scale=1">
+
+    <link rel="stylesheet" href="/css/default.css">
+    <link rel="stylesheet" href="/css/style.css">
+<link rel="alternate"
+              type="application/rss+xml"
+              title=""
+              href="/rss.xml" />
+    <script src="/js/libs/modernizr-2.0.6.min.js"></script>
+</head>
+<body>
+
+    <header>
+<h1>$title$</h1>
+    </header>
+
+    <div id="main" role="main">
+$body$
+    </div>
+
+<nav>
+    <ul id="#navigation">
+        <li><a href="/about/">About</a></li>
+        <li><a href="/photos/">Photos</a></li>
+        <li><a href="/writings/">Writings</a></li>
+    </ul>
+</nav>
+    <footer>
+    <p>All contents &copy; 1999-2011 Andy Irving</p>
+    </footer>
+<script src="//ajax.googleapis.com/ajax/libs/jquery/1.6.2/jquery.min.js"></script>
+<script>window.jQuery || document.write('<script src="/js/libs/jquery-1.6.2.min.js"><\/script>')</script>
+
+<!-- scripts concatenated and minified via ant build script-->
+<script src="/js/plugins.js"></script>
+<script src="/js/script.js"></script>
+<!-- end scripts-->
+
+<script>
+    var _gaq=[['_setAccount','UA-XXXXX-X'],['_trackPageview']];
+    (function(d,t){var g=d.createElement(t),s=d.getElementsByTagName(t)[0];g.async=1;
+    g.src=('https:'==location.protocol?'//ssl':'//www')+'.google-analytics.com/ga.js';
+    s.parentNode.insertBefore(g,s)}(document,'script'));
+</script>
+
+<!--[if lt IE 7 ]>
+    <script src="//ajax.googleapis.com/ajax/libs/chrome-frame/1.0.2/CFInstall.min.js"></script>
+    <script>window.attachEvent("onload",function(){CFInstall.check({mode:"overlay"})})</script>
+<![endif]-->
+
+</body>
+</html>

templates/diff.html

@@ -0,0 +1 @@
+$diff$

templates/history.html

@@ -0,0 +1,4 @@
+
+<div class="history">
+$history$
+</div>

templates/index.html

@@ -0,0 +1,23 @@
+
+<div class="about">
+    <h1>Andy Irving</h1>
+    <p>
+    Hi! My name's Andy, I'm a senior developer, rubbish alpinist and punk rock legend.
+    </p>
+</div>
+
+<div class="contact">
+<h2>Contact</h2>
+<ul>
+<li>Email: <a href="mailto:[email protected]">[email protected]</a> (<a href="./files/public_key.asc">Public Key</a>)</li>
+<li>Social: <a href="https://twitter.com/#!/ndyirving">Twitter</a> | <a href="http://uk.linkedin.com/pub/andy-irving/14/825/2ba">LinkedIn</a> | <a href="https://github.com/irv">GitHub</a>
+</li>
+If you're a potential employer, remember <a href="http://www.telegraph.co.uk/technology/news/8734904/Employers-warned-about-snooping-on-staff-via-social-networks.html"> you risk being sued for discrimination if you snoop on the private lives of prospective employees</a>.
+</div>
+
+<div class="updates">
+<h2>Recent Updates</h2>
+<ul>
+        $posts$
+</ul>
+</div>

templates/post.html

@@ -0,0 +1,10 @@
+
+<p>by <em>$author$</em> on <strong>$date$</strong></p>
+
+<p>Tagged as: $prettytags$.</p>
+
+$body$
+
+<table class="history">
+$history$
+</table>

templates/postitem.html

@@ -0,0 +1,4 @@
+<li>
+    <a href="$url$">$title$</a>
+    - <em>$date$</em> - by <em>$author$</em>
+</li>

templates/posts.html

@@ -0,0 +1,4 @@
+<h1>$title$</h1>
+<ul>
+    $posts$
+</ul>