Rakka/Wiki/Interpreter/PageList.hs

   1 module Rakka.Wiki.Interpreter.PageList
   2     ( interpreters
   3     )
   4     where
   5
   6 import           Data.Maybe
   7 import           Network.HTTP.Lucu.RFC1123DateTime
   8 import           Rakka.Page
   9 import           Rakka.Storage
  10 import           Rakka.Wiki
  11 import           Rakka.Wiki.Interpreter
  12 import           Text.HyperEstraier
  13
  14
  15 interpreters :: [Interpreter]
  16 interpreters = [ recentUpdatesInterp ]
  17
  18
  19 -- <div class="recentUpdates">
  20 --   <ul>
  21 --     <li>
  22 --       <a href="...">...</a>
  23 --       <span class="date">...</span>
  24 --       <p> <!-- サマリが無ければ存在しない -->
  25 --         blah blah...
  26 --       </p>
  27 --     </li>
  28 --     ...
  29 --   </ul>
  30 -- </div>
  31 recentUpdatesInterp :: Interpreter
  32 recentUpdatesInterp
  33     = BlockCommandInterpreter {
  34         bciName      = "recentUpdates"
  35       , bciInterpret
  36           = \ ctx (BlockCommand _ args _)
  37           -> do let items = fromMaybe 10 $ fmap read $ lookup "items" args
  38                     sto   = ctxStorage ctx
  39
  40                 cond <- newCondition
  41                 setPhrase   cond "[UVSET]"
  42                 addAttrCond cond "rakka:isBoring STREQ no"
  43                 addAttrCond cond "rakka:summary STRNE" -- summary が空でない
  44                 setOrder    cond "@mdate NUMD"
  45                 setMax      cond items
  46
  47                 result <- searchPages sto cond
  48                 pages  <- mapM ( \ (name, rev)
  49                                      -> getPage sto name (Just rev) >>= return . fromJust
  50                                ) result
  51
  52                 return $ mkPageList pages
  53       }
  54     where
  55       mkPageList :: [Page] -> BlockElement
  56       mkPageList pages
  57           = Div [("class", "recentUpdates")]
  58             [ Block (List Bullet (map mkListItem pages)) ]
  59
  60       mkListItem :: Page -> ListItem
  61       mkListItem page
  62           = [ Inline ( PageLink {
  63                          linkPage     = Just (pageName page)
  64                        , linkFragment = Nothing
  65                        , linkText     = Nothing
  66                        }
  67                     )
  68             , Inline ( Span [("class", "date")]
  69                                 [Text (formatRFC1123DateTime (pageLastMod page))]
  70                      )
  71             ]
  72             ++
  73             case pageSummary page of
  74               Just s  -> [ Block (Paragraph [Text s]) ]
  75               Nothing -> []