implemented trackback receiver

[Rakka.git] / Rakka / Wiki / Interpreter / Trackback.hs

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