Rakka/Wiki/Interpreter/Trackback.hs

   1 module Rakka.Wiki.Interpreter.Trackback
   2     ( interpreters
   3     )
   4     where
   5
   6 import           Data.Maybe
   7 import           Data.Time
   8 import           Network.HTTP.Lucu.RFC1123DateTime
   9 import           Rakka.Page
  10 import           Rakka.Storage
  11 import           Rakka.SystemConfig
  12 import           Rakka.TrackBack
  13 import           Rakka.Wiki
  14 import           Rakka.Wiki.Interpreter
  15
  16
  17 interpreters :: [Interpreter]
  18 interpreters = [ trackbackURLInterp
  19                , trackbacksInterp
  20                ]
  21
  22
  23 trackbackURLInterp :: Interpreter
  24 trackbackURLInterp
  25     = InlineCommandInterpreter {
  26         iciName = "trackbackURL"
  27       , iciInterpret
  28           = \ ctx _ -> case ctxPageName ctx of
  29                          Nothing
  30                              -> return (Text "No trackbacks for this page.")
  31                          Just name
  32                              -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  33                                    let uri = mkAuxiliaryURI baseURI ["trackback"] name
  34                                    return $ ExternalLink uri (Just "Trackback URL")
  35       }
  36
  37
  38 trackbacksInterp :: Interpreter
  39 trackbacksInterp
  40     = BlockCommandInterpreter {
  41         bciName = "trackbacks"
  42       , bciInterpret
  43           = \ ctx _ ->
  44             do trackbacks <- case ctxPageName ctx of
  45                                Nothing
  46                                    -> return []
  47                                Just name
  48                                    -> getAttachment (ctxStorage ctx) name "trackbacks" Nothing
  49                                       >>=
  50                                       return . fromMaybe []
  51                items <- mapM mkListItem trackbacks
  52
  53                let divElem = Div [("class", "trackbacks")] [list]
  54                    list    = Block (List Bullet items)
  55
  56                return divElem
  57       }
  58     where
  59       mkListItem :: TrackBack -> IO ListItem
  60       mkListItem tb
  61           = do zonedTime <- utcToLocalZonedTime (tbTime tb)
  62
  63                let anchor  = Just (Inline (ExternalLink (tbURL tb) label))
  64                    label   = case (tbTitle tb, tbBlogName tb) of
  65                                (Nothing   , Nothing      ) -> Nothing
  66                                (Just title, Nothing      ) -> Just title
  67                                (Nothing   , Just blogName) -> Just blogName
  68                                (Just title, Just blogName) -> Just (title ++ " (" ++ blogName ++ ")")
  69                    date    = Just ( Block ( Div [("class", "date")]
  70                                             [Inline (Text (formatRFC1123DateTime zonedTime))]
  71                                           )
  72                                   )
  73                    excerpt = do e <- tbExcerpt tb
  74                                 return $ Block $ Paragraph [Text e]
  75
  76                return $ catMaybes [anchor, date, excerpt]