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:isBoring STREQ no"
  44                 addAttrCond cond "rakka:summary STRNE" -- summary が空でない
  45                 setOrder    cond "@mdate NUMD"
  46                 setMax      cond items
  47
  48                 result <- searchPages sto cond
  49                 pages  <- mapM ( \ (name, rev)
  50                                      -> getPage sto name (Just rev) >>= return . fromJust
  51                                ) result
  52
  53                 mkPageList pages
  54       }
  55     where
  56       mkPageList :: [Page] -> IO BlockElement
  57       mkPageList pages
  58           = do items <- mapM mkListItem pages
  59                return (Div [("class", "recentUpdates")]
  60                        [ Block (List Bullet items) ])
  61
  62       mkListItem :: Page -> IO ListItem
  63       mkListItem page
  64           = do lastMod <- utcToLocalZonedTime (entityLastMod page)
  65                return ( [ Inline ( PageLink {
  66                                      linkPage     = Just (pageName page)
  67                                    , linkFragment = Nothing
  68                                    , linkText     = Nothing
  69                                    }
  70                                  )
  71                         , Block ( Div [("class", "date")]
  72                                   [Inline (Text (formatRFC1123DateTime lastMod))]
  73                                 )
  74                         ]
  75                         ++
  76                         case entitySummary page of
  77                           Just s  -> [ Block (Paragraph [Text s]) ]
  78                           Nothing -> []
  79                       )