Rakka/Wiki/Interpreter/PageList.hs

   1 module Rakka.Wiki.Interpreter.PageList
   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.Wiki
  12 import           Rakka.Wiki.Interpreter
  13 import           Text.HyperEstraier
  14
  15
  16 interpreters :: [Interpreter]
  17 interpreters = [ recentUpdatesInterp ]
  18
  19
  20 -- <div class="recentUpdates">
  21 --   <ul>
  22 --     <li>
  23 --       <a href="...">...</a>
  24 --       <div class="date">...</div>
  25 --       <p> <!-- サマリが無ければ存在しない -->
  26 --         blah blah...
  27 --       </p>
  28 --     </li>
  29 --     ...
  30 --   </ul>
  31 -- </div>
  32 recentUpdatesInterp :: Interpreter
  33 recentUpdatesInterp
  34     = BlockCommandInterpreter {
  35         bciName      = "recentUpdates"
  36       , bciInterpret
  37           = \ ctx (BlockCommand _ args _)
  38           -> do let items = fromMaybe 10 $ fmap read $ lookup "items" args
  39                     sto   = ctxStorage ctx
  40
  41                 cond <- newCondition
  42                 setPhrase   cond "[UVSET]"
  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                 mkPageList pages
  53       }
  54     where
  55       mkPageList :: [Page] -> IO BlockElement
  56       mkPageList pages
  57           = do items <- mapM mkListItem pages
  58                return (Div [("class", "recentUpdates")]
  59                        [ Block (List Bullet items) ])
  60
  61       mkListItem :: Page -> IO ListItem
  62       mkListItem page
  63           = do lastMod <- utcToLocalZonedTime (entityLastMod page)
  64                return ( [ Inline ( PageLink {
  65                                      linkPage     = Just (pageName page)
  66                                    , linkFragment = Nothing
  67                                    , linkText     = Nothing
  68                                    }
  69                                  )
  70                         , Block ( Div [("class", "date")]
  71                                   [Inline (Text (formatRFC1123DateTime lastMod))]
  72                                 )
  73                         ]
  74                         ++
  75                         case entitySummary page of
  76                           Just s  -> [ Block (Paragraph [Text s]) ]
  77                           Nothing -> []
  78                       )