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=4faee0f091ca48f2fd1cdce27895308d8eb2984f;hp=2fe9d305fc46509926a60aa6b1ddff9d22a5c403;hb=HEAD;hpb=9932fbe6504e8b812703291e2497a5f010880d3b diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index 2fe9d30..4faee0f 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -1,13 +1,22 @@ +{-# LANGUAGE + OverloadedStrings + , RecordWildCards + , UnicodeSyntax + #-} module Rakka.Wiki.Interpreter.PageList ( interpreters ) where - -import Control.Monad -import Data.Maybe +import Control.Applicative +import Control.Monad +import qualified Data.ByteString.Char8 as C8 +import Data.Maybe +import Data.Monoid.Unicode +import qualified Data.Text as T import Data.Time import qualified Data.Time.RFC1123 as RFC1123 import Network.URI +import Prelude.Unicode import Rakka.Storage import Rakka.SystemConfig import Rakka.Utils @@ -31,9 +40,9 @@ recentUpdatesURLInterp = \ ctx _ -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx) let uri = baseURI { uriPath = uriPath baseURI "search.html" - , uriQuery = '?' : mkQueryString [ ("q" , "[UVSET]") - , ("order", "@mdate NUMD") - ] + , uriQuery = '?' : C8.unpack (mkQueryString [ ("q" , "[UVSET]") + , ("order", "@mdate NUMD") + ]) } return $ ExternalLink uri (Just "List all pages") } @@ -51,29 +60,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 +88,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 (RFC1123.format lastMod))] + [Inline (Text (T.pack $ RFC1123.format lastMod))] ) ] - ++ + ⊕ case (showSummary, hpSummary page) of (True, Just s) - -> [ Block (Paragraph [Text s]) ] - _ -> [] + → [ Block (Paragraph [Text s]) ] + _ → [] )