+++ /dev/null
-module Rakka.Wiki.Interpreter.Trackback
- ( interpreters
- )
- 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
-
-
-interpreters :: [Interpreter]
-interpreters = [ trackbackURLInterp
- , trackbacksInterp
- ]
-
-
-trackbackURLInterp :: Interpreter
-trackbackURLInterp
- = InlineCommandInterpreter {
- iciName = "trackbackURL"
- , iciInterpret
- = \ ctx _ -> case ctxPageName ctx of
- Nothing
- -> return (Text "No trackbacks for this page.")
- Just name
- -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
- let uri = mkAuxiliaryURI baseURI ["trackback"] name
- return $ ExternalLink uri (Just "Trackback URL")
- }
-
-
-trackbacksInterp :: Interpreter
-trackbacksInterp
- = BlockCommandInterpreter {
- bciName = "trackbacks"
- , bciInterpret
- = \ ctx _ ->
- do trackbacks <- case ctxPageName ctx of
- Nothing
- -> return []
- Just name
- -> liftM (fromMaybe [])
- (getAttachment (ctxStorage ctx) name "trackbacks" Nothing)
- 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