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