)
where
+import qualified Codec.Binary.UTF8.String as UTF8
import Control.Arrow
import Control.Arrow.ArrowIO
+import Control.Arrow.ArrowIf
import Control.Arrow.ArrowList
+import Control.Arrow.ArrowTree
import Control.Monad.Trans
import Data.Maybe
import Network.HTTP.Lucu
+import Network.URI hiding (query, fragment)
import Rakka.Environment
+import Rakka.Page
import Rakka.Resource
import Rakka.Storage
+import Rakka.SystemConfig
+import Rakka.Utils
+import Rakka.Wiki.Engine
+import System.FilePath
import Text.HyperEstraier
+import Text.XML.HXT.Arrow.Namespace
import Text.XML.HXT.Arrow.XmlArrow
+import Text.XML.HXT.Arrow.XmlNodeSet
import Text.XML.HXT.DOM.TypeDefs
handleSearch env
= do params <- getQueryForm
- let query = fromMaybe "" $ lookup "q" params
+ let query = UTF8.decodeString $ fromMaybe "" $ lookup "q" params
from = read $ fromMaybe "0" $ lookup "from" params
to = read $ fromMaybe "20" $ lookup "to" params
mkSnippetTree :: ArrowXml a => a SnippetFragment XmlTree
mkSnippetTree = proc fragment
-> case fragment of
+ Boundary -> eelem "boundary"
NormalText t -> txt t
HighlightedWord w -> eelem "hit" += txt w
-<< ()
searchResultToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
searchResultToXHTML env
= proc tree
- -> this -< tree
+ -> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
+ BaseURI baseURI <- getSysConfA (envSysConf env) -< ()
+ StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+ GlobalLock isGLocked <- getSysConfA (envSysConf env) -< ()
+
+ let cssHref = [uriToString id (mkObjectURI baseURI styleSheet) ""]
+ scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
+
+ pageTitle <- listA (readSubPage env) -< (Nothing, Nothing, "PageTitle")
+ leftSideBar <- listA (readSubPage env) -< (Nothing, Nothing, "SideBar/Left")
+ rightSideBar <- listA (readSubPage env) -< (Nothing, Nothing, "SideBar/Right")
+
+ ( eelem "/"
+ += ( eelem "html"
+ += sattr "xmlns" "http://www.w3.org/1999/xhtml"
+ += ( eelem "head"
+ += ( eelem "title"
+ += txt siteName
+ += txt " - "
+ += getXPathTreesInDoc "/searchResult/@query/text()"
+ )
+ += ( constL cssHref
+ >>>
+ eelem "link"
+ += sattr "rel" "stylesheet"
+ += sattr "type" "text/css"
+ += attr "href" (arr id >>> mkText)
+ )
+ += ( constL scriptSrc
+ >>>
+ eelem "script"
+ += sattr "type" "text/javascript"
+ += attr "src" (arr id >>> mkText)
+ )
+ += ( eelem "script"
+ += sattr "type" "text/javascript"
+ += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
+ += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+ += txt "Rakka.isSpecialPage=true;"
+ )
+ )
+ += ( eelem "body"
+ += ( eelem "div"
+ += sattr "class" "header"
+ )
+ += ( eelem "div"
+ += sattr "class" "center"
+ += ( eelem "div"
+ += sattr "class" "title"
+ += constL pageTitle
+ )
+ += ( eelem "div"
+ += sattr "class" "body"
+ += ( eelem "h1"
+ += txt "Search Result"
+ )
+ += ( eelem "div"
+ += sattr "class" "searchStat"
+ += txt "Search result for "
+ += ( eelem "span"
+ += sattr "class" "queryString"
+ += getXPathTreesInDoc "/searchResult/@query/text()"
+ )
+ += txt ": found "
+ += getXPathTreesInDoc "/searchResult/@total/text()"
+ += txt " pages."
+ )
+ += ( getXPathTreesInDoc "/searchResult/page"
+ >>>
+ eelem "div"
+ += sattr "class" "searchResult"
+ += ( eelem "a"
+ += attr "href" ( getAttrValue "name"
+ >>>
+ arr (\ x -> uriToString id (mkPageURI baseURI x) "")
+ >>>
+ mkText
+ )
+ += (getAttrValue "name" >>> mkText)
+ )
+ += ( eelem "p"
+ += ( getChildren
+ >>>
+ choiceA [ isText :-> this
+ , hasName "boundary" :-> txt " ... "
+ , hasName "hit" :-> ( eelem "span"
+ += sattr "class" "highlighted"
+ += getChildren
+ )
+ ]
+ )
+ )
+ )
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "footer"
+ )
+ += ( eelem "div"
+ += sattr "class" "left sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += constL leftSideBar
+ )
+ )
+ += ( eelem "div"
+ += sattr "class" "right sideBar"
+ += ( eelem "div"
+ += sattr "class" "content"
+ += constL rightSideBar
+ )
+ )
+ )
+ >>>
+ uniqueNamespacesFromDeclAndQNames
+ ) ) -<< tree
+
+
+readSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
+ Environment
+ -> a (Maybe PageName, Maybe XmlTree, PageName) XmlTree
+readSubPage env
+ = proc (mainPageName, mainPage, subPageName) ->
+ do subPage <- getPageA (envStorage env) >>> arr fromJust >>> xmlizePage -< (subPageName, Nothing)
+ subXHTML <- makeSubXHTML (envStorage env) (envSysConf env) (envInterpTable env)
+ -< (mainPageName, mainPage, subPage)
+ returnA -< subXHTML
(function () {
$(document).ready(function () {
- $("input.searchField")
- .val("Search")
- .removeClass("activeField")
- .addClass("inactiveField")
- .focus(function () {
- if ($(this).attr("class").indexOf("inactiveField")) {
- $(this)
- .val("")
- .removeClass("inactiveField")
- .addClass("activeField");
- }
- })
- .keypress(function (e) {
+ var $fld = $("input.searchField")
+
+ $fld.keypress(function (e) {
if (e.which == 10 || e.which == 13) {
window.location = Rakka.baseURI + "search.html?q=" + encodeURI($(this).val());
}
});
+
+ /* 檢索 query が指定されてゐれば、それが最初から入力されてゐる
+ * 状態にする。
+ */
+ var form = Rakka.getQueryForm();
+ if (form["q"] == null) {
+ $fld.val("Search")
+ .removeClass("activeField")
+ .addClass("inactiveField")
+ .focus(function () {
+ if ($(this).attr("class").indexOf("inactiveField")) {
+ $(this)
+ .val("")
+ .removeClass("inactiveField")
+ .addClass("activeField");
+ }
+ });
+ }
+ else {
+ $fld.val(form["q"]);
+ }
});
})();
\ No newline at end of file