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