~alcinnz/amphiarao

ref: 2e0a2343f591f1e45ba55eae2b3a06d9648c13ff amphiarao/src/UI/Search.hs -rw-r--r-- 1.6 KiB
2e0a2343 — Adrian Cochrane Integrate HXT for working XPath support. 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
{-# 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")
  ]

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