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                 setPhrase   cond "[UVSET]"
  48                 when onlyEntity
  49                     $ addAttrCond cond "@type STRNE application/x-rakka-redirection"
  50                 when onlySummarized
  51                     $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない
  52                 setOrder    cond "@mdate NUMD"
  53                 setMax      cond items
  54
  55                 result <- searchPages sto cond
  56                 pages  <- mapM ( \ (name, rev)
  57                                      -> getPage sto name (Just rev) >>= return . fromJust
  58                                ) result
  59
  60                 mkPageList showSummary pages
  61       }
  62     where
  63       mkPageList :: Bool -> [Page] -> IO BlockElement
  64       mkPageList showSummary pages
  65           = do items <- mapM (mkListItem showSummary) pages
  66                return (Div [("class", "recentUpdates")]
  67                        [ Block (List Bullet items) ])
  68
  69       mkListItem :: Bool -> Page -> IO ListItem
  70       mkListItem showSummary page
  71           = do lastMod <- utcToLocalZonedTime (entityLastMod page)
  72                return ( [ Inline ( PageLink {
  73                                      linkPage     = Just (pageName page)
  74                                    , linkFragment = Nothing
  75                                    , linkText     = Nothing
  76                                    }
  77                                  )
  78                         , Block ( Div [("class", "date")]
  79                                   [Inline (Text (formatRFC1123DateTime lastMod))]
  80                                 )
  81                         ]
  82                         ++
  83                         case (showSummary, entitySummary page) of
  84                           (True, Just s)
  85                               -> [ Block (Paragraph [Text s]) ]
  86                           _   -> []
  87                       )