Commit adb0e070 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-ngrams-refactoring

parents 9216903e 9b79da8f
......@@ -24,8 +24,7 @@ import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
type CommonProps =
(
frontends :: Frontends
( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
......@@ -154,8 +153,7 @@ 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
......@@ -192,9 +190,12 @@ performAction p@{ reload: (_ /\ setReload)
performAction p@{ openNodes: (_ /\ setOpenNodes)
, 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)
......@@ -38,6 +41,7 @@ instance eqNodeAction :: Eq NodeAction where
eq (Link x) (Link 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,8 +132,8 @@ settingsBox FolderPublic = SettingsBox {
]
}
settingsBox Folder = SettingsBox {
show: true
settingsBox Folder =
SettingsBox { show : true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
......@@ -138,8 +144,8 @@ settingsBox Folder = SettingsBox {
]
}
settingsBox Corpus = SettingsBox {
show: true
settingsBox Corpus =
SettingsBox { show : true
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
......@@ -157,45 +163,50 @@ settingsBox Corpus = SettingsBox {
]
}
settingsBox Texts = SettingsBox {
show: true
settingsBox Texts =
SettingsBox { show : true
, edit : false
, doc : Documentation Texts
, buttons : [ Upload
, buttons : [ Refresh
, Upload
, Download
-- , Delete
]
}
settingsBox Graph = SettingsBox {
show: true
settingsBox Graph =
SettingsBox { show : true
, edit : false
, doc : Documentation Graph
, buttons : [ Download -- TODO as GEXF or JSON
, buttons : [ Refresh
, Config
, Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox NodeList = SettingsBox {
show: true
settingsBox NodeList =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeList
, buttons : [ Upload
, CopyFromCorpus
, buttons : [ Refresh
, Config
, Download
-- , Delete
, Upload
, CopyFromCorpus
, Delete
]
}
settingsBox Dashboard = SettingsBox {
show: true
settingsBox Dashboard =
SettingsBox { show : true
, edit : false
, doc : Documentation Dashboard
, buttons : []
}
settingsBox Annuaire = SettingsBox {
show: true
settingsBox Annuaire =
SettingsBox { show : true
, edit : false
, doc : Documentation Annuaire
, buttons : [ Upload
......@@ -203,8 +214,8 @@ settingsBox Annuaire = SettingsBox {
]
}
settingsBox _ = SettingsBox {
show: false
settingsBox _ =
SettingsBox { show : false
, edit : false
, doc : Documentation NodeUser
, buttons : []
......
......@@ -12,6 +12,7 @@ import Prelude hiding (div)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Routes as GR
import Gargantext.Types as GT
data Action = CreateSubmit String GT.NodeType
......@@ -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"
......@@ -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 []
......@@ -159,15 +162,15 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
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.h4 {}{-className: "text-muted"-}
[ H.text $ "Login to garg://" <> show backend]
, requestAccessLink {}
]
, H.div {}
[ csrfTokenInput {}
, formGroup [ H.p {} [ H.text (fst error) ], usernameInput username ]
......@@ -175,9 +178,23 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
, center
[ H.label {}
[ H.div {className: "checkbox"}
[ termsCheckbox {}, H.text "I accept the terms of use ", termsLink {} ] ]
, loginSubmit $
onClick props error username password ] ] ] ] ] ]
[ 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
......
......@@ -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