From 5bbe9d22da422b2f8289a4e905ca155ed906abb9 Mon Sep 17 00:00:00 2001
From: Alexey Kotlyarov <a@koterpillar.com>
Date: Tue, 20 Jan 2015 20:05:04 +1100
Subject: [PATCH 1/5] Test article previews

---
 src/Views.hs           | 11 ++---------
 templates/list.hamlet  |  4 +---
 testsuite/TestMain.hs  |  1 +
 testsuite/TestViews.hs | 30 ++++++++++++++++++++++++++++++
 4 files changed, 34 insertions(+), 12 deletions(-)
 create mode 100644 testsuite/TestViews.hs

diff --git a/src/Views.hs b/src/Views.hs
index 494c75e..51fbfe4 100644
--- a/src/Views.hs
+++ b/src/Views.hs
@@ -89,12 +89,5 @@ inlineToStr inline = writePlain def $ Pandoc undefined [Plain inline]
 langContent :: HasContent a => LanguagePreference -> a -> Pandoc
 langContent lang = fromJust . matchLanguage lang . getContent
 
-arPreview :: LanguagePreference -> Article -> Pandoc
-arPreview lang = pandocFilter (take 2 . filter isTextual) . langContent lang
-
-pandocFilter :: ([Block] -> [Block]) -> Pandoc -> Pandoc
-pandocFilter f (Pandoc m bs) = Pandoc m (f bs)
-
-isTextual :: Block -> Bool
-isTextual Header{} = False
-isTextual _ = True
+linkedHeader :: Linkable a => a -> Pandoc -> Pandoc
+linkedHeader = undefined
diff --git a/templates/list.hamlet b/templates/list.hamlet
index e4c81fb..0461f22 100644
--- a/templates/list.hamlet
+++ b/templates/list.hamlet
@@ -1,5 +1,3 @@
 $forall article <- articles
   <div>
-    <h2>
-      <a href="@{link article}">#{langTitle lang article}
-    <p>#{writeHtml def $ arPreview lang article}
+    <p>#{writeHtml def $ linkedHeader article $ langContent lang article}
diff --git a/testsuite/TestMain.hs b/testsuite/TestMain.hs
index 7f47c0c..b1566fd 100644
--- a/testsuite/TestMain.hs
+++ b/testsuite/TestMain.hs
@@ -5,5 +5,6 @@ import Test.Framework
 import {-@ HTF_TESTS @-} TestImport
 import {-@ HTF_TESTS @-} TestLanguage
 import {-@ HTF_TESTS @-} TestUtils
+import {-@ HTF_TESTS @-} TestViews
 
 main = htfMain htf_importedTests
