X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FPageList.hs;h=2fe9d305fc46509926a60aa6b1ddff9d22a5c403;hb=d717326c5f603dd140a0b5ee27b412e5e09685cd;hp=69ff0e72ee9697f1a913c892f786bddcecf65381;hpb=859d4378c2e2a1ccc8028821a37eeaa43aaa23fb;p=Rakka.git diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index 69ff0e7..2fe9d30 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -3,17 +3,40 @@ module Rakka.Wiki.Interpreter.PageList ) where +import Control.Monad import Data.Maybe -import Network.HTTP.Lucu.RFC1123DateTime -import Rakka.Page +import Data.Time +import qualified Data.Time.RFC1123 as RFC1123 +import Network.URI import Rakka.Storage +import Rakka.SystemConfig +import Rakka.Utils import Rakka.Wiki import Rakka.Wiki.Interpreter +import System.FilePath import Text.HyperEstraier interpreters :: [Interpreter] -interpreters = [ recentUpdatesInterp ] +interpreters = [ recentUpdatesURLInterp + , recentUpdatesInterp + ] + + +recentUpdatesURLInterp :: Interpreter +recentUpdatesURLInterp + = InlineCommandInterpreter { + iciName = "recentUpdatesURL" + , iciInterpret + = \ ctx _ -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx) + let uri = baseURI { + uriPath = uriPath baseURI "search.html" + , uriQuery = '?' : mkQueryString [ ("q" , "[UVSET]") + , ("order", "@mdate NUMD") + ] + } + return $ ExternalLink uri (Just "List all pages") + } --
@@ -34,42 +57,46 @@ recentUpdatesInterp bciName = "recentUpdates" , bciInterpret = \ ctx (BlockCommand _ args _) - -> do let items = fromMaybe 10 $ fmap read $ lookup "items" args - sto = ctxStorage ctx + -> do let items = fromMaybe 10 $ fmap read $ lookup "items" args + showSummary = fromMaybe True $ fmap parseYesOrNo $ lookup "showSummary" args + onlyEntity = fromMaybe True $ fmap parseYesOrNo $ lookup "onlyEntity" args + onlySummarized = fromMaybe True $ fmap parseYesOrNo $ lookup "onlySummarized" args + sto = ctxStorage ctx cond <- newCondition - setPhrase cond "[UVSET]" - addAttrCond cond "rakka:isBoring STREQ no" - addAttrCond cond "rakka:summary STRNE" -- summary が空でない - setOrder cond "@mdate NUMD" - setMax cond items + when onlyEntity + $ addAttrCond cond "@type STRNE application/x-rakka-redirection" + when onlySummarized + $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない + setPhrase cond "[UVSET]" + setOrder cond "@mdate NUMD" + setMax cond items result <- searchPages sto cond - pages <- mapM ( \ (name, rev) - -> getPage sto name (Just rev) >>= return . fromJust - ) result - - return $ mkPageList pages + mkPageList showSummary (srPages result) } where - mkPageList :: [Page] -> BlockElement - mkPageList pages - = Div [("class", "recentUpdates")] - [ Block (List Bullet (map mkListItem pages)) ] + mkPageList :: Bool -> [HitPage] -> IO BlockElement + mkPageList showSummary pages + = do items <- mapM (mkListItem showSummary) pages + return (Div [("class", "recentUpdates")] + [ Block (List Bullet items) ]) - mkListItem :: Page -> ListItem - mkListItem page - = [ Inline ( PageLink { - linkPage = Just (pageName page) - , linkFragment = Nothing - , linkText = Nothing - } - ) - , Block ( Div [("class", "date")] - [Inline (Text (formatRFC1123DateTime (pageLastMod page)))] - ) - ] - ++ - case pageSummary page of - Just s -> [ Block (Paragraph [Text s]) ] - Nothing -> [] + mkListItem :: Bool -> HitPage -> IO ListItem + mkListItem showSummary page + = do lastMod <- utcToLocalZonedTime (hpLastMod page) + return ( [ Inline PageLink { + linkPage = Just (hpPageName page) + , linkFragment = Nothing + , linkText = Nothing + } + , Block ( Div [("class", "date")] + [Inline (Text (RFC1123.format lastMod))] + ) + ] + ++ + case (showSummary, hpSummary page) of + (True, Just s) + -> [ Block (Paragraph [Text s]) ] + _ -> [] + )