X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FSearch.hs;h=eb4acf253d11c4d0535bed1c25082fc350e58fec;hb=88747f2;hp=c46d40152c34f4ab25e8c43f8e2afe8c9af81e07;hpb=cac96112c79075ff03dd38616a314dd293699170;p=Rakka.git diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs index c46d401..eb4acf2 100644 --- a/Rakka/Resource/Search.hs +++ b/Rakka/Resource/Search.hs @@ -2,18 +2,13 @@ module Rakka.Resource.Search ( resSearch ) 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.List import Data.Maybe import Data.Time +import qualified Data.Time.RFC1123 as RFC1123 +import qualified Data.Time.W3C as W3C import Network.HTTP.Lucu -import Network.HTTP.Lucu.RFC1123DateTime import Network.URI hiding (query, fragment) import Rakka.Environment import Rakka.Page @@ -21,14 +16,10 @@ 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) -import Text.XML.HXT.Arrow.Namespace -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlNodeSet -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.XPath resSearch :: Environment -> ResourceDef @@ -52,6 +43,11 @@ maxSectionWindowSize :: Int maxSectionWindowSize = 10 +findQueryParam :: String -> [FormData] -> Maybe String +findQueryParam name qps + = do fd <- find (\ qp -> fdName qp == name) qps + return $ UTF8.toString $ fdContent fd + {- Resource () handleSearch env = do params <- getQueryForm - let query = UTF8.decodeString $ fromMaybe "" $ lookup "q" params - order = fmap UTF8.decodeString (lookup "order" params) + let query = fromMaybe "" $ findQueryParam "q" params + order = findQueryParam "order" params from = fromMaybe 0 - $ fmap read $ lookup "from" params + $ fmap read $ findQueryParam "from" params to = fromMaybe (from + resultsPerSection) - $ fmap read $ lookup "to" params + $ fmap read $ findQueryParam "to" params cond <- liftIO $ mkCond query order from to result <- searchPages (envStorage env) cond @@ -117,7 +113,7 @@ handleSearch env += attr "name" (arr hpPageName >>> mkText) += attr "lastModified" ( arrIO (utcToLocalZonedTime . hpLastMod) >>> - arr formatW3CDateTime + arr W3C.format >>> mkText ) @@ -282,11 +278,11 @@ searchResultToXHTML env += sattr "class" "date" += ( getAttrValue "lastModified" >>> - arr (zonedTimeToUTC . fromJust . parseW3CDateTime) + arr (zonedTimeToUTC . fromJust . W3C.parse) >>> arrIO utcToLocalZonedTime >>> - arr formatRFC1123DateTime + arr RFC1123.format >>> mkText )