Commit 99d36e28 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE] searx iframe fix

parents 7ca6c353 9c7cea98
......@@ -5,9 +5,13 @@ import Data.Traversable (traverse_)
import React as React
import React (ReactClass, ReactElement, Children)
import React.DOM (div')
import Gargantext.Prelude
import Effect (Effect)
import Effect.Timer (IntervalId, setInterval, clearInterval)
import Effect.Timer (IntervalId, TimeoutId, setInterval, clearInterval, setTimeout, clearTimeout)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
data Action = Update
......@@ -27,7 +31,7 @@ autoUpdateClass =
pure { state: {intervalId: Nothing}
, render: pure $ div' []
, componentDidMount: do
{duration,effect} <- React.getProps this
{duration, effect} <- React.getProps this
intervalId <- setInterval duration effect
React.setState this {intervalId: Just intervalId}
, componentWillUnmount: do
......@@ -37,3 +41,25 @@ autoUpdateClass =
autoUpdateElt :: Props -> ReactElement
autoUpdateElt props = React.createElement autoUpdateClass props []
autoUpdate :: Record PropsRow -> R.Element
autoUpdate props = R.createElement autoUpdateCpt props []
autoUpdateCpt :: R.Component PropsRow
autoUpdateCpt = R.hooksComponent "G.C.AU.autoUpdate" cpt
where
cpt { duration, effect } _ = do
intervalRef <- R.useRef Nothing
R.useEffect' $ do
let mInterval = R.readRef intervalRef
case mInterval of
Nothing -> do
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
Just intervalId -> do
clearInterval intervalId
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
pure $ H.div {} []
......@@ -11,14 +11,15 @@ import Data.Nullable (Nullable)
import Data.String (toLower)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Search, isIsTex_Advanced)
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==), class Show, show)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Search, isIsTex_Advanced)
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==), class Show, show)
import Gargantext.Utils.Reactix as R2
--------------------
data FrameSource = Istex | Searx
......@@ -30,59 +31,93 @@ instance showFrameSource :: Show FrameSource where
--------------------
-- | Iframes
searchIframes :: R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
searchIframes search@(search' /\ _) iframeRef =
if isIsTex_Advanced search'.datafield
then divIframe Istex search iframeRef
else
if Just Web == search'.datafield
then divIframe Searx search iframeRef
else H.div {} []
divIframe :: FrameSource
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
divIframe frameSource search@(search' /\ _) iframeRef =
H.div { className: "frame-search panel panel-default" }
[ iframeWith (frameUrl frameSource)search iframeRef ]
frameUrl :: FrameSource -> String
frameUrl frameSource = frameUrl' (toLower $ show frameSource)
type SearchIFramesProps = (
iframeRef :: R.Ref (Nullable DOM.Element)
, search :: R.State Search
)
searchIframes :: Record SearchIFramesProps -> R.Element
searchIframes props = R.createElement searchIframesCpt props []
searchIframesCpt :: R.Component SearchIFramesProps
searchIframesCpt = R.hooksComponent "G.C.F.T.N.A.S.F.searchIframes" cpt
where
frameUrl' s = "https://" <> s <> ".frame.gargantext.org"
iframeWith :: String
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
iframeWith url (search /\ setSearch) iframeRef =
H.iframe { src: isTexTermUrl search.term
, width: "100%"
, height: "100%"
, ref: iframeRef
, on: { load: \_ -> do
addEventListener window "message" (changeSearchOnMessage url)
R2.postMessage iframeRef search.term
}
} []
cpt { iframeRef, search: search@(search' /\ _) } _ = do
pure $ if isIsTex_Advanced search'.datafield
then divIframe { frameSource: Istex, iframeRef, search }
else
if Just Web == search'.datafield
then divIframe { frameSource: Searx, iframeRef, search }
else H.div {} []
type IFrameProps = (
frameSource :: FrameSource
, iframeRef :: R.Ref (Nullable DOM.Element)
, search :: R.State Search
)
divIframe :: Record IFrameProps -> R.Element
divIframe props = R.createElement divIframeCpt props []
divIframeCpt :: R.Component IFrameProps
divIframeCpt = R.hooksComponent "G.C.F.T.N.A.S.F.divIframe" cpt
where
changeSearchOnMessage :: String -> Callback MessageEvent
changeSearchOnMessage url' =
callback $ \m -> if R2.getMessageOrigin m == url'
then do
let {url'', term} = R2.getMessageData m
setSearch $ _ {url = url'', term = term}
else
pure unit
isTexTermUrl term = url <> query
cpt { frameSource, iframeRef, search: search@(search' /\ _) } _ = do
pure $ H.div { className: "frame-search panel panel-default" }
[ iframeWith { frameSource, iframeRef, search } ]
frameUrl :: FrameSource -> String
frameUrl Istex = "https://istex.frame.gargantext.org"
frameUrl Searx = "http://searx.frame.gargantext.org" -- 192.168.1.4:8080"
iframeWith :: Record IFrameProps -> R.Element
iframeWith props = R.createElement iframeWithCpt props []
iframeWithCpt :: R.Component IFrameProps
iframeWithCpt = R.hooksComponent "G.C.F.T.N.A.S.F.iframeWith" cpt
where
cpt { frameSource, iframeRef, search: (search /\ setSearch) } _ =
pure $ H.iframe { src: src frameSource search.term
, width: "100%"
, height: "100%"
, ref: iframeRef
, on: { load: \_ -> do
addEventListener window "message" (changeSearchOnMessage url)
R2.postMessage iframeRef search.term
}
} []
where
query = Query.print $ NQP.print identity identity qp
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
setSearch $ _ {url = url'', term = term}
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))
]
qp = NQP.QueryPairs [ Tuple (NQP.keyFromString "query")
(Just (NQP.valueFromString term))
]
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)
]
src :: FrameSource -> String -> String
src Istex term = isTexTermUrl term
src Searx term = searxTermUrl term
......@@ -23,7 +23,7 @@ searchBar :: Record Props -> R.Element
searchBar props = R.createElement searchBarCpt props []
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
searchBarCpt = R.hooksComponent "G.C.F.T.N.A.S.SB.searchBar" cpt
where
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
......
......@@ -47,7 +47,7 @@ searchField p = R.createElement searchFieldComponent p []
--searchFieldComponent :: R.Memo Props
--searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) eqProps
searchFieldComponent :: R.Component Props
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
searchFieldComponent = R.hooksComponent "G.C.F.T.N.A.S.SF.searchField" cpt
where
cpt props@{onSearch, search: search@(s /\ _)} _ = do
iframeRef <- R.useRef null
......@@ -75,7 +75,7 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
then componentCNRS search
else H.div {} []
, H.div {} [ searchIframes search iframeRef ]
, H.div {} [ searchIframes { iframeRef, search } ]
, if needsLang s.datafield
then langNav search props.langs
......
......@@ -68,6 +68,10 @@ import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^?))
import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just)
......@@ -143,8 +147,13 @@ initialPageParams session nodeId listIds tabType =
newtype NgramsTerm = NormNgramsTerm String
derive instance eqNgramsTerm :: Eq NgramsTerm
derive instance ordNgramsTerm :: Ord NgramsTerm
derive instance genericNgramsTerm :: Generic NgramsTerm _
instance eqNgramsTerm :: Eq NgramsTerm where
eq = genericEq
instance ordNgramsTerm :: Ord NgramsTerm where
compare = genericCompare
instance showNgramsTerm :: Show NgramsTerm where
show = genericShow
instance encodeJsonNgramsTerm :: EncodeJson NgramsTerm where
encodeJson (NormNgramsTerm s) = encodeJson s
......@@ -692,11 +701,11 @@ syncPatches props { ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPa
}
syncPatchesR :: forall p s. CoreParams p -> R.State (CoreState s) -> Effect Unit
syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ngramsNewElems, ngramsPatches}
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) = do
syncPatchesR props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsNewElems, ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
setState $ \s ->
s { ngramsLocalPatch = fromNgramsPatches mempty
......
......@@ -29,14 +29,14 @@ instance decodeNodePoly :: (DecodeJson a)
hyperdata <- obj .: "hyperdata"
hyperdata' <- decodeJson hyperdata
pure $ NodePoly { id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
}
pure $ NodePoly { id
, date
, hyperdata: hyperdata'
, name
, parentId
, typename
, userId
}
newtype HyperdataList = HyperdataList { preferences :: String }
......
module Gargantext.Components.Nodes.Corpus.Document where
import Prelude (class Show, bind, mempty, pure, show, ($), (<>))
import Prelude (class Show, bind, mempty, pure, show, ($), (<>), Unit)
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import React (ReactClass, Children)
import React.DOM (div, h4, li, p, span, text, ul)
import React.DOM.Props (className)
import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Reactix.DOM.HTML as H
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.AutoUpdate ( autoUpdate)
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatchR
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatchesR )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
......@@ -28,11 +28,13 @@ import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2
type DocPath =
{ nodeId :: Int
{
corpusId :: Maybe Int
, listIds :: Array Int
, corpusId :: Maybe Int
, nodeId :: Int
, session :: Session
, tabType :: TabType
, session :: Session }
}
type NodeDocument = NodePoly Document
......@@ -41,10 +43,10 @@ type LoadedData =
, ngramsTable :: VersionedNgramsTable
}
type Props =
{ loaded :: LoadedData
type Props = (
loaded :: LoadedData
, path :: DocPath
}
)
-- This is a subpart of NgramsTable.State.
type State = CoreState ()
......@@ -295,74 +297,85 @@ instance decodeDocument :: DecodeJson Document
--, text
}
docViewSpec :: Spec State Props Action
docViewSpec = simpleSpec performAction render
docViewWrapper :: Record Props -> R.Element
docViewWrapper props = R.createElement docViewWrapperCpt props []
docViewWrapperCpt :: R.Component Props
docViewWrapperCpt = R.hooksComponent "G.C.N.C.D.docViewWrapper" cpt
where
performAction :: PerformAction State Props Action
performAction Synchronize {path} state = do
syncPatches path state
performAction (SetTermListItem n pl) _ {ngramsVersion} =
commitPatch (Versioned {version: ngramsVersion, data: pt})
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch n pe
performAction (AddNewNgram ngram termList) _ {ngramsVersion} =
commitPatch (Versioned {version: ngramsVersion, data: pt})
where
pt = addNewNgram ngram termList
render :: Render State Props Action
render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }
{ ngramsLocalPatch
, ngramsValidPatch
}
_reactChildren =
[ autoUpdateElt { duration: 3000
, effect: dispatch Synchronize
}
, div [className "container1"]
cpt { loaded, path } _ = do
state <- R.useState' $ initialState { loaded }
pure $ docView { loaded, path, state }
type DocViewProps = (
state :: R.State State
| Props
)
docView :: Record DocViewProps -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component DocViewProps
docViewCpt = R.hooksComponent "G.C.N.C.D.docView" cpt
where
cpt props@{ loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }, state } _ = do
pure $ H.div {} [
autoUpdate { duration: 3000, effect: dispatch Synchronize }
, H.div { className: "container1" }
[
div [className "row"]
R2.row
[
div [className "col-md-8"]
[ h4 [] [annotate doc.title]
, ul [className "list-group"]
[ li' [ span [] [text' doc.source]
R2.col 8
[ H.h4 {} [ annotate state doc.title ]
, H.ul { className: "list-group" }
[ li' [ H.span {} [ text' doc.source ]
, badge "source"
]
-- TODO add href to /author/ if author present in
, li' [ span [] [text' doc.authors]
, li' [ H.span {} [ text' doc.authors ]
, badge "authors"
]
, li' [ span [] [text $ publicationDate $ Document doc]
, li' [ H.span {} [ H.text $ publicationDate $ Document doc ]
, badge "date"
]
]
, badge "abstract"
, annotate doc.abstract
, div [className "jumbotron"]
[ p [] [text "Empty Full Text"]
, annotate state doc.abstract
, H.div { className: "jumbotron" }
[ H.p {} [ H.text "Empty Full Text" ]
]
]
]
]
]
where
ngramsTable = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable
setTermList ngram Nothing newList = dispatch $ AddNewNgram ngram newList
setTermList ngram (Just oldList) newList = dispatch $ SetTermListItem ngram (replace oldList newList)
annotate text = R2.scuff $ AnnotatedField.annotatedField { ngrams: ngramsTable, setTermList, text }
li' = li [className "list-group-item justify-content-between"]
text' x = text $ fromMaybe "Nothing" x
badge s = span [className "badge badge-default badge-pill"] [text s]
dispatch :: Action -> Effect Unit
dispatch (AddNewNgram ngram termList) = do
commitPatchR (Versioned {version, data: pt}) state
where
({ ngramsVersion: version } /\ _) = state
pt = addNewNgram ngram termList
dispatch (SetTermListItem ngram termList) = do
commitPatchR (Versioned {version, data: pt}) state
where
({ ngramsVersion: version } /\ _) = state
pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do
syncPatchesR props.path props.state
annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state
, setTermList: setTermList state
, text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" }
ngramsTable ({ ngramsLocalPatch, ngramsValidPatch } /\ _) = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable
setTermList state ngram Nothing newList = dispatch (AddNewNgram ngram newList)
setTermList state ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata : Document doc} = document
docViewClass :: ReactClass { children :: Children
, loaded :: LoadedData
, path :: DocPath
}
docViewClass = createClass "DocumentView" docViewSpec initialState
type LayoutProps = (
corpusId :: Maybe Int
, listId :: Int
......@@ -398,7 +411,7 @@ documentLayoutWithKeyCpt = R.hooksComponent "G.C.N.C.D.documentLayoutWithKey" cp
where
cpt { corpusId, listId, nodeId, session } _ = do
useLoader path loadData $ \loaded ->
R2.createElement' docViewClass {path, loaded} []
docViewWrapper {path, loaded}
where
tabType = TabDocument (TabNgramType CTabTerms)
path = { corpusId, listIds: [listId], nodeId, session, tabType }
......
......@@ -96,7 +96,7 @@ publicLayoutCpt = R.hooksComponent "[G.C.N.H.Public.publicLayout" cpt
[ H.h2 {} [H.text "Public Maps"]
, H.p { className: "lead text-muted"}
[ H.text "Discover maps made with "
, H.div {className: "fa fa-heart"} []
, H.span {className: "fa fa-heart"} []
]
, H.p { className:"flex-space-around" }
[ H.a { className: "btn btn-primary my-2"
......
module Gargantext.Hooks.Loader where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut.Core (stringify)
import Data.Argonaut.Parser (jsonParser)
......@@ -8,9 +7,14 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Prelude
......@@ -18,9 +22,6 @@ import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils as GU
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Milkis as M
import Reactix as R
import Web.Storage.Storage as WSS
useLoader :: forall path st. Eq path
......
......@@ -9,7 +9,7 @@ exports._makeRequest = function() {
exports._openCache = function(cacheName) {
return function() {
return caches.open(cacheName);
return window.caches.open(cacheName);
}
}
......@@ -36,3 +36,9 @@ exports._match = function(cache) {
}
}
}
exports._fetch = function(req) {
return function() {
return fetch(req);
}
}
......@@ -69,6 +69,7 @@ add cache req = toAffE $ _add cache req
match :: Cache -> Request -> Aff (Maybe M.Response)
match cache req = do
res <- toAffE $ _match cache req
-- _match returns a null/undefined value when cache entity not found
case runExcept $ F.readNullOrUndefined res of
Left err -> throwError $ error $ show err
Right v -> pure $ F.unsafeFromForeign <$> v
......@@ -96,15 +97,33 @@ cachedJson cache req = do
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> err
Right b -> pure b
delete :: Cache -> Request -> Aff Unit
delete cache req = toAffE $ _delete cache req
-- No cache: raw API calls
fetch :: Request -> Aff M.Response
fetch req = do
res <- toAffE $ _fetch req
pure $ F.unsafeFromForeign res
pureJson :: forall a. DecodeJson a => Request -> Aff a
pureJson req = do
res <- fetch req
j <- M.json res
case decodeJson (F.unsafeFromForeign j) of
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> err
Right b -> pure b
foreign import _makeRequest :: forall options trash. Union options trash M.Options =>
M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
foreign import _openCache :: String -> Effect (Promise Cache)
foreign import _delete :: Cache -> Request -> Effect (Promise Unit)
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
foreign import _fetch :: Request -> Effect (Promise F.Foreign)
......@@ -253,7 +253,7 @@ row :: Array R.Element -> R.Element
row children = H.div { className: "row" } children
col :: Int -> Array R.Element -> R.Element
col n children = H.div { className : "col-md" <> show n } children
col n children = H.div { className : "col-md-" <> show n } children
innerText :: DOM.Element -> String
innerText e = e .. "innerText"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment