implemented trackback receiver

darcs-hash:20080129090525-62b54-a0a08dc93785c737913f16e451e5716245894aa1.gz

diff --git a/Rakka/Resource/TrackBack.hs b/Rakka/Resource/TrackBack.hs
index ad367cd0f287fbb783d30356c153cf410d2665df..a9b364a56891349d4dc5daa943aaffd5ee64b909 100644 (file)
--- 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 2ea34cd44ed1118fcee67e9bac5c51ad6f5e843a..4155e3449af548e5a0013a25f8127b10adaf87f8 100644 (file)
--- 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 a5b96814bf37d05a4f89d85f51d65d03f11734fd..485c46f1d6e343b48eece25ae6dc384ae146d36f 100644 (file)
--- 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