Frame.purs 4.17 KB
Newer Older
1 2 3 4 5 6
module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where

import DOM.Simple as DOM
import DOM.Simple.Event (MessageEvent)
import DOM.Simple.EventListener (Callback, addEventListener, callback)
import DOM.Simple.Window (window)
7
import Data.Generic.Rep (class Generic)
8
import Data.Show.Generic (genericShow)
9 10 11 12 13
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Tuple (Tuple(..))
import Reactix as R
import Reactix.DOM.HTML as H
14
import Toestand as T
15 16 17
import URI.Extra.QueryPairs as NQP
import URI.Query as Query

18 19
import Gargantext.Prelude

20 21
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types
  ( DataField(..), Search, isIsTex_Advanced )
22 23
import Gargantext.Utils.Reactix as R2

24
here :: R2.Here
25
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.Frame"
26

27 28 29 30
--------------------

data FrameSource = Istex | Searx

31
derive instance Generic FrameSource _
32

33
instance Show FrameSource where
34 35
  show = genericShow

36 37
--------------------
-- | Iframes
38

39 40
type SearchIFramesProps = (
    iframeRef :: R.Ref (Nullable DOM.Element)
41
  , search    :: T.Box Search
42 43
  )

44 45
searchIframes :: R2.Component SearchIFramesProps
searchIframes = R.createElement searchIframesCpt
46
searchIframesCpt :: R.Component SearchIFramesProps
47
searchIframesCpt = here.component "searchIframes" cpt
48
  where
49 50 51
    cpt { iframeRef, search } _ = do
      search' <- T.useLive T.unequal search

52
      pure $ if isIsTex_Advanced search'.datafield
53
         then divIframe { frameSource: Istex, iframeRef, search } []
54 55
      else
        if Just Web == search'.datafield
56
           then divIframe { frameSource: Searx, iframeRef, search } []
57 58 59 60 61
           else H.div {} []


type IFrameProps = (
    frameSource :: FrameSource
62 63
  , iframeRef   :: R.Ref (Nullable DOM.Element)
  , search      :: T.Box Search
64 65
  )

66 67
divIframe :: R2.Component IFrameProps
divIframe = R.createElement divIframeCpt
68
divIframeCpt :: R.Component IFrameProps
69
divIframeCpt = here.component "divIframe" cpt
70
  where
71
    cpt props _ = do
72
      pure $ H.div { className: "frame-search card" }
73
                   [ iframeWith props [] ]
74 75 76

frameUrl :: FrameSource -> String
frameUrl Istex = "https://istex.frame.gargantext.org"
77
frameUrl Searx = "https://searx.frame.gargantext.org" -- 192.168.1.4:8080"
78 79


80 81
iframeWith :: R2.Component IFrameProps
iframeWith = R.createElement iframeWithCpt
82
iframeWithCpt :: R.Component IFrameProps
83
iframeWithCpt = here.component "iframeWith" cpt
84
  where
85 86 87 88
    cpt { frameSource, iframeRef, search } _ = do
      search' <- T.useLive T.unequal search

      pure $ H.iframe { src: src frameSource search'.term
89 90 91 92 93
                      , width: "100%"
                      , height: "100%"
                      , ref: iframeRef
                      , on: { load: \_ -> do
                                 addEventListener window "message" (changeSearchOnMessage url)
94
                                 R2.postMessage iframeRef search'.term
95 96
                            }
                      } []
97
      where
98 99 100 101 102 103 104
        url :: String
        url =  frameUrl frameSource

        changeSearchOnMessage :: String -> Callback MessageEvent
        changeSearchOnMessage url' =
                callback $ \m -> if R2.getMessageOrigin m == url' then do
                                   let {url'', term} = R2.getMessageData m
105
                                   T.modify_ (_ {url = url'', term = term}) search
106 107 108 109 110 111 112 113 114 115 116
                                 else
                                    pure unit

        isTexTermUrl :: String -> String
        isTexTermUrl term = url <> query
          where
            query = Query.print $ NQP.print identity identity qp

            qp = NQP.QueryPairs [ Tuple (NQP.keyFromString "query")
                                  (Just (NQP.valueFromString term))
                                ]
117

118 119 120 121 122 123 124
        searxTermUrl :: String -> String
        searxTermUrl term = url <> query
          where
            query = Query.print $ NQP.print identity identity qp
            qp = NQP.QueryPairs [ Tuple (NQP.keyFromString "q")
                                  (Just $ NQP.valueFromString term)
                                ]
125

126 127 128
        src :: FrameSource -> String -> String
        src Istex term = isTexTermUrl term
        src Searx term = searxTermUrl term