~alcinnz/amphiarao

ref: 7b26fe8f55dd630cde332fb7663e163ae441d70b amphiarao/src/UI/Search.hs -rw-r--r-- 1.4 KiB
7b26fe8f — Adrian Cochrane Expose CSS selector search in UI FIXME: build the linked pages. 3 years ago
                                                                                
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
8a39949f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f 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
{-# 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 Control.Monad (mapM)

engines :: [(
    [Text] -> Html,
    String -> Session -> Session' -> IO [[Text] -> Html]
  )]
engines = [
    (const "URL", offerToLoad),
    (const "CSS", queryEls "css selector")
  ]

result href' label = a ! href (stringValue href') ! target "preview" $ string label
disclosure = "⤷"

---

offerToLoad q _ _ | Just _ <- parseAbsoluteURI q = return [\langs -> do
        result q q
        H.form ! action "nav/load" ! method "POST" $ do
            input ! type_ "hidden" ! name "url" ! value (stringValue q)
            button ! type_ "submit" ! class_ "disclosure" ! A.title (l' langs DebugLink') $ disclosure
      ]
    | otherwise = return []

queryEls method q session session'
    | Right ret <- Els.find (Els.Find method q) $ XC.fromDocument $ document session' = do
        Prelude.map formatEl <$> mapM (\el -> (,) el <$> registerEl session el) ret
    | otherwise = return []

formatEl (el, uuid) langs = result ("el/" ++ ID.toString uuid ++ "/preview") $ show $ XC.node el