X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FPageList.hs;fp=Rakka%2FWiki%2FInterpreter%2FPageList.hs;h=d94f67ea1545a597b511c8f116e8fac5ebe37c44;hp=3d5ce246b5e511f7de4f1f6623f54c0eb994cdee;hb=42f51754dea02201aececaacbf194d714cd58aaf;hpb=98fd1cb53a837a9bda7145544c34872acb13a634 diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index 3d5ce24..d94f67e 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -1,13 +1,21 @@ +{-# LANGUAGE + OverloadedStrings + , RecordWildCards + , UnicodeSyntax + #-} module Rakka.Wiki.Interpreter.PageList ( interpreters ) where - -import Control.Monad -import Data.Maybe +import Control.Applicative +import Control.Monad +import Data.Maybe +import Data.Monoid.Unicode +import qualified Data.Text as T import Data.Time -import Network.HTTP.Lucu.RFC1123DateTime +import qualified Data.Time.RFC1123 as RFC1123 import Network.URI +import Prelude.Unicode import Rakka.Storage import Rakka.SystemConfig import Rakka.Utils @@ -51,29 +59,26 @@ recentUpdatesURLInterp -- ... -- -- -recentUpdatesInterp :: Interpreter +recentUpdatesInterp ∷ Interpreter recentUpdatesInterp = BlockCommandInterpreter { bciName = "recentUpdates" , bciInterpret - = \ ctx (BlockCommand _ args _) - -> 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 - 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 - mkPageList showSummary (srPages result) + = \(InterpreterContext {..}) (BlockCommand _ args _) → + do let items = fromMaybe 10 $ read ∘ T.unpack <$> lookup "items" args + showSummary = fromMaybe True $ parseYesOrNo <$> lookup "showSummary" args + onlyEntity = fromMaybe True $ parseYesOrNo <$> lookup "onlyEntity" args + onlySummarized = fromMaybe True $ parseYesOrNo <$> lookup "onlySummarized" args + cond ← newCondition + 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 ctxStorage cond + mkPageList showSummary (srPages result) } where mkPageList :: Bool -> [HitPage] -> IO BlockElement @@ -82,21 +87,21 @@ recentUpdatesInterp return (Div [("class", "recentUpdates")] [ Block (List Bullet items) ]) - mkListItem :: Bool -> HitPage -> IO ListItem + mkListItem ∷ Bool → HitPage → IO ListItem mkListItem showSummary page - = do lastMod <- utcToLocalZonedTime (hpLastMod page) + = do lastMod ← utcToLocalZonedTime (hpLastMod page) return ( [ Inline PageLink { linkPage = Just (hpPageName page) , linkFragment = Nothing , linkText = Nothing } , Block ( Div [("class", "date")] - [Inline (Text (formatRFC1123DateTime lastMod))] + [Inline (Text (T.pack $ RFC1123.format lastMod))] ) ] - ++ + ⊕ case (showSummary, hpSummary page) of (True, Just s) - -> [ Block (Paragraph [Text s]) ] - _ -> [] + → [ Block (Paragraph [Text s]) ] + _ → [] )