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