Rakka/Wiki/Interpreter/PageList.hs

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