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 qualified Data.Time.RFC1123 as RFC1123
  10 import           Network.URI
  11 import           Rakka.Storage
  12 import           Rakka.SystemConfig
  13 import           Rakka.Utils
  14 import           Rakka.Wiki
  15 import           Rakka.Wiki.Interpreter
  16 import           System.FilePath
  17 import           Text.HyperEstraier
  18
  19
  20 interpreters :: [Interpreter]
  21 interpreters = [ recentUpdatesURLInterp
  22                , recentUpdatesInterp
  23                ]
  24
  25
  26 recentUpdatesURLInterp :: Interpreter
  27 recentUpdatesURLInterp
  28     = InlineCommandInterpreter {
  29         iciName = "recentUpdatesURL"
  30       , iciInterpret
  31           = \ ctx _ -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
  32                           let uri = baseURI {
  33                                       uriPath  = uriPath baseURI </> "search.html"
  34                                     , uriQuery = '?' : mkQueryString [ ("q"    , "[UVSET]")
  35                                                                      , ("order", "@mdate NUMD")
  36                                                                      ]
  37                                     }
  38                           return $ ExternalLink uri (Just "List all pages")
  39       }
  40
  41
  42 -- <div class="recentUpdates">
  43 --   <ul>
  44 --     <li>
  45 --       <a href="...">...</a>
  46 --       <div class="date">...</div>
  47 --       <p> <!-- サマリが無ければ存在しない -->
  48 --         blah blah...
  49 --       </p>
  50 --     </li>
  51 --     ...
  52 --   </ul>
  53 -- </div>
  54 recentUpdatesInterp :: Interpreter
  55 recentUpdatesInterp
  56     = BlockCommandInterpreter {
  57         bciName      = "recentUpdates"
  58       , bciInterpret
  59           = \ ctx (BlockCommand _ args _)
  60           -> do let items          = fromMaybe 10   $ fmap read         $ lookup "items" args
  61                     showSummary    = fromMaybe True $ fmap parseYesOrNo $ lookup "showSummary" args
  62                     onlyEntity     = fromMaybe True $ fmap parseYesOrNo $ lookup "onlyEntity" args
  63                     onlySummarized = fromMaybe True $ fmap parseYesOrNo $ lookup "onlySummarized" args
  64                     sto            = ctxStorage ctx
  65
  66                 cond <- newCondition
  67                 when onlyEntity
  68                     $ addAttrCond cond "@type STRNE application/x-rakka-redirection"
  69                 when onlySummarized
  70                     $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない
  71                 setPhrase cond "[UVSET]"
  72                 setOrder  cond "@mdate NUMD"
  73                 setMax    cond items
  74
  75                 result <- searchPages sto cond
  76                 mkPageList showSummary (srPages result)
  77       }
  78     where
  79       mkPageList :: Bool -> [HitPage] -> IO BlockElement
  80       mkPageList showSummary pages
  81           = do items <- mapM (mkListItem showSummary) pages
  82                return (Div [("class", "recentUpdates")]
  83                        [ Block (List Bullet items) ])
  84
  85       mkListItem :: Bool -> HitPage -> IO ListItem
  86       mkListItem showSummary page
  87           = do lastMod <- utcToLocalZonedTime (hpLastMod page)
  88                return ( [ Inline PageLink {
  89                                        linkPage     = Just (hpPageName page)
  90                                      , linkFragment = Nothing
  91                                      , linkText     = Nothing
  92                                      }
  93                         , Block ( Div [("class", "date")]
  94                                   [Inline (Text (RFC1123.format lastMod))]
  95                                 )
  96                         ]
  97                         ++
  98                         case (showSummary, hpSummary page) of
  99                           (True, Just s)
 100                               -> [ Block (Paragraph [Text s]) ]
 101                           _   -> []
 102                       )