~alcinnz/amphiarao

ref: 70de37cee9613aaeceedea91f0ac89cfd83bd8aa amphiarao/src/UI/Search.hs -rw-r--r-- 1.4 KiB
70de37ce — Adrian Cochrane Show syntax-highlighted start tags for elements in HTML UI. 3 years ago
                                                                                
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
8a39949f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
70de37ce Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
d4c10f89 Adrian Cochrane
70de37ce Adrian Cochrane
d4c10f89 Adrian Cochrane
7b26fe8f Adrian Cochrane
70de37ce Adrian Cochrane
7b26fe8f Adrian Cochrane
70de37ce 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
{-# 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)
import qualified UI.Templates as Tpl

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

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

---

offerToLoad q _ _ | Just _ <- parseAbsoluteURI q = return [\langs -> do
        result q $ string 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") $ Tpl.xmlNode $ XC.node el