.searchResult .date

[Rakka.git] / Rakka / Resource / Search.hs

diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs
index e4456e878387ef79e5bd414b1fe7c374bc4c8c7e..6624e9e8baeafcd2f44c9a2d57c4c777be7216f2 100644 (file)
--- a/Rakka/Resource/Search.hs
+++ b/Rakka/Resource/Search.hs
@@ -11,7 +11,9 @@ import           Control.Arrow.ArrowList
 import           Control.Arrow.ArrowTree
 import           Control.Monad.Trans
 import           Data.Maybe
+import           Data.Time
 import           Network.HTTP.Lucu
+import           Network.HTTP.Lucu.RFC1123DateTime
 import           Network.URI hiding (query, fragment)
 import           Rakka.Environment
 import           Rakka.Page
@@ -19,6 +21,7 @@ import           Rakka.Resource
 import           Rakka.Storage
 import           Rakka.SystemConfig
 import           Rakka.Utils
+import           Rakka.W3CDateTime
 import           Rakka.Wiki.Engine
 import           System.FilePath
 import           Text.HyperEstraier hiding (getText)
@@ -55,7 +58,7 @@ maxSectionWindowSize = 10
                 to="5"
                 total="5">
 
-    <page name="Page/1">
+    <page name="Page/1" lastModified="2000-01-01T00:00:00">
       aaa <hit>foo</hit> bbb
     </page>
 
@@ -77,7 +80,8 @@ handleSearch env
 
          let to' = min (from + length (srPages result)) to
 
-         runIdempotentA $ proc ()
+         BaseURI baseURI <- getSysConf (envSysConf env)
+         runIdempotentA baseURI $ proc ()
              -> do tree <- ( eelem "/"
                              += ( eelem "searchResult"
                                   += sattr "query" query
@@ -100,22 +104,29 @@ handleSearch env
                setMax    cond (to - from)
                return cond
 
-      mkPageElem :: ArrowXml a => a HitPage XmlTree
+      mkPageElem :: (ArrowChoice a, ArrowXml a, ArrowIO a) => a HitPage XmlTree
       mkPageElem = ( eelem "page"
                      += attr "name" (arr hpPageName >>> mkText)
+                     += attr "lastModified" ( arrIO (utcToLocalZonedTime . hpLastMod)
+                                              >>>
+                                              arr formatW3CDateTime
+                                              >>>
+                                              mkText
+                                            )
                      += ( arrL hpSnippet
                           >>>
                           mkSnippetTree
                         )
                    )
 
-      mkSnippetTree :: ArrowXml a => a SnippetFragment XmlTree
+      mkSnippetTree :: (ArrowChoice a, ArrowXml a) => a SnippetFragment XmlTree
       mkSnippetTree = proc fragment
                     -> case fragment of
-                         Boundary          -> eelem "boundary"
-                         NormalText      t -> txt t
-                         HighlightedWord w -> eelem "hit" += txt w
-                         -<< ()
+                         Boundary          -> eelem "boundary" -< ()
+                         NormalText      t -> mkText           -< t
+                         HighlightedWord w -> ( eelem "hit"
+                                                += mkText
+                                              ) -< w
 
 
 searchResultToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
@@ -241,7 +252,7 @@ searchResultToXHTML env
                  uniqueNamespacesFromDeclAndQNames
                ) ) -<< tree
     where
-      formatItem :: (ArrowXml a, ArrowChoice a) => URI -> a XmlTree XmlTree
+      formatItem :: (ArrowXml a, ArrowChoice a, ArrowIO a) => URI -> a XmlTree XmlTree
       formatItem baseURI
           = ( eelem "div"
               += sattr "class" "searchResult"
@@ -254,6 +265,19 @@ searchResultToXHTML env
                                   )
                    += (getAttrValue "name" >>> mkText)
                  )
+              += ( eelem "div"
+                   += sattr "class" "date"
+                   += ( getAttrValue "lastModified"
+                        >>>
+                        arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
+                        >>>
+                        arrIO utcToLocalZonedTime
+                        >>>
+                        arr formatRFC1123DateTime
+                        >>>
+                        mkText
+                      )
+                 )
               += ( eelem "p"
                    += ( getChildren
                         >>>