~alcinnz/amphiarao

ref: 1067e7dade93a5f4193da768bf2e3d6a771c65db amphiarao/src/UI/Search.hs -rw-r--r-- 1.6 KiB
1067e7da — Adrian Cochrane Integrate Haskell Stylist for CSS debugging. 2 years ago
                                                                                
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
8a39949f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
a6104355 Adrian Cochrane
7b26fe8f Adrian Cochrane
70de37ce Adrian Cochrane
d4c10f89 Adrian Cochrane
58648b62 Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
b8351f83 Adrian Cochrane
f33ba874 Adrian Cochrane
2e0a2343 Adrian Cochrane
d4c10f89 Adrian Cochrane
70de37ce Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
a6104355 Adrian Cochrane
7b26fe8f Adrian Cochrane
58648b62 Adrian Cochrane
7b26fe8f Adrian Cochrane
a6104355 Adrian Cochrane
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