1 module Rakka.Resource.Search
7 import Control.Arrow.ArrowIO
8 import Control.Arrow.ArrowList
9 import Control.Monad.Trans
11 import Network.HTTP.Lucu
12 import Rakka.Environment
15 import Text.HyperEstraier
16 import Text.XML.HXT.Arrow.XmlArrow
17 import Text.XML.HXT.DOM.TypeDefs
20 resSearch :: Environment -> ResourceDef
23 resUsesNativeThread = False
25 , resGet = Just $ handleSearch env
34 <searchResult query="foo bar baz"
40 aaa <hit>foo</hit> bbb
46 handleSearch :: Environment -> Resource ()
48 = do params <- getQueryForm
50 let query = fromMaybe "" $ lookup "q" params
51 from = read $ fromMaybe "0" $ lookup "from" params
52 to = read $ fromMaybe "20" $ lookup "to" params
54 cond <- liftIO $ mkCond query from to
55 result <- searchPages (envStorage env) cond
57 let to' = min (from + length result) to
59 runIdempotentA $ proc ()
60 -> do tree <- ( eelem "/"
61 += ( eelem "searchResult"
62 += sattr "query" query
63 += sattr "from" (show from)
64 += sattr "to" (show to')
65 += sattr "total" (show $ length result)
72 returnA -< outputXmlPage' tree (searchResultToXHTML env)
74 mkCond :: String -> Int -> Int -> IO Condition
76 = do cond <- newCondition
79 setMax cond (to - from)
82 mkPageElem :: ArrowXml a => a SearchResult XmlTree
83 mkPageElem = ( eelem "page"
84 += attr "name" (arr srPageName >>> mkText)
91 mkSnippetTree :: ArrowXml a => a SnippetFragment XmlTree
92 mkSnippetTree = proc fragment
95 HighlightedWord w -> eelem "hit" += txt w
99 searchResultToXHTML :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a XmlTree XmlTree
100 searchResultToXHTML env