{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module UI.Search(engines) where import Text.Blaze.Html5 as H import Text.Blaze.Html5.Attributes as A import Text.Blaze.Html import Data.Text as Txt import Data.UUID as ID import Internal import Messages import Network.URI (parseAbsoluteURI) import qualified Internal.Elements as Els import qualified Text.XML.Cursor as XC import qualified Text.XML as XML import Control.Monad (mapM) import qualified UI.Templates as Tpl engines :: [( [Text] -> Html, String -> Session -> XC.Cursor -> IO [[Text] -> Html] )] engines = [ (const "URL", offerToLoad), (const "CSS", queryEls "css selector"), (flip l LinkSearchExact, queryEls "link text"), -- Only useful if it promotes results higher. (flip l LinkSearch, queryEls "partial link text") -- (const "XPath", queryEls "xpath") -- FIXME parser infinite loops... ] result href' = a ! href (stringValue href') ! target "preview" disclosure = "⤷" --- offerToLoad q _ _ | Just _ <- parseAbsoluteURI q = return [\langs -> do H.form ! action "nav/load" ! method "POST" $ do input ! type_ "hidden" ! name "url" ! value (stringValue q) result q $ string q button ! type_ "submit" ! A.title (l' langs DebugLink') $ disclosure ] | otherwise = return [] queryEls method q session root | Right ret <- Els.find (Els.Find method q) root = do Prelude.map formatEl <$> mapM (\el -> (,) el <$> registerEl session el) ret | otherwise = return [] formatEl (el, uuid) langs = result ("el/" ++ ID.toString uuid ++ "/preview") $ Tpl.xmlNode' $ XC.node el