Wrote many...

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

diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs
new file mode 100644 (file)
index 0000000..2a10372
--- /dev/null
+++ b/Rakka/Wiki/Interpreter/PageList.hs
@@ -0,0 +1,75 @@
+module Rakka.Wiki.Interpreter.PageList
+    ( interpreters
+    )
+    where
+
+import           Data.Maybe
+import           Network.HTTP.Lucu.RFC1123DateTime
+import           Rakka.Page
+import           Rakka.Storage
+import           Rakka.Wiki
+import           Rakka.Wiki.Interpreter
+import           Text.HyperEstraier
+
+
+interpreters :: [Interpreter]
+interpreters = [ recentUpdatesInterp ]
+
+
+-- <div class="recentUpdates">
+--   <ul>
+--     <li>
+--       <a href="...">...</a>
+--       <span class="date">...</span>
+--       <p> <!-- サマリが無ければ存在しない -->
+--         blah blah...
+--       </p>
+--     </li>
+--     ...
+--   </ul>
+-- </div>
+recentUpdatesInterp :: Interpreter
+recentUpdatesInterp 
+    = BlockCommandInterpreter {
+        bciName      = "recentUpdates"
+      , bciInterpret
+          = \ ctx (BlockCommand _ args _)
+          -> do let items = fromMaybe 10 $ fmap read $ lookup "items" 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
+
+                result <- searchPages sto cond
+                pages  <- mapM ( \ (name, rev)
+                                     -> getPage sto name (Just rev) >>= return . fromJust
+                               ) result
+
+                return $ mkPageList pages
+      }
+    where
+      mkPageList :: [Page] -> BlockElement
+      mkPageList pages
+          = Div [("class", "recentUpdates")]
+            [ Block (List Bullet (map mkListItem pages)) ]
+
+      mkListItem :: Page -> ListItem
+      mkListItem page
+          = [ Inline ( PageLink {
+                         linkPage     = Just (pageName page)
+                       , linkFragment = Nothing
+                       , linkText     = Nothing
+                       }
+                    )
+            , Inline ( Span [("class", "date")]
+                                [Text (formatRFC1123DateTime (pageLastMod page))]
+                     )
+            ]
+            ++
+            case pageSummary page of
+              Just s  -> [ Block (Paragraph [Text s]) ]
+              Nothing -> []