diff --git a/testsuite/TestViews.hs b/testsuite/TestViews.hs
new file mode 100644
index 0000000..a68c067
--- /dev/null
+++ b/testsuite/TestViews.hs
@@ -0,0 +1,30 @@
+{-# OPTIONS_GHC -F -pgmF htfpp #-}
+{-# LANGUAGE RankNTypes #-}
+
+module TestViews where
+
+import Text.Blaze.Html.Renderer.String (renderHtml)
+import Text.Pandoc hiding (Meta)
+
+import Routes
+import Views
+
+import Test.Framework
+
+data TestLink = TestLink
+
+instance Linkable TestLink where
+    link = const Index
+
+test_linkedHeader = do
+    let source = unlines $ [ "Header"
+                           , "======"
+                           , ""
+                           , "Text content"
+                           , ""
+                           , "Other header"
+                           , "============"
+                           ]
+    assertEqual
+        "<h2><a href=\"/\">Header</a></h2><p>Text content</p><h2>Other header</h2>"
+        $ renderHtml $ writeHtml def $ linkedHeader TestLink $ readMarkdown def source

From 3595df39dac2072f3602b5ae55ae373cc37c2625 Mon Sep 17 00:00:00 2001
From: Alexey Kotlyarov <a@koterpillar.com>
Date: Tue, 20 Jan 2015 20:13:31 +1100
Subject: [PATCH 2/5] Spec out better

---
 src/Views.hs           |  4 ++--
 templates/list.hamlet  |  2 +-
 testsuite/TestViews.hs | 23 +++++++++++++----------
 3 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/Views.hs b/src/Views.hs
index 51fbfe4..b953fd9 100644
--- a/src/Views.hs
+++ b/src/Views.hs
@@ -89,5 +89,5 @@ inlineToStr inline = writePlain def $ Pandoc undefined [Plain inline]
 langContent :: HasContent a => LanguagePreference -> a -> Pandoc
 langContent lang = fromJust . matchLanguage lang . getContent
 
-linkedHeader :: Linkable a => a -> Pandoc -> Pandoc
-linkedHeader = undefined
+linkedHeader :: Linkable a => a -> Pandoc -> Markup
+linkedHeader _ = writeHtml def
diff --git a/templates/list.hamlet b/templates/list.hamlet
index 0461f22..1d13e2d 100644
--- a/templates/list.hamlet
+++ b/templates/list.hamlet
@@ -1,3 +1,3 @@
 $forall article <- articles
   <div>
-    <p>#{writeHtml def $ linkedHeader article $ langContent lang article}
+    <p>#{linkedHeader article $ langContent lang article}
diff --git a/testsuite/TestViews.hs b/testsuite/TestViews.hs
index a68c067..2c433ea 100644
--- a/testsuite/TestViews.hs
+++ b/testsuite/TestViews.hs
@@ -17,14 +17,17 @@ instance Linkable TestLink where
     link = const Index
 
 test_linkedHeader = do
-    let source = unlines $ [ "Header"
-                           , "======"
-                           , ""
-                           , "Text content"
-                           , ""
-                           , "Other header"
-                           , "============"
-                           ]
+    let source = unlines [ "Header"
+                         , "------"
+                         , ""
+                         , "Text content"
+                         , ""
+                         , "Other header"
+                         , "------------"
+                         ]
     assertEqual
-        "<h2><a href=\"/\">Header</a></h2><p>Text content</p><h2>Other header</h2>"
-        $ renderHtml $ writeHtml def $ linkedHeader TestLink $ readMarkdown def source
+        (unlines [ "<h2><a href=\"/\">Header</a></h2>"
+                 , "<p>Text content</p>"
+                 , "<h2>Other header</h2>"
+                 ])
+        $ renderHtml $ linkedHeader TestLink $ readMarkdown def source

From c34c2cbcdf04bcbf81eed5a12409d532c754c14c Mon Sep 17 00:00:00 2001
From: Alexey Kotlyarov <a@koterpillar.com>
Date: Tue, 20 Jan 2015 20:46:03 +1100
Subject: [PATCH 3/5] Linkify headers

---
 src/Views.hs           | 14 +++++++++++++-
 testsuite/TestViews.hs | 16 +++++++++-------
 2 files changed, 22 insertions(+), 8 deletions(-)

diff --git a/src/Views.hs b/src/Views.hs
index b953fd9..91888f0 100644
--- a/src/Views.hs
+++ b/src/Views.hs
@@ -89,5 +89,17 @@ inlineToStr inline = writePlain def $ Pandoc undefined [Plain inline]
 langContent :: HasContent a => LanguagePreference -> a -> Pandoc
 langContent lang = fromJust . matchLanguage lang . getContent
 
+-- Modify the first header to be a link to a given place
+-- and remove all anchors from headers
 linkedHeader :: Linkable a => a -> Pandoc -> Markup
-linkedHeader _ = writeHtml def
+linkedHeader target doc = writeHtml def $ evalState (walkM linkHeader doc) 0
+    where linkHeader :: Block -> State Int Block
+          linkHeader (Header n _ text) = do
+              -- note if this is the first header
+              cnt <- get
+              modify (+ 1)
+              -- make the first header a link
+              let text' = if cnt == 0 then [Link text ("/", "")] else text
+              -- remove anchors
+              return $ Header n ("",[],[]) text'
+          linkHeader x = return x
diff --git a/testsuite/TestViews.hs b/testsuite/TestViews.hs
index 2c433ea..f10a593 100644
--- a/testsuite/TestViews.hs
+++ b/testsuite/TestViews.hs
@@ -3,6 +3,8 @@
 
 module TestViews where
 
+import Data.List
+
 import Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Pandoc hiding (Meta)
 
@@ -11,10 +13,10 @@ import Views
 
 import Test.Framework
 
-data TestLink = TestLink
+data TestLink = TestLink String
 
 instance Linkable TestLink where
-    link = const Index
+    link (TestLink dest) = MetaView dest
 
 test_linkedHeader = do
     let source = unlines [ "Header"
@@ -26,8 +28,8 @@ test_linkedHeader = do
                          , "------------"
                          ]
     assertEqual
-        (unlines [ "<h2><a href=\"/\">Header</a></h2>"
-                 , "<p>Text content</p>"
-                 , "<h2>Other header</h2>"
-                 ])
-        $ renderHtml $ linkedHeader TestLink $ readMarkdown def source
+        (intercalate "\n" [ "<h2><a href=\"/test\">Header</a></h2>"
+                          , "<p>Text content</p>"
+                          , "<h2>Other header</h2>"
+                          ])
+        $ renderHtml $ linkedHeader (TestLink "test") $ readMarkdown def source

From 6d4200010e039bf1e76564d51c990d741dfa2abb Mon Sep 17 00:00:00 2001
From: Alexey Kotlyarov <a@koterpillar.com>
Date: Tue, 20 Jan 2015 20:47:57 +1100
Subject: [PATCH 4/5] Use a boolean for "is this the first header"

---
 src/Views.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Views.hs b/src/Views.hs
index 91888f0..fa51320 100644
--- a/src/Views.hs
+++ b/src/Views.hs
@@ -92,14 +92,14 @@ langContent lang = fromJust . matchLanguage lang . getContent
 -- Modify the first header to be a link to a given place
 -- and remove all anchors from headers
 linkedHeader :: Linkable a => a -> Pandoc -> Markup
-linkedHeader target doc = writeHtml def $ evalState (walkM linkHeader doc) 0
-    where linkHeader :: Block -> State Int Block
+linkedHeader target doc = writeHtml def $ evalState (walkM linkHeader doc) True
+    where linkHeader :: Block -> State Bool Block
           linkHeader (Header n _ text) = do
               -- note if this is the first header
-              cnt <- get
-              modify (+ 1)
+              isFirst <- get
+              put False
               -- make the first header a link
-              let text' = if cnt == 0 then [Link text ("/", "")] else text
+              let text' = if isFirst then [Link text ("/", "")] else text
               -- remove anchors
               return $ Header n ("",[],[]) text'
           linkHeader x = return x

From a759e37bd65048a19d760afe891ea6b8b6a5b1c8 Mon Sep 17 00:00:00 2001
From: Alexey Kotlyarov <a@koterpillar.com>
Date: Wed, 21 Jan 2015 20:01:42 +1100
Subject: [PATCH 5/5] Properly linkify articles in a list

---
 src/Views.hs           | 23 ++++++++++++++++++-----
 templates/list.hamlet  |  4 ++--
 testsuite/TestViews.hs |  4 ++--
 3 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/src/Views.hs b/src/Views.hs
index fa51320..c6a0e8b 100644
--- a/src/Views.hs
+++ b/src/Views.hs
@@ -11,6 +11,7 @@ import Control.Monad.State
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Text as T
 import Data.Time
 
 import Text.Blaze.Html (Markup)
@@ -64,8 +65,10 @@ template lang page = do
 
 articleListDisplay :: (MonadRoute m, URL m ~ Sitemap, MonadState AppState m, MonadPlus m) =>
     LanguagePreference -> [Article] -> m Markup
-articleListDisplay lang articles = template lang $
-    mkPage Nothing $(hamletFile "templates/list.hamlet")
+articleListDisplay lang articles = do
+    articlesContent <- mapM (linkedContent lang) articles
+    template lang $
+        mkPage Nothing $(hamletFile "templates/list.hamlet")
 
 articleDisplay :: (MonadRoute m, URL m ~ Sitemap, MonadState AppState m, MonadPlus m) =>
     LanguagePreference -> Article -> m Markup
@@ -89,17 +92,27 @@ inlineToStr inline = writePlain def $ Pandoc undefined [Plain inline]
 langContent :: HasContent a => LanguagePreference -> a -> Pandoc
 langContent lang = fromJust . matchLanguage lang . getContent
 
+-- Modify the content to have a link to itself and have no anchors
+linkedContent :: (HasContent a, Linkable a, MonadRoute m, URL m ~ Sitemap)
+              => LanguagePreference
+              -> a
+              -> m Pandoc
+linkedContent lang a = do
+    routeFn <- askRouteFn
+    let target = T.unpack $ routeFn (link a) []
+    return $ linkedHeader target $ langContent lang a
+
 -- Modify the first header to be a link to a given place
 -- and remove all anchors from headers
-linkedHeader :: Linkable a => a -> Pandoc -> Markup
-linkedHeader target doc = writeHtml def $ evalState (walkM linkHeader doc) True
+linkedHeader :: String -> Pandoc -> Pandoc
+linkedHeader target doc = evalState (walkM linkHeader doc) True
     where linkHeader :: Block -> State Bool Block
           linkHeader (Header n _ text) = do
               -- note if this is the first header
               isFirst <- get
               put False
               -- make the first header a link
-              let text' = if isFirst then [Link text ("/", "")] else text
+              let text' = if isFirst then [Link text (target, "")] else text
               -- remove anchors
               return $ Header n ("",[],[]) text'
           linkHeader x = return x
diff --git a/templates/list.hamlet b/templates/list.hamlet
index 1d13e2d..85cecf4 100644
--- a/templates/list.hamlet
+++ b/templates/list.hamlet
@@ -1,3 +1,3 @@
-$forall article <- articles
+$forall article <- articlesContent
   <div>
-    <p>#{linkedHeader article $ langContent lang article}
+    <p>#{writeHtml def article}
diff --git a/testsuite/TestViews.hs b/testsuite/TestViews.hs
index f10a593..d37b16e 100644
--- a/testsuite/TestViews.hs
+++ b/testsuite/TestViews.hs
@@ -28,8 +28,8 @@ test_linkedHeader = do
                          , "------------"
                          ]
     assertEqual
-        (intercalate "\n" [ "<h2><a href=\"/test\">Header</a></h2>"
+        (intercalate "\n" [ "<h2><a href=\"http://test\">Header</a></h2>"
                           , "<p>Text content</p>"
                           , "<h2>Other header</h2>"
                           ])
-        $ renderHtml $ linkedHeader (TestLink "test") $ readMarkdown def source
+        $ renderHtml $ writeHtml def $ linkedHeader "http://test" $ readMarkdown def source