merge branch origin/master

[Rakka.git] / Rakka / Wiki / Interpreter / PageList.hs

diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs
index 2fe9d305fc46509926a60aa6b1ddff9d22a5c403..4faee0f091ca48f2fd1cdce27895308d8eb2984f 100644 (file)
--- 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
 --     ...
 --   </ul>
 -- </div>
-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]) ]
+                          _   → []
                       )