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
import Rakka.Storage
import Rakka.SystemConfig
import Rakka.Utils
+import Rakka.W3CDateTime
import Rakka.Wiki.Engine
import System.FilePath
import Text.HyperEstraier hiding (getText)
to="5"
total="5">
- <page name="Page/1">
+ <page name="Page/1" lastModified="2000-01-01T00:00:00">
aaa <hit>foo</hit> bbb
</page>
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
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
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"
)
+= (getAttrValue "name" >>> mkText)
)
+ += ( eelem "div"
+ += sattr "class" "date"
+ += ( getAttrValue "lastModified"
+ >>>
+ arr (zonedTimeToUTC . fromJust . parseW3CDateTime)
+ >>>
+ arrIO utcToLocalZonedTime
+ >>>
+ arr formatRFC1123DateTime
+ >>>
+ mkText
+ )
+ )
+= ( eelem "p"
+= ( getChildren
>>>