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           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                                  )
  94                         , Block ( Div [("class", "date")]
  95                                   [Inline (Text (formatRFC1123DateTime lastMod))]
  96                                 )
  97                         ]
  98                         ++
  99                         case (showSummary, hpSummary page) of
 100                           (True, Just s)
 101                               -> [ Block (Paragraph [Text s]) ]
 102                           _   -> []
 103                       )