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'
......
...@@ -2,64 +2,72 @@ module Gargantext.Components.Forest.Tree.Node.Box where ...@@ -2,64 +2,72 @@ module Gargantext.Components.Forest.Tree.Node.Box where
import Gargantext.Prelude import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Tuple (fst, Tuple(..)) import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Nullable (Nullable, null)
import DOM.Simple as DOM import DOM.Simple as DOM
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_) import Effect.Aff (Aff, launchAff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox) import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..)) import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.GraphExplorer.API as GEAPI import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.NgramsTable.API as NTAPI import Gargantext.Components.NgramsTable.API as NTAPI
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Lang (allLangs, Lang(EN))
import Gargantext.Components.Search.SearchBar (searchBar) import Gargantext.Components.Search.SearchBar (searchBar)
import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex) import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex_Advanced)
import Gargantext.Components.Search.Types (DataField(..))
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, post)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Routes as GR
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Popover as Popover import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import DOM.Simple.Types
import DOM.Simple.Window
import DOM.Simple.EventListener
import DOM.Simple.Event
import Effect.Console
type Dispatch = Action -> Aff Unit type Dispatch = Action -> Aff Unit
type CommonProps = type CommonProps =
( ( dispatch :: Dispatch
dispatch :: Dispatch , session :: Session
, session :: Session
) )
-- Main Node -- Main Node
type NodeMainSpanProps = type NodeMainSpanProps =
( id :: ID ( id :: ID
, asyncTasks :: Array GT.AsyncTaskWithType , asyncTasks :: Array GT.AsyncTaskWithType
, folderOpen :: R.State Boolean , folderOpen :: R.State Boolean
, frontends :: Frontends , frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit , onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
| CommonProps | CommonProps
) )
...@@ -89,8 +97,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el ...@@ -89,8 +97,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
else H.div {} [] else H.div {} []
, H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id))) , H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id)))
} }
[ nodeText { isSelected: (mCorpusId mCurrentRoute) == (Just id) [ nodeText { isSelected: mAppRouteId mCurrentRoute == Just id
, name: name' props } ] , name: name' props
} ]
, nodeActions { id , nodeActions { id
, nodeType , nodeType
, refreshTree: const $ dispatch RefreshTree , refreshTree: const $ dispatch RefreshTree
...@@ -195,8 +204,7 @@ nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt ...@@ -195,8 +204,7 @@ nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
-- START nodeActions -- START nodeActions
type NodeActionsProps = type NodeActionsProps =
( ( id :: ID
id :: ID
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, refreshTree :: Unit -> Aff Unit , refreshTree :: Unit -> Aff Unit
, session :: Session , session :: Session
...@@ -222,14 +230,13 @@ nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt ...@@ -222,14 +230,13 @@ nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
cpt _ _ = do cpt _ _ = do
pure $ H.div {} [] pure $ H.div {} []
graphVersions session graphId = GEAPI.graphVersions { graphId, session } graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
triggerRefresh refreshTree = refreshTree triggerRefresh refreshTree = refreshTree
type NodeActionsGraphProps = type NodeActionsGraphProps =
( ( id :: ID
id :: ID , graphVersions :: Record GraphAPI.GraphVersions
, graphVersions :: Record GEAPI.GraphVersions , session :: Session
, session :: Session
, triggerRefresh :: Unit -> Aff Unit , triggerRefresh :: Unit -> Aff Unit
) )
...@@ -248,8 +255,7 @@ nodeActionsGraphCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsGraph" cpt ...@@ -248,8 +255,7 @@ nodeActionsGraphCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsGraph" cpt
] ]
type GraphUpdateButtonProps = type GraphUpdateButtonProps =
( ( id :: ID
id :: ID
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Aff Unit , triggerRefresh :: Unit -> Aff Unit
) )
...@@ -272,7 +278,7 @@ graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt ...@@ -272,7 +278,7 @@ graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt
onClick (true /\ setEnabled) _ = do onClick (true /\ setEnabled) _ = do
launchAff_ $ do launchAff_ $ do
liftEffect $ setEnabled $ const false liftEffect $ setEnabled $ const false
g <- GEAPI.updateGraphVersions { graphId: id, session } g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true liftEffect $ setEnabled $ const true
triggerRefresh unit triggerRefresh unit
pure unit pure unit
...@@ -331,17 +337,30 @@ nodeListUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.nodeListUpdateButton" cp ...@@ -331,17 +337,30 @@ nodeListUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.nodeListUpdateButton" cp
-- END nodeActions -- END nodeActions
mCorpusId :: Maybe AppRoute -> Maybe Int mAppRouteId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id mAppRouteId (Just (Routes.Folder _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id mAppRouteId (Just (Routes.FolderPrivate _ id)) = Just id
mCorpusId _ = Nothing mAppRouteId (Just (Routes.FolderPublic _ id)) = Just id
mAppRouteId (Just (Routes.FolderShared _ id)) = Just id
mAppRouteId (Just (Routes.Team _ id)) = Just id
mAppRouteId (Just (Routes.Corpus _ id)) = Just id
mAppRouteId (Just (Routes.PGraphExplorer _ id)) = Just id
mAppRouteId (Just (Routes.Dashboard _ id)) = Just id
mAppRouteId (Just (Routes.Texts _ id)) = Just id
mAppRouteId (Just (Routes.Lists _ id)) = Just id
mAppRouteId (Just (Routes.Annuaire _ id)) = Just id
mAppRouteId (Just (Routes.UserPage _ id)) = Just id
mAppRouteId (Just (Routes.Document _ id _ )) = Just id
mAppRouteId (Just (Routes.ContactPage _ id _ )) = Just id
mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mAppRouteId _ = Nothing
-- | START Popup View -- | START Popup View
type NodePopupProps = type NodePopupProps =
( id :: ID ( id :: ID
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit , onPopoverClose :: DOM.Element -> Effect Unit
| CommonProps | CommonProps
) )
...@@ -354,7 +373,10 @@ type NodePopupS = ...@@ -354,7 +373,10 @@ type NodePopupS =
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
iconAStyle :: { color :: String, paddingTop :: String, paddingBottom :: String} iconAStyle :: { color :: String
, paddingTop :: String
, paddingBottom :: String
}
iconAStyle = { color : "black" iconAStyle = { color : "black"
, paddingTop : "6px" , paddingTop : "6px"
, paddingBottom : "6px" , paddingBottom : "6px"
...@@ -368,14 +390,16 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -368,14 +390,16 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
where where
cpt p _ = do cpt p _ = do
renameBoxOpen <- R.useState' false renameBoxOpen <- R.useState' false
iframeRef <- R.useRef null
nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {action: Nothing, id: p.id, name: p.name, nodeType: p.nodeType} nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {action: Nothing, id: p.id, name: p.name, nodeType: p.nodeType}
search <- R.useState' $ defaultSearch { node_id = Just p.id } search <- R.useState' $ defaultSearch { node_id = Just p.id }
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
[ H.div { className: "popup-container" } [ H.div { className: "popup-container" }
[ H.div { className: "panel panel-default" } [ H.div { className: "panel panel-default" }
[ H.div {className: ""} [ H.div {className: ""}
[ H.div { className : "col-md-11"} [ H.div { className : "col-md-10 flex-between"}
[ H.h3 { className: GT.fldr p.nodeType true} [H.text $ show p.nodeType] [ H.h3 { className: GT.fldr p.nodeType true} [H.text $ show p.nodeType]
-- , H.div { className : "col-md-1" } []
, H.p {className: "text-primary center"} [H.text p.name] , H.p {className: "text-primary center"} [H.text p.name]
] ]
] ]
...@@ -384,23 +408,19 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -384,23 +408,19 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
, mPanelAction nodePopupState p search , mPanelAction nodePopupState p search
] ]
, if nodePopup.action == Just SearchBox then , if nodePopup.action == Just SearchBox then
H.div {} H.div {} [ searchIframes p search iframeRef ]
[
searchIsTexIframe p search
]
else else
H.div {} [] H.div {} []
] ]
] ]
where where
tooltipProps = { tooltipProps = { className : ""
className: "" , id : "node-popup-tooltip"
, id: "node-popup-tooltip" , title : "Node settings"
, title: "Node settings" , data: { toggle: "tooltip"
, data: { toggle: "tooltip" , placement: "right"}
, placement: "right"} --, style: { top: y - 65.0, left: x + 10.0 }
--, style: { top: y - 65.0, left: x + 10.0 } }
}
panelHeading renameBoxOpen@(open /\ _) {dispatch, id, name, nodeType} = panelHeading renameBoxOpen@(open /\ _) {dispatch, id, name, nodeType} =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
...@@ -434,7 +454,9 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -434,7 +454,9 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
] ]
editIcon (true /\ _) = H.div {} [] editIcon (true /\ _) = H.div {} []
panelBody :: R.State (Record ActionState) -> Record NodePopupProps -> R.Element panelBody :: R.State (Record ActionState)
-> Record NodePopupProps
-> R.Element
panelBody nodePopupState {dispatch: d, nodeType} = panelBody nodePopupState {dispatch: d, nodeType} =
H.div {className: "panel-body flex-space-between"} H.div {className: "panel-body flex-space-between"}
[ H.div {className: "flex-center"} [buttonClick {action: doc, state: nodePopupState}] [ H.div {className: "flex-center"} [buttonClick {action: doc, state: nodePopupState}]
...@@ -444,59 +466,36 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -444,59 +466,36 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
where where
SettingsBox {edit, doc, buttons} = settingsBox nodeType SettingsBox {edit, doc, buttons} = settingsBox nodeType
mPanelAction :: R.State (Record NodePopupS) -> Record NodePopupProps -> R.State Search -> R.Element mPanelAction :: R.State (Record NodePopupS)
-> Record NodePopupProps
-> R.State Search
-> R.Element
mPanelAction ({action: Nothing} /\ _) _ _ = H.div {} [] mPanelAction ({action: Nothing} /\ _) _ _ = H.div {} []
mPanelAction ({action: Just action} /\ _) p search = mPanelAction ({action: Just action} /\ _) p search =
panelAction { panelAction { action
action , dispatch : p.dispatch
, dispatch: p.dispatch , id : p.id
, id: p.id , name : p.name
, name: p.name , nodePopup: Just NodePopup
, nodePopup: Just NodePopup , nodeType : p.nodeType
, nodeType: p.nodeType , search
, search , session : p.session
, session: p.session }
}
searchIsTexIframe {nodeType} search@(search' /\ _) =
if isIsTex search'.datafield then
H.div { className: "istex-search panel panel-default" }
[
H.h3 { className: GT.fldr nodeType true} []
, componentIsTex search
]
else
H.div {} []
componentIsTex (search /\ setSearch) =
H.iframe { src: isTexTermUrl search.term , width: "100%", height: "100%"} []
isTexUrl = "https://istex.gargantext.org"
isTexLocalUrl = "http://localhost:8083"
isTexTermUrl term = isTexUrl <> query
where
query = Query.print $ NQP.print identity identity qp
qp = NQP.QueryPairs [
Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term))
]
type ActionState = type ActionState =
( ( action :: Maybe NodeAction
action :: Maybe NodeAction , id :: ID
, id :: ID , name :: Name
, name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
type ButtonClickProps = type ButtonClickProps =
( ( action :: NodeAction
action :: NodeAction , state :: R.State (Record ActionState)
, state :: R.State (Record ActionState)
) )
buttonClick :: Record ButtonClickProps -> R.Element buttonClick :: Record ButtonClickProps -> R.Element
buttonClick p = R.createElement buttonClickCpt p [] buttonClick p = R.createElement buttonClickCpt p []
...@@ -521,9 +520,7 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt ...@@ -521,9 +520,7 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
then Nothing then Nothing
else (Just todo) else (Just todo)
-- END Popup View -- END Popup View
type NodeProps = type NodeProps =
( id :: ID ( id :: ID
, name :: Name , name :: Name
...@@ -549,84 +546,221 @@ panelAction p = R.createElement panelActionCpt p [] ...@@ -549,84 +546,221 @@ panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps panelActionCpt :: R.Component PanelActionProps
panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
where where
cpt {action: Documentation GT.NodeUser} _ = do cpt {action: Documentation nodeType} _ = actionDoc nodeType
pure $ R.fragment [ cpt {action: Download, id, nodeType, session} _ = actionDownload nodeType id session
H.div {style: {margin: "10px"}} [ infoTitle GT.NodeUser cpt {action: Upload, dispatch, id, nodeType, session} _ = actionUpload nodeType id session dispatch
, H.p {} [ H.text "This account is personal"] cpt {action: Delete, nodeType, dispatch} _ = actionDelete nodeType dispatch
, H.p {} [ H.text "See the instances terms of uses."]
]
]
cpt {action: Documentation GT.FolderPrivate} _ = do
pure $ fragmentPT "This folder and its children are private only!"
cpt {action: Documentation GT.FolderPublic} _ = do
pure $ fragmentPT "Soon, you will be able to build public folders to share your work with the world!"
cpt {action: Documentation GT.FolderShared} _ = do
pure $ fragmentPT "Soon, you will be able to build teams folders to share your work"
cpt {action: Documentation x, nodeType} _ = do
pure $ fragmentPT $ "More information on" <> show nodeType
cpt {action: Link _} _ = do
pure $ fragmentPT "Soon, you will be able to link the corpus with your Annuaire (and reciprocally)."
cpt {action: Upload, dispatch, id, nodeType: GT.NodeList, session} _ = do
pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt {action: Upload, dispatch, id, nodeType, session} _ = do
pure $ uploadFileView {dispatch, id, nodeType, session}
cpt {action: Download, id, nodeType: NodeList, session} _ = do
let href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
pure $ R.fragment [
H.span { className: "row" }
[ H.a { className: "col-md-12"
, href
, target: "_blank" } [ H.text "Download file" ]
]
]
cpt {action: Download} _ = do
pure $ fragmentPT "Soon, you will be able to dowload your file here"
cpt props@{action: SearchBox, search, session} _ = do
pure $ R.fragment [
H.p {"style": {"margin" :"10px"}} [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch: onSearch props, search, session}
]
cpt {action: Delete, nodeType: GT.NodeUser} _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]
]
cpt {action: Delete, dispatch} _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} (map (\t -> H.p {} [H.text t]) ["Are your sure you want to delete it ?", "If yes, click again below."])
, reallyDelete dispatch
]
cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do
pure $ createNodeView {dispatch, id, name, nodeType, nodeTypes: xs} pure $ createNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
cpt {action: CopyFromCorpus, dispatch, id, nodeType, session} _ = do cpt {action: CopyFromCorpus, dispatch, id, nodeType, session} _ = do
pure $ copyFromCorpusView {dispatch, id, nodeType, session} pure $ copyFromCorpusView {dispatch, id, nodeType, session}
cpt _ _ = do
pure $ H.div {} []
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
onSearch :: Record PanelActionProps -> GT.AsyncTaskWithType -> Effect Unit cpt {action: Link _} _ = pure $ fragmentPT "Soon, you will be able to link the corpus with your Annuaire (and reciprocally)."
onSearch {dispatch, nodePopup: p} task = do
_ <- launchAff $ dispatch (SearchQuery task)
-- close popup
-- TODO
--snd p $ const Nothing
pure unit
infoTitle :: GT.NodeType -> R.Element cpt props@{action: SearchBox, search, session} _ = do
infoTitle nt = H.div {style: {margin: "10px"}} [ H.h3 {} [H.text "Documentation about " ] pure $ R.fragment [ H.p {"style": {"margin" :"10px"}}
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ] [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch: searchOn props, search, session}
] ]
where
searchOn :: Record PanelActionProps -> GT.AsyncTaskWithType -> Effect Unit
searchOn {dispatch, nodePopup: p} task = do
_ <- launchAff $ dispatch (SearchQuery task)
-- close popup
-- TODO
--snd p $ const Nothing
pure unit
reallyDelete :: Dispatch -> R.Element {-
reallyDelete d = H.div {className: "panel-footer"} cpt {action: Refresh, nodeType: GT.Graph, id, session} _ = do
pure $ H.div {className: "panel-footer"}
[ H.a { type: "button" [ H.a { type: "button"
, className: "btn glyphicon glyphicon-trash" , className: "btn glyphicon glyphicon-trash"
, id: "delete" , id: "delete"
, title: "Delete" , title: "Delete"
, on: {click: \_ -> launchAff $ d $ DeleteNode} , on: {click: \_ -> post session (GR.GraphAPI id $ GT.asyncTaskTypePath GT.GraphT) {}
-- TODO pure $ GT.AsyncTaskWithType { task, typ: GT.GraphT }
}
} }
[H.text " Yes, delete!"] [H.text " Yes, delete!"]
] ]
--}
cpt _ _ = do
pure $ H.div {} []
-- | Action : Delete
actionDelete :: NodeType -> Dispatch -> R.Hooks R.Element
actionDelete NodeUser _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}}
[H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
]
]
actionDelete _ dispatch = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} (map (\t -> H.p {} [H.text t]) ["Are your sure you want to delete it ?", "If yes, click again below."])
, reallyDelete dispatch
]
where
reallyDelete :: Dispatch -> R.Element
reallyDelete d = H.div {className: "panel-footer"}
[ H.a { type: "button"
, className: "btn glyphicon glyphicon-trash"
, id: "delete"
, title: "Delete"
, on: {click: \_ -> launchAff $ d $ DeleteNode}
}
[H.text " Yes, delete!"]
]
-- | Action : Upload
actionUpload :: NodeType -> ID -> Session -> Dispatch -> R.Hooks R.Element
actionUpload NodeList id session dispatch =
pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
actionUpload Corpus id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Corpus, session}
actionUpload _ _ _ _ =
pure $ fragmentPT $ "Soon, upload for this NodeType."
-- | Action : Download
actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element
actionDownload NodeList id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
label = "Download List"
info = "Info about the List as JSON format"
actionDownload GT.Graph id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
label = "Download Graph"
info = "Info about the Graph as GEXF format"
actionDownload GT.Corpus id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
label = "Download Corpus"
info = "TODO: fix the backend route"
actionDownload GT.Texts id session = downloadButton href label info
where
href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
label = "Download texts"
info = "TODO: fix the backend route. What is the expected result ?"
actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to dowload your file here "
type Href = String
type Label = String
type Info = String
downloadButton :: Href -> Label -> Info -> R.Hooks R.Element
downloadButton href label info = do
pure $ R.fragment [ H.div { className: "row"}
[ H.div { className: "col-md-2"} []
, H.div { className: "col-md-7 flex-center"}
[ H.p {} [H.text info] ]
]
, H.span { className: "row" }
[ H.div { className: "panel-footer"}
[ H.div { className: "col-md-3"} []
, H.div { className: "col-md-3 flex-center"}
[ H.a { className: "btn btn-default"
, href
, target: "_blank" }
[ H.text label ]
]
]
]
]
-- | Action: Show Documentation
actionDoc :: NodeType -> R.Hooks R.Element
actionDoc nodeType =
pure $ R.fragment [ H.div { style: {margin: "10px"} }
$ [ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
]
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
-- | TODO add documentation of all NodeType
docOf :: NodeType -> Array String
docOf GT.NodeUser = [ "This account is personal"
, "See the instances terms of uses."
]
docOf GT.FolderPrivate = ["This folder and its children are private only."]
docOf GT.FolderPublic = ["Soon, you will be able to build public folders to share your work with the world!"]
docOf GT.FolderShared = ["Soon, you will be able to build teams folders to share your work"]
docOf nodeType = ["More information on " <> show nodeType]
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
--------------------
-- | Iframes
searchIframes {nodeType} search@(search' /\ _) iframeRef =
if isIsTex_Advanced search'.datafield then
H.div { className: "istex-search panel panel-default" }
[ H.h3 { className: GT.fldr nodeType true} []
, iframeWith "https://istex.gargantext.org" search iframeRef
]
else
if Just Web == search'.datafield then
H.div { className: "istex-search panel panel-default" }
[ H.h3 { className: GT.fldr nodeType true} []
, iframeWith "https://searx.gargantext.org" search iframeRef
]
else
H.div {} []
iframeWith url (search /\ setSearch) iframeRef =
H.iframe { src: isTexTermUrl search.term
,width: "100%"
,height: "100%"
,ref: iframeRef
,on: {
load: \_ -> do
addEventListener window "message" (changeSearchOnMessage url)
R2.postMessage iframeRef search.term
}
} []
where
changeSearchOnMessage :: String -> Callback MessageEvent
changeSearchOnMessage url = callback $ \m -> if R2.getMessageOrigin m == url
then do
let {url, term} = R2.getMessageData m
setSearch $ _ {url = url, term = term}
else
pure unit
isTexTermUrl term = url <> query
where
query = Query.print $ NQP.print identity identity qp
qp = NQP.QueryPairs [
Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term))
]
...@@ -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