From 51edda81709389f8219ddb45d572de915a2e7553 Mon Sep 17 00:00:00 2001
From: pho <pho@cielonegro.org>
Date: Tue, 29 Jan 2008 18:05:25 +0900
Subject: [PATCH] implemented trackback receiver

darcs-hash:20080129090525-62b54-a0a08dc93785c737913f16e451e5716245894aa1.gz
---
 Rakka/Resource/TrackBack.hs         |  2 +-
 Rakka/TrackBack.hs                  |  5 +---
 Rakka/Wiki/Interpreter/Trackback.hs | 39 ++++++++++++++++++++++++++++-
 3 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/Rakka/Resource/TrackBack.hs b/Rakka/Resource/TrackBack.hs
index ad367cd..a9b364a 100644
--- a/Rakka/Resource/TrackBack.hs
+++ b/Rakka/Resource/TrackBack.hs
@@ -81,7 +81,7 @@ validateTrackBack :: [(String, String)] -> Resource (Maybe TrackBack)
 validateTrackBack form
     = do let title    = get' "title"
              excerpt  = get' "excerpt"
-             blogName = get' "blogName"
+             blogName = get' "blog_name"
          case get' "url" of
            Nothing
                -> do outputResponse (Error 1 "Parameter `url' is missing.")
diff --git a/Rakka/TrackBack.hs b/Rakka/TrackBack.hs
index 2ea34cd..4155e34 100644
--- a/Rakka/TrackBack.hs
+++ b/Rakka/TrackBack.hs
@@ -72,10 +72,7 @@ instance Attachment [TrackBack] where
                    ) -<< ()
 
     deserializeFromXmlTree
-        = proc doc
-        -> do tree <- getXPathTreesInDoc "/trackbacks/trackback" -< doc
-              tb   <- treeToTb -< tree
-              listA this -< tb
+        = proc doc -> listA (getXPathTreesInDoc "/trackbacks/trackback" >>> treeToTb) -< doc
         where
           treeToTb :: (ArrowChoice a, ArrowXml a) => a XmlTree TrackBack
           treeToTb 
diff --git a/Rakka/Wiki/Interpreter/Trackback.hs b/Rakka/Wiki/Interpreter/Trackback.hs
index a5b9681..485c46f 100644
--- a/Rakka/Wiki/Interpreter/Trackback.hs
+++ b/Rakka/Wiki/Interpreter/Trackback.hs
@@ -3,8 +3,13 @@ module Rakka.Wiki.Interpreter.Trackback
     )
     where
 
+import           Data.Maybe
+import           Data.Time
+import           Network.HTTP.Lucu.RFC1123DateTime
 import           Rakka.Page
+import           Rakka.Storage
 import           Rakka.SystemConfig
+import           Rakka.TrackBack
 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter
 
@@ -35,5 +40,37 @@ trackbacksInterp
     = BlockCommandInterpreter {
         bciName = "trackbacks"
       , bciInterpret
-          = \ _ _ -> return $ Div [("class", "trackbacks")] []
+          = \ ctx _ ->
+            do trackbacks <- case ctxPageName ctx of
+                               Nothing
+                                   -> return []
+                               Just name
+                                   -> getAttachment (ctxStorage ctx) name "trackbacks" Nothing
+                                      >>=
+                                      return . fromMaybe []
+               items <- mapM mkListItem trackbacks
+
+               let divElem = Div [("class", "trackbacks")] [list]
+                   list    = Block (List Bullet items)
+                   
+               return divElem
       }
+    where
+      mkListItem :: TrackBack -> IO ListItem
+      mkListItem tb
+          = do zonedTime <- utcToLocalZonedTime (tbTime tb)
+
+               let anchor  = Just (Inline (ExternalLink (tbURL tb) label))
+                   label   = case (tbTitle tb, tbBlogName tb) of
+                               (Nothing   , Nothing      ) -> Nothing
+                               (Just title, Nothing      ) -> Just title
+                               (Nothing   , Just blogName) -> Just blogName
+                               (Just title, Just blogName) -> Just (title ++ " (" ++ blogName ++ ")")
+                   date    = Just ( Block ( Div [("class", "date")]
+                                            [Inline (Text (formatRFC1123DateTime zonedTime))]
+                                          )
+                                  )
+                   excerpt = do e <- tbExcerpt tb
+                                return $ Block $ Paragraph [Text e]
+
+               return $ catMaybes [anchor, date, excerpt]
\ No newline at end of file
-- 
2.40.0