Commit adb0e070 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-ngrams-refactoring

parents 9216903e 9b79da8f
......@@ -24,12 +24,11 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
type CommonProps =
(
frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
)
------------------------------------------------------------------------
......@@ -93,16 +92,16 @@ toHtml p@{ frontends
, tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps
pAction = performAction (RecordE.pick p :: Record PerformActionProps)
pAction = performAction (RecordE.pick p :: Record PerformActionProps)
cpt _ _ = do
let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let nodeId = mkNodeId session id
let folderIsOpen = Set.member nodeId (fst openNodes)
let setFn = if folderIsOpen then Set.delete else Set.insert
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
let withId (NTree (LNode {id: id'}) _) = id'
......@@ -154,15 +153,14 @@ childNodes props@{ children } =
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, asyncTasks} _ = do
tasks <- R.useState' asyncTasks
pure $ toHtml (Record.merge commonProps
{ tasks, tree })
pure $ toHtml (Record.merge commonProps { tasks, tree })
type PerformActionProps =
( openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree
, reload :: R.State Reload
, session :: Session
, tasks :: R.State (Array GT.AsyncTaskWithType)
, tree :: FTree
)
performAction :: Record PerformActionProps
......@@ -191,10 +189,13 @@ performAction p@{ reload: (_ /\ setReload)
performAction p RefreshTree
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, reload: (_ /\ setReload)
, tasks: (_ /\ setAsyncTasks)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
-- task <- createNodeAsync session id $ CreateValue {name, nodeType}
task <- createNode session id $ CreateValue {name, nodeType}
-- liftEffect $ setAsyncTasks $ A.cons task
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
performAction p RefreshTree
......
......@@ -16,9 +16,12 @@ filterWithRights (show action if user can only)
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
data Status a = IsBeta a | IsProd a
data NodeAction = Documentation NodeType
| SearchBox
| Download | Upload | Refresh
| Download | Upload | Refresh | Config
| Move | Clone | Delete
| Share | Link NodeType
| Add (Array NodeType)
......@@ -36,8 +39,9 @@ instance eqNodeAction :: Eq NodeAction where
eq Delete Delete = true
eq Share Share = true
eq (Link x) (Link y) = true && (x == y)
eq (Add x) (Add y) = true && (x == y)
eq (Add x) (Add y) = true && (x == y)
eq CopyFromCorpus CopyFromCorpus = true
eq Config Config = true
eq _ _ = false
instance showNodeAction :: Show NodeAction where
......@@ -50,6 +54,7 @@ instance showNodeAction :: Show NodeAction where
show Clone = "Clone"
show Delete = "Delete"
show Share = "Share"
show Config = "Config"
show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show CopyFromCorpus = "Copy from corpus"
......@@ -64,10 +69,11 @@ glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "transfer"
glyphiconNodeAction Download = "download"
glyphiconNodeAction CopyFromCorpus = "random"
glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction _ = ""
------------------------------------------------------------------------
------------------------------------------------------------------------
data SettingsBox =
SettingsBox { show :: Boolean
......@@ -79,14 +85,14 @@ data SettingsBox =
settingsBox :: NodeType -> SettingsBox
settingsBox NodeUser = SettingsBox {
show: true
show : true
, edit : false
, doc : Documentation NodeUser
, buttons : [ Delete ]
}
settingsBox FolderPrivate = SettingsBox {
show: true
show : true
, edit : false
, doc : Documentation FolderPrivate
, buttons : [ Add [ Corpus
......@@ -97,7 +103,7 @@ settingsBox FolderPrivate = SettingsBox {
}
settingsBox Team = SettingsBox {
show: true
show : true
, edit : true
, doc : Documentation Team
, buttons : [ Add [ Corpus
......@@ -108,7 +114,7 @@ settingsBox Team = SettingsBox {
}
settingsBox FolderShared = SettingsBox {
show: true
show : true
, edit : true
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
......@@ -117,7 +123,7 @@ settingsBox FolderShared = SettingsBox {
}
settingsBox FolderPublic = SettingsBox {
show: true
show : true
, edit : false
, doc : Documentation FolderPublic
, buttons : [ Add [ Corpus
......@@ -126,86 +132,91 @@ settingsBox FolderPublic = SettingsBox {
]
}
settingsBox Folder = SettingsBox {
show: true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Delete
]
}
settingsBox Folder =
SettingsBox { show : true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Delete
]
}
settingsBox Corpus = SettingsBox {
show: true
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
, Add [ NodeList
, Graph
, Dashboard
]
, Upload
, Download
--, Share
--, Move
--, Clone
, Link Annuaire
, Delete
]
}
settingsBox Corpus =
SettingsBox { show : true
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
, Add [ NodeList
, Graph
, Dashboard
]
, Upload
, Download
--, Share
--, Move
--, Clone
, Link Annuaire
, Delete
]
}
settingsBox Texts = SettingsBox {
show: true
, edit : false
, doc : Documentation Texts
, buttons : [ Upload
, Download
-- , Delete
]
}
settingsBox Texts =
SettingsBox { show : true
, edit : false
, doc : Documentation Texts
, buttons : [ Refresh
, Upload
, Download
-- , Delete
]
}
settingsBox Graph = SettingsBox {
show: true
, edit : false
, doc : Documentation Graph
, buttons : [ Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox Graph =
SettingsBox { show : true
, edit : false
, doc : Documentation Graph
, buttons : [ Refresh
, Config
, Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox NodeList = SettingsBox {
show: true
, edit : false
, doc : Documentation NodeList
, buttons : [ Upload
, CopyFromCorpus
, Download
-- , Delete
]
}
settingsBox NodeList =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeList
, buttons : [ Refresh
, Config
, Download
, Upload
, CopyFromCorpus
, Delete
]
}
settingsBox Dashboard = SettingsBox {
show: true
, edit : false
, doc : Documentation Dashboard
, buttons : []
}
settingsBox Dashboard =
SettingsBox { show : true
, edit : false
, doc : Documentation Dashboard
, buttons : []
}
settingsBox Annuaire = SettingsBox {
show: true
, edit : false
, doc : Documentation Annuaire
, buttons : [ Upload
, Delete
]
}
settingsBox Annuaire =
SettingsBox { show : true
, edit : false
, doc : Documentation Annuaire
, buttons : [ Upload
, Delete
]
}
settingsBox _ = SettingsBox {
show: false
, edit : false
, doc : Documentation NodeUser
, buttons : []
}
settingsBox _ =
SettingsBox { show : false
, edit : false
, doc : Documentation NodeUser
, buttons : []
}
......@@ -12,7 +12,8 @@ import Prelude hiding (div)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Types as GT
import Gargantext.Routes as GR
import Gargantext.Types as GT
data Action = CreateSubmit String GT.NodeType
| DeleteNode
......@@ -61,6 +62,16 @@ type UploadFile = {
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
createNodeAsync :: Session
-> ID
-> CreateValue
-> Aff GT.AsyncTaskWithType
createNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.CreateNode}
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.CreateNode)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
......
......@@ -34,7 +34,7 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' "Default Name"
nodeName <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
[ panelBody readNodeType nodeName nodeType'
......
......@@ -69,11 +69,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
[ RH.div { className: "", role: "tabpanel" }
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (badges props.graph props.selectedNodeIds)))
]
, RH.div { className: "gexf" } [
RH.a { className: "btn btn-default"
, href: gexfHref props.session props.graphId
, target: "_blank" } [ RH.text "Download GEXF" ]
]
, RH.div { className: "tab-content" }
[
removeButton "Remove candidate" CandidateTerm props nodesMap
......@@ -138,9 +133,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
gexfHref :: Session -> Int -> String
gexfHref session graphId = url session $ Routes.NodeAPI GT.Graph (Just graphId) "gexf"
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} =
......
......@@ -3,11 +3,12 @@
-- Select a backend and log into it
module Gargantext.Components.Login where
import Prelude (Unit, bind, const, discard, pure, show, ($), (<>), (*>), (<$>), (>), map)
import Prelude (Unit, bind, const, discard, pure, show, ($), (<>), (*>), (<$>), (>), map, (==), (/=), not, (&&))
import Data.Array (head)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Data.String as DST
import DOM.Simple.Console (log)
import Data.Sequence as DS
......@@ -18,7 +19,7 @@ import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Components.Forms (clearfix, card, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Forms (clearfix, cardBlock, cardGroup, center, formGroup)
import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Ends (Backend(..))
import Gargantext.Sessions (Session, Sessions(..), postAuthRequest, unSessions)
......@@ -32,7 +33,8 @@ import Gargantext.Utils.Reactix as R2
type Props =
( backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean )
, visible :: R.State Boolean
)
type ModalProps = ( visible :: R.State Boolean )
......@@ -53,7 +55,6 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.div { className: "modal-header" }
[ closing
, logo
, H.h2 { className: "center modal-title" } [H.text "Instances manager"]
]
, H.div { className: "modal-body" } children ] ] ] ]
modalClass s = "modal myModal" <> if s then "" else " fade"
......@@ -86,7 +87,7 @@ loginCpt = R.hooksComponent "G.C.Login.login" cpt
modal {visible} $
case fst backend of
Nothing -> chooser { backends, backend, sessions, visible }
Just b -> form { sessions, visible, backend: b }
Just b -> form { sessions, visible, backend: b }
type ChooserProps = ( backend :: R.State (Maybe Backend) | Props )
......@@ -97,8 +98,9 @@ chooserCpt :: R.Component ChooserProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record ChooserProps -> Array R.Element -> R.Element
cpt {backend, backends, sessions} _ =
R.fragment $ active <> new <> search
R.fragment $ title <> active <> new <> search
where
title = [H.h2 { className: "center modal-title" } [H.text "Instances manager"]]
active = if DS.length ss > 0 then [ H.h3 {} [H.text "Active connection(s)"]
, H.ul {} [ renderSessions sessions]
] else [] where
......@@ -147,7 +149,8 @@ renderBackend state backend@(Backend {name}) =
type FormProps =
( backend :: Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean )
, visible :: R.State Boolean
)
form :: Record FormProps -> R.Element
form props = R.createElement formCpt props []
......@@ -156,28 +159,42 @@ formCpt :: R.Component FormProps
formCpt = R.hooksComponent "G.C.Login.form" cpt where
cpt :: Record FormProps -> Array R.Element -> R.Hooks R.Element
cpt props@{backend, sessions, visible} _ = do
error <- R.useState' ""
error <- R.useState' ""
username <- R.useState' ""
password <- R.useState' ""
setBox@(checkBox /\ setCheckBox) <- R.useState' false
pure $ R2.row
[ cardGroup
[ card
[ cardBlock
[ center
[ H.h4 {className: "m-b-0"}
[ H.span {className: "icon-text"} [ H.text "Welcome :)" ] ]
, H.p {className: "text-muted"}
[ H.text $ "Login to your account or", requestAccessLink {} ] ]
, H.div {}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ passwordInput password, clearfix {} ]
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox {}, H.text "I accept the terms of use ", termsLink {} ] ]
, loginSubmit $
onClick props error username password ] ] ] ] ] ]
[ cardBlock
[ center
[ H.h4 {}{-className: "text-muted"-}
[ H.text $ "Login to garg://" <> show backend]
, requestAccessLink {}
]
, H.div {}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
, formGroup [ passwordInput password, clearfix {} ]
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox setBox
, H.text "I hereby accept "
, H.a { target: "_blank"
, href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
} [ H.text "the terms of use" ]
]
]
]
]
, if checkBox == true
&& fst username /= ""
&& fst password /= ""
then H.div {} [center [loginSubmit $ onClick props error username password]]
else H.div {} []
]
]
]
onClick {backend, sessions, visible} error username password e =
launchAff_ $ do
let req = AuthRequest {username: fst username, password: fst password}
......@@ -194,13 +211,18 @@ csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
termsCheckbox :: {} -> R.Element
termsCheckbox _ =
H.input { id: "terms-accept", type: "checkbox", value: "", className: "checkbox" }
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
H.input { id: "terms-accept"
, type: "checkbox"
, value: fst setCheckBox
, className: "checkbox"
, on: { click: \_ -> (snd setCheckBox) $ const $ not (fst setCheckBox)}
}
termsLink :: {} -> R.Element
termsLink _ =
H.a { target: "_blank", href: termsUrl } [ H.text " [ Read the terms of use ] " ]
H.a { target: "_blank", href: termsUrl } [ H.text "the terms of use" ]
where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
requestAccessLink :: {} -> R.Element
......
......@@ -3,6 +3,11 @@ module Gargantext.Components.Search.SearchBar
) where
import Data.Tuple.Nested ((/\))
import Data.Nullable (Nullable)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Effect (Effect)
import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.SearchField (Search, searchField)
......
module Gargantext.Components.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex, isIsTex_Advanced) where
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Maybe (Maybe(..), maybe, fromMaybe, isJust)
import Data.Newtype (over)
import Data.String (length)
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Data.Nullable (Nullable, toMaybe)
import Effect.Console (logShow)
import DOM.Simple.Console (log, log2)
import Effect.Aff (launchAff_)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect (Effect)
import Reactix as R
......@@ -32,6 +34,7 @@ select = R.createElement "select"
type Search = { databases :: Database
, datafield :: Maybe DataField
, url :: String
, lang :: Maybe Lang
, node_id :: Maybe Int
, term :: String
......@@ -50,6 +53,7 @@ defaultSearch = { databases: Empty
, node_id : Nothing
, lang : Nothing
, term : ""
, url: ""
}
type Props =
......@@ -161,6 +165,17 @@ isIsTex ( Just
) = true
isIsTex _ = false
isIsTex_Advanced :: Maybe DataField -> Boolean
isIsTex_Advanced ( Just
( External
( Just ( IsTex_Advanced)
)
)
) = true
isIsTex_Advanced _ = false
isIMT :: Maybe DataField -> Boolean
isIMT ( Just
( External
......@@ -364,6 +379,7 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
pure $
H.div { className : "" }
[ H.input { defaultValue: search.term
, value: search.term
, className: "form-control"
, type: "text"
, on: { change : onChange setSearch }
......
......@@ -91,6 +91,7 @@ allDatabases = [ Empty
, PubMed
, HAL Nothing
, IsTex
, IsTex_Advanced
, Isidore
--, Web
--, News
......@@ -102,6 +103,7 @@ data Database = All_Databases
| PubMed
| HAL (Maybe Org)
| IsTex
| IsTex_Advanced
| Isidore
-- | News
-- | SocialNetworks
......@@ -111,6 +113,7 @@ instance showDatabase :: Show Database where
show PubMed = "PubMed"
show (HAL _)= "HAL"
show IsTex = "IsTex"
show IsTex_Advanced = "IsTex_Advanced"
show Isidore= "Isidore"
show Empty = "Empty"
-- show News = "News"
......@@ -121,6 +124,7 @@ instance docDatabase :: Doc Database where
doc PubMed = "All Medical publications"
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc IsTex_Advanced = "IsTex advanced search"
doc Isidore = "All (French) Social Sciences"
doc Empty = "Empty"
-- doc News = "Web filtered by News"
......@@ -130,8 +134,9 @@ readDatabase :: String -> Maybe Database
readDatabase "All Databases" = Just All_Databases
readDatabase "PubMed" = Just PubMed
readDatabase "HAL" = Just $ HAL Nothing
readDatabase "IsTex" = Just IsTex
readDatabase "Isidore"= Just Isidore
readDatabase "IsTex" = Just IsTex
readDatabase "IsTex_Advanced" = Just IsTex_Advanced
-- readDatabase "Web" = Just Web
-- readDatabase "News" = Just News
-- readDatabase "Social Networks" = Just SocialNetworks
......
......@@ -48,21 +48,21 @@ data SessionRoute
instance showAppRoute :: Show AppRoute where
show Home = "Home"
show Login = "Login"
show (Folder s i) = "Folder" <> show i <> " (" <> show s <> ")"
show (FolderPrivate s i) = "FolderPrivate" <> show i <> " (" <> show s <> ")"
show (FolderPublic s i) = "FolderPublic" <> show i <> " (" <> show s <> ")"
show (FolderShared s i) = "FolderShared" <> show i <> " (" <> show s <> ")"
show (Team s i) = "Team" <> show i <> " (" <> show s <> ")"
show (Corpus s i) = "Corpus" <> show i <> " (" <> show s <> ")"
show (Document _ s i) = "Document" <> show i <> " (" <> show s <> ")"
show (Folder s i) = "Folder" <> show i <> " (" <> show s <> ")"
show (FolderPrivate s i) = "FolderPrivate" <> show i <> " (" <> show s <> ")"
show (FolderPublic s i) = "FolderPublic" <> show i <> " (" <> show s <> ")"
show (FolderShared s i) = "FolderShared" <> show i <> " (" <> show s <> ")"
show (Team s i) = "Team" <> show i <> " (" <> show s <> ")"
show (Corpus s i) = "Corpus" <> show i <> " (" <> show s <> ")"
show (Document _ s i) = "Document" <> show i <> " (" <> show s <> ")"
show (CorpusDocument s _ _ i) = "CorpusDocument" <> show i <> " (" <> show s <> ")"
show (PGraphExplorer s i) = "graphExplorer" <> show i <> " (" <> show s <> ")"
show (Dashboard s i) = "Dashboard" <> show i <> " (" <> show s <> ")"
show (Texts s i) = "texts" <> show i <> " (" <> show s <> ")"
show (Lists s i) = "lists" <> show i <> " (" <> show s <> ")"
show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")"
show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")"
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (Texts s i) = "texts" <> show i <> " (" <> show s <> ")"
show (Lists s i) = "lists" <> show i <> " (" <> show s <> ")"
show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")"
show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")"
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
appPath Home = ""
......
......@@ -466,13 +466,14 @@ modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form | GraphT | Query
data AsyncTaskType = Form | GraphT | Query | CreateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath CreateNode = "async/nobody/"
type AsyncTaskID = String
......
module Gargantext.BootstrapNative where
module Gargantext.Utils.BootstrapNative where
import Effect (Effect)
......
......@@ -15,6 +15,10 @@ function stringify(j, indent) {
return JSON.stringify(j, null, indent);
}
function postMessage(obj, msg, src) {
obj.contentWindow.postMessage(msg, src);
}
function setCookie(c) {
document.cookie = c;
}
......@@ -22,4 +26,5 @@ function setCookie(c) {
exports._addRootElement = addRootElement;
exports._getSelection = getSelection;
exports._stringify = stringify;
exports._postMessage = postMessage;
exports._setCookie = setCookie;
......@@ -13,15 +13,16 @@ import Data.Argonaut as Json
import Data.Argonaut.Core (Json)
import Data.Either (hush)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2)
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2, runEffectFn3)
import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (...), (.=), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial)
......@@ -296,6 +297,25 @@ useLocalStorageState key s = do
pure (Tuple state setState)
getMessageDataStr :: DE.MessageEvent -> String
getMessageDataStr = getMessageData
getMessageOrigin :: DE.MessageEvent -> String
getMessageOrigin me = me .. "origin"
getMessageData :: forall o. DE.MessageEvent -> o
getMessageData me = me .. "data"
foreign import _postMessage
:: forall r. EffectFn3 r String String Unit
postMessage :: forall r. R.Ref (Nullable r) -> String -> Effect Unit
postMessage ref msg = do
case (R.readNullableRef ref) of
(Just ifr) -> do
runEffectFn3 _postMessage ifr msg (ifr .. "src")
(Nothing) -> pure unit
foreign import _setCookie :: EffectFn1 String Unit
setCookie :: String -> Effect Unit
......
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