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