Rakka/Wiki/Interpreter/PageList.hs

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