Skip to content

P
purescript-gargantext
Commit 0b03d8c1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-list-charts

parents 16364b1e 8c872d4b
Hide whitespace changes
Inline Side-by-side
Showing with 2540 additions and 1857 deletions
README.md
View file @ 0b03d8c1
...@@ -14,15 +14,14 @@ granted access to a [backend](https://gitlab.iscpif.fr/gargantext/haskell-gargan ...@@ -14,15 +14,14 @@ granted access to a [backend](https://gitlab.iscpif.fr/gargantext/haskell-gargan
This software is free software, developed by the CNRS Complex Systems This software is free software, developed by the CNRS Complex Systems
Institute of Paris Île-de-France (ISC-PIF) and its partners. Institute of Paris Île-de-France (ISC-PIF) and its partners.
## Development ## Dependencies
### System Dependencies The build requires the following system dependencies preinstalled:
* NodeJS (11+) * NodeJS (11+)
* Yarn (Recent) * Yarn (Recent)
* A webserver (anything that can serve a static directory will do)
#### NodeJS Installation ### NodeJS
On debian testing, debian unstable or ubuntu: On debian testing, debian unstable or ubuntu:
...@@ -37,32 +36,28 @@ curl -sL https://deb.nodesource.com/setup_11.x | sudo bash - ...@@ -37,32 +36,28 @@ curl -sL https://deb.nodesource.com/setup_11.x | sudo bash -
sudo apt update && sudo apt install nodejs sudo apt update && sudo apt install nodejs
``` ```
(For Ubuntu) <!-- TODO: wtf is all this sudo? -->
```shell <!-- To upgrade to latest version (and not current stable) version, you can -->
curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add - <!-- use the `n` module from npm to upgrade node: -->
echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/sources.list.d/yarn.list
sudo apt update && sudo apt install yarn
```
To upgrade to latest version (and not current stable) version, you can use
(Use n module from npm in order to upgrade node)
```shell <!-- ```shell -->
sudo npm cache clean -f <!-- sudo npm cache clean -f -->
sudo npm install -g n <!-- sudo npm install -g n -->
sudo n stable <!-- sudo n stable -->
sudo n latest <!-- sudo n latest -->
``` <!-- ``` -->
On Mac OS X with homebrew:
### OSX
```shell ```shell
brew install node brew install node
``` ```
#### Yarn installation For other platforms, please refer to [the nodejs website](https://nodejs.org/en/download/).
### Yarn (javascript package manager)
On ubuntu: On debian or ubuntu:
```shell ```shell
curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add - curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add -
...@@ -70,113 +65,77 @@ echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/source ...@@ -70,113 +65,77 @@ echo "deb https://dl.yarnpkg.com/debian/ stable main" | sudo tee /etc/apt/source
sudo apt update && sudo apt install yarn sudo apt update && sudo apt install yarn
``` ```
On Mac OS (with Homebrew): On Mac OS X with homebrew:
```shell ```shell
brew install yarn brew install yarn
``` ```
#### Webservers For other platforms, please refer to [the yarn website](https://www.yarnpkg.com/).
Some options:
* The `python3` builtin webserver ## Development
* Caddy
### Purescript and Javascript dependencies
Once you have node and yarn installed, you may install deps with: Once you have node and yarn installed, you may install deps with:
```shell ```shell
yarn install && yarn add psc-package && yarn install-ps && yarn build yarn install -D && yarn install-ps
```
You need to copy index.html:
```shell
cp src/index.html dist/
``` ```
(Be careful, to update or upgrade your install, maybe you need to remove You will likely want to check your work in a browser. We provide a
old files in node_modules). local development webserver that serves on port 5000 for this purpose:
### Development
You can compile the purescript code with:
```shell ```shell
yarn compile yarn server
``` ```
Or run a repl: To generate a new browser bundle to test:
```shell ```shell
yarn repl yarn build
```
```shell
yarn install && yarn ps-deps
``` ```
### Running a dev server If you are rapidly iterating and just want to type check your code:
```shell ```shell
yarn dev yarn compile
```
This will launch a hot-reloading development server with
webpack-dev-server. Visit [localhost:9000](http://localhost:9000/) to
see the result when the output shows a line like this:
```
ℹ ｢wdm｣: Compiled successfully.
``` ```
#### Purescript IDE integration You may access a purescript repl if you want to explore:
A `purs ide` connection will be available on port 9002 while the
development server is running.
A guide to getting set up with the IDE integration is beyond the scope
of this document.
#### Source maps
Currently broken. Someone please fix them.
### Getting a purescript repl
```shell ```shell
yarn repl yarn repl
``` ```
### Compiling styles If you need to reinstall dependencies such as after a git pull or branch switch:
We use the `sass` compiler for some of the style files. To convert them to CSS do:
```shell ```shell
yarn sass yarn install -D && yarn install-ps # both javascript and purescript
``` ```
### Building for production If something goes wrong building after a deps update, you may clean
build artifacts and try again:
```shell ```shell
yarn build yarn clean-js # clean javascript, very useful
yarn clean-ps # clean purescript, should never be required, possible purescript bug
yarn clean # clean both purescript and javascript
``` ```
It is *not* necessary to `yarn compile` before running `yarn build`. If you edit the SASS, you'll need to rebuild the CSS:
You can then serve the `dist` directory with your favourite webserver. ```shell
yarn sass
Examples: ```
* `python3 -m http.server --directory dist` (requires Python 3.7+) <!-- A `purs ide` connection will be available on port 9002 while the -->
<!-- development server is running. -->
<!-- To get a live-reloading development server --> A guide to getting set up with the IDE integration is coming soon, I hope.
of this document.
<!-- ```shell --> ### Note to contributors
<!-- yarn live -->
<!-- ``` -->
Note that a production build takes a little while. Please follow CONTRIBUTING.md
### How do I? ### How do I?
...@@ -194,12 +153,6 @@ endConfig' v = { front : frontRelative ...@@ -194,12 +153,6 @@ endConfig' v = { front : frontRelative
, back : backDemo v } , back : backDemo v }
``` ```
## Note to the contributors
Please follow CONTRIBUTING.md
### How do I?
#### Add a javascript dependency? #### Add a javascript dependency?
Add it to `package.json`, under `dependencies` if it is needed at Add it to `package.json`, under `dependencies` if it is needed at
...@@ -288,10 +241,9 @@ bigram/2-gram ...@@ -288,10 +241,9 @@ bigram/2-gram
: A two-word n-gram, e.g. `coffee cup` : A two-word n-gram, e.g. `coffee cup`
trigram/3-gram trigram/3-gram
: A three-word n-gram, e.g. `coffee cup holder` : A three-word n-gram, e.g. `coffee cup holder`
<!-- skip-grams are not yet supported --> skip-gram
<!-- skip-gram --> : An n-gram where the words are not all adjacent. Not yet supported.
<!-- : An n-gram where the words are not all adjacent --> k-skip-n-gram
<!-- k-skip-n-gram --> : An n-gram where the words are at most distance k from each other.
<!-- : An n-gram where the words are at most distance k from each other -->
dist/styles/Login.css
View file @ 0b03d8c1
...@@ -78,9 +78,10 @@ li#rename #rename-a { ...@@ -78,9 +78,10 @@ li#rename #rename-a {
background-color: white; background-color: white;
border: none; border: none;
} }
#node-popup-tooltip .popup-container .istex-search.panel { #node-popup-tooltip .popup-container .frame-search.panel {
border: 1px solid rgba(0, 0, 0, 0.2); border: 1px solid rgba(0, 0, 0, 0.2);
box-shadow: 0 2px 5px rgba(0, 0, 0, 0.2); box-shadow: 0 2px 5px rgba(0, 0, 0, 0.2);
height: 600px;
width: 1300px; width: 1300px;
} }
......
dist/styles/Login.sass
View file @ 0b03d8c1
...@@ -70,9 +70,10 @@ li#rename ...@@ -70,9 +70,10 @@ li#rename
justify-content: center justify-content: center
background-color: white background-color: white
border: none border: none
.istex-search.panel .frame-search.panel
border: 1px solid rgba(0,0,0,0.2) border: 1px solid rgba(0,0,0,0.2)
box-shadow: 0 2px 5px rgba(0,0,0,0.2) box-shadow: 0 2px 5px rgba(0,0,0,0.2)
height: 600px
width: 1300px width: 1300px
......
package.json
View file @ 0b03d8c1
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.5.1", "version": "0.0.1.5.2",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
"clean-js": "rm -Rf node_modules", "clean-js": "rm -Rf node_modules",
"clean-ps": "rm -Rf output", "clean-ps": "rm -Rf output",
"test": "pulp test", "test": "pulp test",
"start": "serve dist" "server": "serve dist"
}, },
"dependencies": { "dependencies": {
"create-react-class": "^15.6.3", "create-react-class": "^15.6.3",
......
src/Gargantext/AsyncTasks.purs
View file @ 0b03d8c1
module Gargantext.AsyncTasks where module Gargantext.AsyncTasks where
import Data.Argonaut (decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:)) import Data.Argonaut (decodeJson)
import Data.Argonaut.Parser (jsonParser) import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
......
src/Gargantext/Components/DocsTable.purs
View file @ 0b03d8c1
...@@ -34,7 +34,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -34,7 +34,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, post, delete, put) import Gargantext.Sessions (Session, sessionId, post, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult, NodeID) import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..), AffTableResult)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite data Category = Trash | UnRead | Checked | Topic | Favorite
......
src/Gargantext/Components/Forest.purs
View file @ 0b03d8c1
...@@ -33,27 +33,45 @@ forestCpt :: R.Component Props ...@@ -33,27 +33,45 @@ forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes) openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache R2.useCache
(frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload /\ fst asyncTasks) ( frontends
/\ route
/\ sessions
/\ fst openNodes
/\ fst extReload
/\ fst reload
/\ fst asyncTasks
)
(cpt' openNodes asyncTasks reload showLogin) (cpt' openNodes asyncTasks reload showLogin)
cpt' openNodes asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do cpt' openNodes asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do
pure $ R.fragment $ A.cons (plus showLogin) trees pure $ R.fragment $ A.cons (plus showLogin) trees
where where
trees = tree <$> unSessions sessions trees = tree <$> unSessions sessions
tree s@(Session {treeId}) = tree s@(Session {treeId}) =
treeView { root: treeId, asyncTasks, frontends, mCurrentRoute: Just route, session: s, openNodes, reload } treeView { root: treeId
, asyncTasks
, frontends
, mCurrentRoute: Just route
, session: s
, openNodes
, reload
}
plus :: R2.Setter Boolean -> R.Element plus :: R2.Setter Boolean -> R.Element
plus showLogin = plus showLogin =
H.button {on: {click}, className: "btn btn-primary"} H.button { on: {click}
[ H.div { "type": "", className: "fa fa-universal-access fa-lg"} [H.text " Log "] , className: "btn btn-primary"
, H.div {} [H.text " "] }
[ H.div { "type": ""
, className: "fa fa-universal-access fa-lg"
} [H.text " Log "]
, H.div {} [H.text " "]
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
] ]
-- TODO same as the one in the Login Modal (same CSS) -- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ] -- [ H.i { className: "material-icons md-36"} [] ]
where where
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree where module Gargantext.Components.Forest.Tree where
import DOM.Simple.Console (log, log2)
import Data.Array as A import Data.Array as A
import Data.Map as Map import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..), maybe)
import Data.Set as Set import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..),deleteNode) import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (loadNode) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode) import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (getNodeTree)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share (ShareValue(..), share)
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), renameNode) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct) import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..), Tree)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>), identity) import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
import Gargantext.Routes (AppRoute) import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId) import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
import Gargantext.Types (ID, Reload) import Gargantext.Types (ID, Reload)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
------------------------------------------------------------------------ ------------------------------------------------------------------------
type CommonProps = type CommonProps =
( frontends :: Frontends ( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
...@@ -42,8 +41,8 @@ type CommonProps = ...@@ -42,8 +41,8 @@ type CommonProps =
) )
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = ( root :: ID type Props = ( root :: ID
, asyncTasks :: R.State GAT.Storage , asyncTasks :: R.State GAT.Storage
| CommonProps | CommonProps
) )
...@@ -53,9 +52,22 @@ treeView props = R.createElement treeViewCpt props [] ...@@ -53,9 +52,22 @@ treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where where
cpt { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks} _children = do cpt { root
pure $ treeLoadView , mCurrentRoute
{ root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks} , session
, frontends
, openNodes
, reload
, asyncTasks
} _children = pure
$ treeLoadView { root
, mCurrentRoute
, session
, frontends
, openNodes
, reload
, asyncTasks
}
treeLoadView :: Record Props -> R.Element treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadViewCpt p [] treeLoadView p = R.createElement treeLoadViewCpt p []
...@@ -63,10 +75,16 @@ treeLoadView p = R.createElement treeLoadViewCpt p [] ...@@ -63,10 +75,16 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
treeLoadViewCpt :: R.Component Props treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
where where
cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do cpt { root
let fetch _ = loadNode session root , asyncTasks
let paint loaded = loadedTreeView { , mCurrentRoute
asyncTasks , session
, frontends
, openNodes
, reload
} _children = do
let fetch _ = getNodeTree session root
let paint loaded = loadedTreeView { asyncTasks
, frontends , frontends
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
...@@ -77,9 +95,9 @@ treeLoadView p = R.createElement treeLoadViewCpt p [] ...@@ -77,9 +95,9 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
} }
useLoader { root, counter: fst reload } fetch paint useLoader { root, counter: fst reload } fetch paint
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree , tree :: FTree
, tasks :: Record Tasks , tasks :: Record Tasks
| CommonProps | CommonProps
) )
...@@ -89,16 +107,31 @@ loadedTreeView p = R.createElement loadedTreeViewCpt p [] ...@@ -89,16 +107,31 @@ loadedTreeView p = R.createElement loadedTreeViewCpt p []
loadedTreeViewCpt :: R.Component TreeViewProps loadedTreeViewCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
where where
cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do cpt { asyncTasks
pure $ H.div {className: "tree"} , frontends
[ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ] , mCurrentRoute
, openNodes
, reload
, tasks
, tree
, session
} _ = pure $ H.div { className: "tree"}
[ toHtml { asyncTasks
, frontends
, mCurrentRoute
, openNodes
, reload
, session
, tasks
, tree
}
]
------------------------------------------------------------------------ ------------------------------------------------------------------------
type ToHtmlProps = type ToHtmlProps =
( ( asyncTasks :: R.State GAT.Storage
asyncTasks :: R.State GAT.Storage , tasks :: Record Tasks
, tasks :: Record Tasks , tree :: FTree
, tree :: FTree
| CommonProps | CommonProps
) )
...@@ -109,59 +142,72 @@ toHtml p@{ asyncTasks ...@@ -109,59 +142,72 @@ toHtml p@{ asyncTasks
, openNodes , openNodes
, reload: reload@(_ /\ setReload) , reload: reload@(_ /\ setReload)
, session , session
, tasks: tasks@{ onTaskAdd, onTaskFinish, tasks: tasks' } , tasks: tasks@{ onTaskAdd
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} [] , onTaskFinish
where , tasks: tasks'
el = R.hooksComponent "NodeView" cpt }
commonProps = RecordE.pick p :: Record CommonProps , tree: tree@(NTree (LNode { id
pAction = performAction (RecordE.pick p :: Record PerformActionProps) , name
, nodeType
cpt _ _ = do }
let nodeId = mkNodeId session id ) ary
let folderIsOpen = Set.member nodeId (fst openNodes) )
let setFn = if folderIsOpen then Set.delete else Set.insert } =
let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId) R.createElement el {} []
let folderOpen = Tuple folderIsOpen toggleFolderIsOpen where
el = R.hooksComponent "NodeView" cpt
let withId (NTree (LNode {id: id'}) _) = id' commonProps = RecordE.pick p :: Record CommonProps
pAction a = performAction a (RecordE.pick p :: Record PerformActionProps)
pure $ H.ul {}
[ H.li {} cpt _ _ = do
( [ nodeMainSpan { id let nodeId = mkNodeId session id
, dispatch: pAction let folderIsOpen = Set.member nodeId (fst openNodes)
, folderOpen let setFn = if folderIsOpen then Set.delete else Set.insert
, frontends let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
, mCurrentRoute let folderOpen = Tuple folderIsOpen toggleFolderIsOpen
, name
, nodeType let withId (NTree (LNode {id: id'}) _) = id'
, session
, tasks pure $ H.ul {}
} ] [ H.li {}
<> childNodes (Record.merge commonProps ( [ nodeMainSpan { id
{ asyncTasks , dispatch: pAction
, children: ary , folderOpen
, folderOpen }) , frontends
) , mCurrentRoute
] , name
, nodeType
, session
, tasks
} ]
<> childNodes (Record.merge commonProps
{ asyncTasks
, children: ary
, folderOpen
}
)
)
]
type ChildNodesProps = type ChildNodesProps =
( asyncTasks :: R.State GAT.Storage ( asyncTasks :: R.State GAT.Storage
, children :: Array FTree , children :: Array FTree
, folderOpen :: R.State Boolean , folderOpen :: R.State Boolean
| CommonProps | CommonProps
) )
childNodes :: Record ChildNodesProps -> Array R.Element childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = [] childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = [] childNodes { folderOpen: (false /\ _) } = []
childNodes props@{ asyncTasks, children, reload } = childNodes props@{ asyncTasks, children, reload } =
map (\ctree@(NTree (LNode {id}) _) -> map (\ctree@(NTree (LNode {id}) _) ->
toHtml (Record.merge commonProps { toHtml (Record.merge commonProps { asyncTasks
asyncTasks , tasks: tasksStruct id asyncTasks reload
, tasks: tasksStruct id asyncTasks reload , tree: ctree
, tree: ctree }
})) $ sorted children )
) $ sorted children
where where
commonProps = RecordE.pick props :: Record CommonProps commonProps = RecordE.pick props :: Record CommonProps
sorted :: Array FTree -> Array FTree sorted :: Array FTree -> Array FTree
...@@ -175,54 +221,85 @@ type PerformActionProps = ...@@ -175,54 +221,85 @@ type PerformActionProps =
, tree :: FTree , tree :: FTree
) )
performAction :: Record PerformActionProps -------
-> Action performAction :: Action
-> Record PerformActionProps
-> Aff Unit -> Aff Unit
performAction p@{ openNodes: (_ /\ setOpenNodes) performAction DeleteNode p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } DeleteNode = do , tree: (NTree (LNode {id}) _)
void $ deleteNode session id } =
liftEffect do do
setOpenNodes (Set.delete (mkNodeId session id)) void $ deleteNode session id
performAction p RefreshTree liftEffect $ setOpenNodes (Set.delete (mkNodeId session id))
performAction RefreshTree p
performAction { reload: (_ /\ setReload)
, session -------
, tasks: { onTaskAdd } performAction (DoSearch task) { reload: (_ /\ setReload)
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do , session
liftEffect $ onTaskAdd task , tasks: { onTaskAdd }
liftEffect $ log2 "[performAction] SearchQuery task:" task , tree: (NTree (LNode {id}) _)
} =
performAction { reload: (_ /\ setReload) do
, session liftEffect $ onTaskAdd task
, tasks: {onTaskAdd} liftEffect $ log2 "[performAction] DoSearch task:" task
, tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
liftEffect $ onTaskAdd task -------
liftEffect $ log2 "[performAction] UpdateNode task:" task performAction (UpdateNode params) { reload: (_ /\ setReload)
, session
, tasks: {onTaskAdd}
performAction p@{ reload: (_ /\ setReload) , tree: (NTree (LNode {id}) _)
, session } =
, tree: (NTree (LNode {id}) _) } (Submit name) = do do
void $ renameNode session id $ RenameValue {name} task <- updateRequest params session id
performAction p RefreshTree liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] UpdateNode task:" task
performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session -------
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do performAction (RenameNode name) p@{ reload: (_ /\ setReload)
task <- addNode session id $ AddNodeValue {name, nodeType} , session
liftEffect do , tree: (NTree (LNode {id}) _)
setOpenNodes (Set.insert (mkNodeId session id)) } =
performAction p RefreshTree do
void $ rename session id $ RenameValue {text:name}
performAction { session performAction RefreshTree p
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do -------
task <- uploadFile session nodeType id fileType {mName, contents} performAction (ShareNode username) p@{ reload: (_ /\ setReload)
liftEffect $ onTaskAdd task , session
liftEffect $ log2 "uploaded, task:" task , tree: (NTree (LNode {id}) _)
} =
performAction { reload: (_ /\ setReload) } RefreshTree = do do
void $ share session id $ ShareValue {text:username}
-------
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _)
} =
do
task <- addNode session id $ AddNodeValue {name, nodeType}
liftEffect $ setOpenNodes (Set.insert (mkNodeId session id))
performAction RefreshTree p
-------
performAction (UploadFile nodeType fileType mName contents) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
-------
performAction DownloadNode _ = do
liftEffect $ log "[performAction] DownloadNode"
-------
performAction RefreshTree { reload: (_ /\ setReload) } = do
liftEffect $ setReload (_ + 1) liftEffect $ setReload (_ + 1)
-------
src/Gargantext/Components/Forest/Tree/Node.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node where module Gargantext.Components.Forest.Tree.Node where
import Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Data.Array (foldl)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Nullable (null)
import Data.Tuple.Nested ((/\))
import Gargantext.Types import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID)
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Web.File.FileReader.Aff (readAsText)
-- Main Node
type NodeMainSpanProps =
( id :: ID
, folderOpen :: R.State Boolean
, frontends :: Frontends
, mCurrentRoute :: Maybe Routes.AppRoute
, name :: Name
, nodeType :: GT.NodeType
, tasks :: Record Tasks
| CommonProps
)
nodeMainSpan :: Record NodeMainSpanProps
-> R.Element
nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el p []
where
el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
cpt props@{id, mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }} _ = do
-- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
popoverRef <- R.useRef null
pure $ H.span (dropProps droppedFile isDragOver) $
[ folderIcon nodeType folderOpen
, if showBox then
Popover.popover { arrow: false
, open: false
, onClose: \_ -> pure unit
, onOpen: \_ -> pure unit
, ref: popoverRef } [
popOverIcon
, mNodePopupView props (onPopoverClose popoverRef)
]
else H.div {} []
, H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id)))
}
[ nodeText { isSelected: mAppRouteId mCurrentRoute == Just id
, name: name' props
} ]
, nodeActions { id
, nodeType
, refreshTree: const $ dispatch RefreshTree
, session }
, fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType}
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id
, onFinish: const $ onTaskFinish t
, session
}
) tasks
)
]
where
SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
name' {name, nodeType} = if nodeType == GT.NodeUser
then show session
else name
folderIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "folder-icon"
, onClick: R2.effToggler folderOpen'
}
[ H.i {className: GT.fldr nodeType open} [] ]
popOverIcon = H.a { className: "settings fa fa-cog" } []
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { id
, dispatch
, name: name' props
, nodeType
, onPopoverClose
, session
}
dropProps droppedFile isDragOver =
{ className: "leaf " <> (dropClass droppedFile isDragOver)
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) e = do
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
contents <- readAsText blob
liftEffect $ setDroppedFile
$ const
$ Just
$ DroppedFile { contents: (UploadFileContents contents)
, fileType: Just CSV
, lang : EN
}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
------------------------------------------------------------------------
------------------------------------------------------------------------
{- {-
-- | TODO fldr nt open = if open
filterWithRights (show action if user can only) then "fa fa-globe" -- <> color nt
else "fa fa-folder-globe" -- <> color nt
--else "glyphicon glyphicon-folder-close" <> color nt
where
color GT.NodeUser = ""
color FolderPublic = ""
color FolderShared = " text-warning"
color _ = " text-danger"
-} -}
------------------------------------------------------------------------
------------------------------------------------------------------------
data Status a = IsBeta a | IsProd a
data NodeAction = Documentation NodeType
| SearchBox
| Download | Upload | Refresh | Config
| Move | Clone | Delete
| Share | Link NodeType
| Add (Array NodeType)
| CopyFromCorpus
instance eqNodeAction :: Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true
eq Download Download = true
eq Upload Upload = true
eq Refresh Refresh = true
eq Move Move = true
eq Clone Clone = true
eq Delete Delete = true
eq Share Share = true
eq (Link x) (Link y) = true && (x == y)
eq (Add x) (Add y) = true && (x == y)
eq CopyFromCorpus CopyFromCorpus = true
eq Config Config = true
eq _ _ = false
instance showNodeAction :: Show NodeAction where
show (Documentation x) = "Documentation of " <> show x
show SearchBox = "SearchBox"
show Download = "Download"
show Upload = "Upload"
show Refresh = "Refresh"
show Move = "Move"
show Clone = "Clone"
show Delete = "Delete"
show Share = "Share"
show Config = "Config"
show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show CopyFromCorpus = "Copy from corpus"
glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-sign"
glyphiconNodeAction Delete = "trash"
glyphiconNodeAction (Add _) = "plus"
glyphiconNodeAction SearchBox = "search"
glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "transfer"
glyphiconNodeAction Download = "download"
glyphiconNodeAction CopyFromCorpus = "random"
glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction _ = ""
------------------------------------------------------------------------
data SettingsBox =
SettingsBox { show :: Boolean
, edit :: Boolean
, doc :: NodeAction
, buttons :: Array NodeAction
}
------------------------------------------------------------------------
settingsBox :: NodeType -> SettingsBox
settingsBox NodeUser = SettingsBox {
show : true
, edit : false
, doc : Documentation NodeUser
, buttons : [ Delete ]
}
settingsBox FolderPrivate = SettingsBox {
show : true
, edit : false
, doc : Documentation FolderPrivate
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
]
}
settingsBox Team = SettingsBox {
show : true
, edit : true
, doc : Documentation Team
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Delete]
}
settingsBox FolderShared = SettingsBox {
show : true
, edit : true
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
-- , Delete
]
}
settingsBox FolderPublic = SettingsBox {
show : true
, edit : false
, doc : Documentation FolderPublic
, buttons : [ Add [ Corpus
, Folder
]
]
}
settingsBox Folder =
SettingsBox { show : true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Delete
]
}
settingsBox Corpus =
SettingsBox { show : true
, edit : true
, doc : Documentation Corpus
, buttons : [ SearchBox
, Add [ NodeList
, Graph
, Dashboard
]
, Upload
, Download
--, Share
--, Move
--, Clone
, Link Annuaire
, Delete
]
}
settingsBox Texts =
SettingsBox { show : true
, edit : false
, doc : Documentation Texts
, buttons : [ Refresh
, Upload
, Download
-- , Delete
]
}
settingsBox Graph =
SettingsBox { show : true
, edit : false
, doc : Documentation Graph
, buttons : [ Refresh
, Config
, Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox NodeList =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeList
, buttons : [ Refresh
, Config
, Download
, Upload
, CopyFromCorpus
, Delete
]
}
settingsBox Dashboard =
SettingsBox { show : true
, edit : false
, doc : Documentation Dashboard
, buttons : []
}
settingsBox Annuaire = -- START node text
SettingsBox { show : true type NodeTextProps =
, edit : false ( isSelected :: Boolean
, doc : Documentation Annuaire , name :: Name
, buttons : [ Upload )
, Delete
] nodeText :: Record NodeTextProps -> R.Element
} nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
cpt { isSelected: true, name } _ = do
pure $ H.u {} [
H.b {} [
H.text ("| " <> name <> " | ")
]
]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
-- START nodeActions
type NodeActionsProps =
( id :: ID
, nodeType :: GT.NodeType
, refreshTree :: Unit -> Aff Unit
, session :: Session
)
nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p []
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
where
cpt { id
, nodeType: GT.Graph
, refreshTree
, session
} _ = do
useLoader id (graphVersions session) $ \gv ->
nodeActionsGraph { id
, graphVersions: gv
, session
, triggerRefresh: triggerRefresh refreshTree
}
cpt { id
, nodeType: GT.NodeList
, refreshTree
, session
} _ = do
useLoader { nodeId: id, session } loadCorpusWithChild $
\{ corpusId } ->
nodeActionsNodeList { listId: id
, nodeId: corpusId
, nodeType: GT.TabNgramType GT.CTabTerms
, session
, triggerRefresh: triggerRefresh refreshTree
}
cpt _ _ = do
pure $ H.div {} []
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
triggerRefresh refreshTree = refreshTree
-- END nodeActions
mAppRouteId :: Maybe Routes.AppRoute -> Maybe Int
mAppRouteId (Just (Routes.Folder _ id)) = Just id
mAppRouteId (Just (Routes.FolderPrivate _ id)) = Just id
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
settingsBox _ =
SettingsBox { show : false
, edit : false
, doc : Documentation NodeUser
, buttons : []
}
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action where module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Maybe (Maybe)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude hiding (div) import Gargantext.Prelude (class Show, Unit)
import Gargantext.Sessions (Session)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Routes as GR
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
{-
type UpdateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
)
-}
data Action = CreateSubmit String GT.NodeType data Action = AddNode String GT.NodeType
| DeleteNode | DeleteNode
| UpdateNode GT.AsyncTaskWithType | RenameNode String
| SearchQuery GT.AsyncTaskWithType | UpdateNode UpdateNodeParams
| Submit String | ShareNode String
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents | UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode
| RefreshTree | RefreshTree
-----------------------------------------------------
-- TODO Delete with asyncTaskWithType instance showShow :: Show Action where
deleteNode :: Session -> GT.ID -> Aff GT.ID show (AddNode _ _ )= "AddNode"
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) "" show DeleteNode = "DeleteNode"
----------------------------------------------------------------------- show (RenameNode _ )= "RenameNode"
show (UpdateNode _ )= "UpdateNode"
show (ShareNode _ )= "ShareNode"
show (DoSearch _ )= "SearchQuery"
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
type Props = type Props =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
...@@ -35,18 +48,27 @@ type Props = ...@@ -35,18 +48,27 @@ type Props =
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
) )
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon DeleteNode = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareNode _) = glyphiconNodeAction Share
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
-- icon _ = "hand-o-right"
-- TODO remove these types from here text :: Action -> String
text (AddNode _ _ )= "Add !"
data FileType = CSV | CSV_HAL | WOS | PresseRIS text DeleteNode = "Delete !"
text (RenameNode _ )= "Rename !"
derive instance genericFileType :: Generic FileType _ text (UpdateNode _ )= "Update !"
text (ShareNode _ )= "Share !"
instance eqFileType :: Eq FileType where text (DoSearch _ )= "Launch search !"
eq = genericEq text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
instance showFileType :: Show FileType where text DownloadNode = "Download !"
show = genericShow -----------------------------------------------------------------------
newtype UploadFileContents = UploadFileContents String
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Add where module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Array (length, head) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Array (head)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
-- import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff)
import Effect.Uncurried (mkEffectFn1) import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, formEdit, formChoiceSafe, panel)
import Gargantext.Types (NodeType(..), readNodeType) import Gargantext.Prelude (Unit, bind, pure, show, ($), (<>))
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT import Gargantext.Types as GT
import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<)) import Gargantext.Types (NodeType(..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -23,9 +21,9 @@ addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID) ...@@ -23,9 +21,9 @@ addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) "" addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session addNodeAsync :: Session
-> GT.ID -> GT.ID
-> AddNodeValue -> AddNodeValue
-> Aff GT.AsyncTaskWithType -> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do addNodeAsync session parentId q = do
task <- post session p q task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode} pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
...@@ -57,77 +55,23 @@ type CreateNodeProps = ...@@ -57,77 +55,23 @@ type CreateNodeProps =
) )
addNodeView :: Record CreateNodeProps addNodeView :: Record CreateNodeProps
-> R.Element -> R.Element
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p [] addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where where
el = R.hooksComponent "AddNodeView" cpt el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do cpt {id, name} _ = do
nodeName <- R.useState' "Name" nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
pure $ H.div {}
[ panelBody readNodeType nodeName nodeType'
, panelFooter nodeName nodeType'
]
where
panelBody :: (String -> NodeType)
-> R.State String
-> R.State NodeType
-> R.Element
panelBody readIt (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.form {className: "form-horizontal"} $ maybeChoose <> maybeEdit ]
]
]
where
SettingsBox {edit} = settingsBox nt
maybeEdit = [ if edit then
H.div {className: "form-group"}
[ H.input { type: "text"
, placeholder: "Node name"
, defaultValue: "Write Name here"
, className: "form-control"
, onInput: mkEffectFn1 $ setNodeName <<< const <<< R2.unsafeEventValue
}
]
else
H.div {} []
]
maybeChoose = [ if length nodeTypes > 1 then
R.fragment [
H.div {className: "form-group"} $ [
R2.select { className: "form-control"
, onChange: mkEffectFn1 $ setNodeType <<< const <<< readIt <<< R2.unsafeEventValue
}
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
]
-- , showConfig nt
]
else
H.button { className : "btn btn-primary"
, type : "button"
, onClick : mkEffectFn1 $ \_ -> setNodeType ( const
$ fromMaybe nt
$ head nodeTypes
)
} []
]
let
SettingsBox {edit} = settingsBox nt
maybeChoose = [ formChoiceSafe nodeTypes Error setNodeType ]
maybeEdit = [ if edit
then formEdit "Node Name" setNodeName
else H.div {} []
]
panelFooter :: R.State String -> R.State NodeType -> R.Element pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt) dispatch)
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-primary text-center"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
-- TODO
--setPopupOpen $ const Nothing
launchAff $ dispatch $ CreateSubmit name' nt
} [H.text "Add"]
]
-- END Create Node -- END Create Node
......
src/Gargantext/Components/Forest/Tree/Node/Action/CopyFrom.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.CopyFrom where module Gargantext.Components.Forest.Tree.Node.Action.CopyFrom where
import Data.Array as A
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff) import Data.Array as A
import Effect.Class (liftEffect) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect.Aff (Aff)
import Partial.Unsafe (unsafePartial) import Gargantext.Components.Forest.Tree.Node.Action (Props)
import React.SyntheticEvent as E import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude (class Show, Unit, bind, const, discard, map, pure, show, unit, void, ($), (&&), (/=), (<>))
import Gargantext.Components.Lang (readLang, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, ID, LNode(..), NTree(..))
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>))
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), postWwwUrlencoded, get) import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (id) import Reactix as R
import Gargantext.Utils.Reactix as R2 import Reactix.DOM.HTML as H
loadNode :: Session -> GT.ID -> Aff FTree ------------------------------------------------------------------------
loadNode session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) "" getNodeTree :: Session -> GT.ID -> Aff FTree
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
copyFromCorpusView :: Record Props -> R.Element copyFromCorpusView :: Record Props -> R.Element
copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props [] copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
...@@ -38,10 +25,22 @@ copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props [] ...@@ -38,10 +25,22 @@ copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
copyFromCorpusViewCpt :: R.Component Props copyFromCorpusViewCpt :: R.Component Props
copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
where where
cpt {dispatch, id, nodeType, session} _ = do cpt { dispatch
useLoader session loadCorporaTree $ , id
\tree -> , nodeType
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree} , session
} _ =
do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded { dispatch
, id
, nodeType
, session
, tree
}
------------------------------------------------------------------------
type CorpusTreeProps = type CorpusTreeProps =
( tree :: FTree ( tree :: FTree
...@@ -55,9 +54,10 @@ copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps ...@@ -55,9 +54,10 @@ copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
where where
cpt p@{dispatch, id, nodeType, session, tree} _ = do cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } [ pure $ H.div { className: "copy-from-corpus" }
H.div { className: "tree" } [copyFromCorpusTreeView p] [ H.div { className: "tree" }
] [copyFromCorpusTreeView p]
]
copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props [] copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
...@@ -67,11 +67,13 @@ copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeVi ...@@ -67,11 +67,13 @@ copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeVi
where where
cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} [] pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
, -} H.div { className: "node" } ([ H.span { className: "name " <> clickable , -} H.div { className: "node" }
, on: { click: onClick } ( [ H.span { className: "name " <> clickable
} [ H.text name ] , on: { click: onClick }
} [ H.text name ]
] <> children) ] <> children
)
-- ] -- ]
where where
children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
...@@ -91,10 +93,12 @@ loadCorporaTree session = getCorporaTree session treeId ...@@ -91,10 +93,12 @@ loadCorporaTree session = getCorporaTree session treeId
getCorporaTree :: Session -> Int -> Aff FTree getCorporaTree :: Session -> Int -> Aff FTree
getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" typesList
, GT.FolderShared typesList = [ GT.FolderPrivate
, GT.Team , GT.FolderShared
, GT.FolderPublic , GT.Team
, GT.Folder , GT.FolderPublic
, GT.Corpus , GT.Folder
, GT.NodeList] , GT.Corpus
, GT.NodeList
]
src/Gargantext/Components/Forest/Tree/Node/Action/Delete.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Effect.Aff (Aff)
import Gargantext.Types as GT
import Gargantext.Sessions (Session, delete)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Types (NodeType(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Reactix.DOM.HTML as H
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> GT.ID -> Aff GT.ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
actionDelete NodeUser _ = do
pure $ panel [ 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."
]
]
(H.div {} [])
actionDelete _ dispatch = do
pure $ panel [ 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."
]
)
]
(submitButton DeleteNode dispatch)
src/Gargantext/Components/Forest/Tree/Node/Action/Documentation.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
-- | Action: Show Documentation
actionDoc :: NodeType -> R.Hooks R.Element
actionDoc nodeType =
pure $ panel ( [ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
)
( H.div {} [])
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]
src/Gargantext/Components/Forest/Tree/Node/Action/Download.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Download where
import Data.Maybe (Maybe(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(DownloadNode))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref)
import Gargantext.Ends (url)
import Gargantext.Prelude (pure, ($))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
-- | Action : Download
actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element
actionDownload NodeList id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
info = "Info about the List as JSON format"
actionDownload GT.Graph id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
info = "Info about the Graph as GEXF format"
actionDownload GT.Corpus id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Download as JSON"
{-
-- TODO fix the route
actionDownload GT.Texts id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
info = "TODO: fix the backend route. What is the expected result ?"
-}
actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to download your file here "
src/Gargantext/Components/Forest/Tree/Node/Action/Rename.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Rename where module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Effect.Aff (Aff)
import Effect.Aff (Aff, launchAff) import Prelude (($))
import Effect.Uncurried (mkEffectFn1)
import Prelude (Unit, bind, const, discard, pure, ($), (<<<))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Types (NodeType, ID, Name) import Gargantext.Types (ID)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Utils.Reactix as R2 import Gargantext.Sessions (Session, put)
import Gargantext.Sessions (Session, get, put, post, delete)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID) ------------------------------------------------------------------------
renameNode session renameNodeId = rename :: Session -> ID -> RenameValue -> Aff (Array ID)
rename session renameNodeId =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename" put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
renameAction :: String -> Action
renameAction newName = RenameNode newName
------------------------------------------------------------------------
newtype RenameValue = RenameValue newtype RenameValue = RenameValue
{ name :: Name } { text :: String }
instance encodeJsonRenameValue :: EncodeJson RenameValue where instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name}) encodeJson (RenameValue {text})
= "r_name" := name = "r_name" := text
~> jsonEmptyObject ~> jsonEmptyObject
------------------------------------------------------------------------
-- | START Rename Box
type RenameBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, name :: Name
, nodeType :: NodeType
, renameBoxOpen :: R.State Boolean
)
renameBox :: Record RenameBoxProps -> R.Element
renameBox p@{ dispatch, renameBoxOpen: (true /\ setRenameBoxOpen) } = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {id, name, nodeType} _ = do
renameNodeName <- R.useState' name
pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName
, renameBtn renameNodeName
, cancelBtn
]
where
renameInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: "Rename Node"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ setRenameNodeName <<< const <<< R2.unsafeEventValue
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
launchAff $ dispatch $ Submit newName
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel"
} []
renameBox p@{ renameBoxOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {name} _ = pure $ H.div {} []
-- END Rename Box
src/Gargantext/Components/Forest/Tree/Node/Action/Search.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Search where
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Lang (allLangs)
import Gargantext.Prelude (Unit, bind, pure, unit, ($), (<>))
import Gargantext.Sessions (Session)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
-- | Action : Search
actionSearch :: Session
-> Maybe ID
-> (Action -> Aff Unit)
-> Maybe NodePopup
-> R.Hooks R.Element
actionSearch session id dispatch nodePopup = do
search <- R.useState' $ defaultSearch { node_id = id }
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: searchOn dispatch nodePopup
, search
, session
}
]
where
searchOn :: (Action -> Aff Unit)
-> Maybe NodePopup
-> GT.AsyncTaskWithType
-> Effect Unit
searchOn dispatch' p task = do
_ <- launchAff $ dispatch' (DoSearch task)
-- close popup
-- TODO
--snd p $ const Nothing
pure unit
src/Gargantext/Components/Forest/Tree/Node/Action/Search/Frame.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where
import DOM.Simple as DOM
import DOM.Simple.Event (MessageEvent)
import DOM.Simple.EventListener (Callback, addEventListener, callback)
import DOM.Simple.Window (window)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.String (toLower)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Search, isIsTex_Advanced)
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==), class Show, show)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
--------------------
data FrameSource = Istex | Searx
derive instance genericFrameSource :: Generic FrameSource _
instance showFrameSource :: Show FrameSource where
show = genericShow
--------------------
-- | Iframes
searchIframes :: R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
searchIframes search@(search' /\ _) iframeRef =
if isIsTex_Advanced search'.datafield
then divIframe Istex search iframeRef
else
if Just Web == search'.datafield
then divIframe Searx search iframeRef
else H.div {} []
divIframe :: FrameSource
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
divIframe frameSource search@(search' /\ _) iframeRef =
H.div { className: "frame-search panel panel-default" }
[ iframeWith (frameUrl frameSource)search iframeRef ]
frameUrl :: FrameSource -> String
frameUrl frameSource = frameUrl' (toLower $ show frameSource)
where
frameUrl' s = "https://" <> s <> ".frame.gargantext.org"
iframeWith :: String
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
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))
]
src/Gargantext/Components/Search/SearchBar.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs
View file @ 0b03d8c1
module Gargantext.Components.Search.SearchBar module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
( Props, searchBar, searchBarCpt ( Props, searchBar, searchBarCpt
) 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.Forest.Tree.Node.Action.Search.SearchField (searchField)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Lang (Lang) import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Prelude (Unit, pure, ($)) import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types as GT import Gargantext.Types as GT
...@@ -33,10 +28,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt ...@@ -33,10 +28,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s --onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}} pure $ H.div {"style": {"margin" :"10px"}}
[ searchField { databases:allDatabases [ searchField { databases:allDatabases
, langs , langs
, onSearch , onSearch
, search , search
, session , session
} }
] ]
src/Gargantext/Components/Search/SearchField.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs
View file @ 0b03d8c1
module Gargantext.Components.Search.SearchField module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex, isIsTex_Advanced) where where
import Data.Maybe (Maybe(..), maybe, fromMaybe, isJust) import DOM.Simple.Console (log, log2)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Nullable (null)
import Data.Newtype (over) import Data.Newtype (over)
import Data.String (length)
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst) import Data.String (length)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Nullable (Nullable, toMaybe)
import Effect.Console (logShow)
import DOM.Simple.Console (log, log2)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect (Effect) import Effect (Effect)
import Reactix as R import Effect.Aff (launchAff_)
import Reactix.DOM.HTML as H import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==)) import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search)
import Gargantext.Data.Array (catMaybes)
import Gargantext.Components.Lang (Lang) import Gargantext.Components.Lang (Lang)
import Gargantext.Components.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database) import Gargantext.Prelude (Unit, bind, discard, map, pure, show, ($), (<), (<$>), (<>), (==), read)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
select :: forall props. import Reactix.DOM.HTML as H
R.IsComponent String props (Array R.Element)
=> Record props
-> Array R.Element
-> R.Element
select = R.createElement "select"
type Search = { databases :: Database
, datafield :: Maybe DataField
, url :: String
, lang :: Maybe Lang
, node_id :: Maybe Int
, term :: String
}
eqSearch :: Search -> Search -> Boolean
eqSearch s s' = (s.databases == s'.databases)
&& (s.datafield == s'.datafield)
&& (s.lang == s'.lang)
&& (s.node_id == s'.node_id)
&& (s.term == s'.term)
defaultSearch :: Search defaultSearch :: Search
defaultSearch = { databases: Empty defaultSearch = { databases: Empty
...@@ -75,18 +50,15 @@ searchFieldComponent :: R.Component Props ...@@ -75,18 +50,15 @@ searchFieldComponent :: R.Component Props
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
where where
cpt props@{onSearch, search: search@(s /\ _)} _ = do cpt props@{onSearch, search: search@(s /\ _)} _ = do
pure $ iframeRef <- R.useRef null
H.div { className: "search-field-group", style: { width: "100%" } } let params =
[
H.div { className: "row" }
[
H.div { className: "col-md-12" }
[ searchInput {search} [ searchInput {search}
, if length s.term < 3 -- search with love : <3 , if length s.term < 3 -- search with love : <3
then then
H.div {}[] H.div {}[]
else else
H.div {} [ dataFieldNav search dataFields H.div {} [ dataFieldNav search dataFields
, if isExternal s.datafield , if isExternal s.datafield
then databaseInput search props.databases then databaseInput search props.databases
else H.div {} [] else H.div {} []
...@@ -102,46 +74,44 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt ...@@ -102,46 +74,44 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
, if isCNRS s.datafield , if isCNRS s.datafield
then componentCNRS search then componentCNRS search
else H.div {} [] else H.div {} []
, H.div {} [ searchIframes search iframeRef ]
, if needsLang s.datafield
then langNav search props.langs
else H.div {} []
] ]
] ]
] let button = submitButton {onSearch, search, session: props.session}
, H.div { className : "panel-footer" }
[ if needsLang s.datafield pure $ panel params button
then langNav search props.langs
else H.div {} []
, H.div {} [] componentIMT (search /\ setSearch) =
, H.div {className: "flex-center"} R.fragment
[submitButton {onSearch, search, session: props.session}] [ H.ul {} $ map liCpt allIMTorgs
] --, filterInput fi
] ]
eqProps :: Record Props -> Record Props -> Boolean where
eqProps p p' = (p.databases == p'.databases ) liCpt org =
&& (p.langs == p'.langs ) H.li {}
&& (eqSearch (fst p.search) (fst p'.search)) [ H.input { type: "checkbox"
-- && (fst p.filters == fst p'.filters ) , checked: isIn org search.datafield
componentIMT (search /\ setSearch) = , on: { change: \_ -> ( setSearch $ _ { datafield = updateFilter org search.datafield })
R.fragment }
[ H.ul {} $ map liCpt allIMTorgs }
--, filterInput fi , if org == All_IMT
] then H.i {} [H.text $ " " <> show org]
where else H.text $ " " <> show org
liCpt org =
H.li {}
[ H.input { type: "checkbox"
, checked: isIn org search.datafield
, on: { change: \_ -> ( setSearch $ _ { datafield = updateFilter org search.datafield })
}
}
, if org == All_IMT
then H.i {} [H.text $ " " <> show org]
else H.text $ " " <> show org
]
componentCNRS (search /\ setSearch) =
R.fragment [
H.div {} []
--, filterInput fi
] ]
componentCNRS (search /\ setSearch) =
R.fragment [
H.div {} []
--, filterInput fi
]
isExternal :: Maybe DataField -> Boolean isExternal :: Maybe DataField -> Boolean
isExternal (Just (External _)) = true isExternal (Just (External _)) = true
...@@ -165,16 +135,6 @@ isIsTex ( Just ...@@ -165,16 +135,6 @@ 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
...@@ -264,9 +224,11 @@ langNav ({lang} /\ setSearch) langs = ...@@ -264,9 +224,11 @@ langNav ({lang} /\ setSearch) langs =
------------------------------------------------------------------------ ------------------------------------------------------------------------
dataFieldNav :: R.State Search -> Array DataField -> R.Element dataFieldNav :: R.State Search -> Array DataField -> R.Element
dataFieldNav ({datafield} /\ setSearch) datafields = dataFieldNav ({datafield} /\ setSearch) datafields =
R.fragment [ H.div {className: "text-primary center"} [H.text "with DataField"] R.fragment [ H.div { className: "text-primary center"} [H.text "with DataField"]
, H.div {className: "nav nav-tabs"} (liItem <$> dataFields) , H.div {className: "nav nav-tabs"} (liItem <$> dataFields)
, H.div {className: "center"} [ H.text $ maybe "" doc datafield ] , H.div {className: "center"} [ H.text
$ maybe "TODO: add Doc Instance" doc datafield
]
] ]
where where
liItem :: DataField -> R.Element liItem :: DataField -> R.Element
...@@ -276,9 +238,9 @@ dataFieldNav ({datafield} /\ setSearch) datafields = ...@@ -276,9 +238,9 @@ dataFieldNav ({datafield} /\ setSearch) datafields =
then " active" then " active"
else "" else ""
, on: { click: \_ -> setSearch $ _ { datafield = Just df' , on: { click: \_ -> setSearch $ _ { datafield = Just df'
, databases = datafield2database df' , databases = datafield2database df'
} }
} }
-- just one database query for now -- just one database query for now
-- a list a selected database needs more ergonomy -- a list a selected database needs more ergonomy
} [ H.text (show df') ] } [ H.text (show df') ]
...@@ -326,7 +288,7 @@ databaseInput (search /\ setSearch) dbs = ...@@ -326,7 +288,7 @@ databaseInput (search /\ setSearch) dbs =
liItem db' = H.option {className : "text-primary center"} [ H.text (show db') ] liItem db' = H.option {className : "text-primary center"} [ H.text (show db') ]
onChange e = do onChange e = do
let value = readDatabase $ R2.unsafeEventValue e let value = read $ R2.unsafeEventValue e
setSearch $ _ { datafield = Just $ External value setSearch $ _ { datafield = Just $ External value
, databases = fromMaybe Empty value , databases = fromMaybe Empty value
} }
...@@ -345,7 +307,7 @@ orgInput ({datafield} /\ setSearch) orgs = ...@@ -345,7 +307,7 @@ orgInput ({datafield} /\ setSearch) orgs =
liItem org = H.option {className : "text-primary center"} [ H.text (show org) ] liItem org = H.option {className : "text-primary center"} [ H.text (show org) ]
onChange e = do onChange e = do
let value = R2.unsafeEventValue e let value = R2.unsafeEventValue e
setSearch $ _ { datafield = Just $ External $ Just $ HAL $ readOrg value } setSearch $ _ { datafield = Just $ External $ Just $ HAL $ read value }
{- {-
filterInput :: R.State String -> R.Element filterInput :: R.State String -> R.Element
...@@ -392,8 +354,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt ...@@ -392,8 +354,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
type SubmitButtonProps = type SubmitButtonProps =
( onSearch :: GT.AsyncTaskWithType -> Effect Unit ( onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search , search :: R.State Search
, session :: Session , session :: Session
) )
submitButton :: Record SubmitButtonProps -> R.Element submitButton :: Record SubmitButtonProps -> R.Element
......
src/Gargantext/Components/Search/Types.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/Types.purs
View file @ 0b03d8c1
module Gargantext.Components.Search.Types where module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Data.Array (concat)
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (concat)
import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Set (Set) import Data.Set (Set)
...@@ -9,17 +9,33 @@ import Data.Set as Set ...@@ -9,17 +9,33 @@ import Data.Set as Set
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
import Gargantext.Components.Lang import Gargantext.Components.Lang
import Gargantext.Ends (class ToUrl, backendUrl) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Prelude (id, class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>), class Read)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post) import Gargantext.Sessions (Session(..), post)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (id) import URI.Extra.QueryPairs as QP
import URI.Query as Q
type Search = { databases :: Database
, datafield :: Maybe DataField
, url :: String
, lang :: Maybe Lang
, node_id :: Maybe Int
, term :: String
}
isIsTex_Advanced :: Maybe DataField -> Boolean
isIsTex_Advanced ( Just
( External
( Just ( IsTex_Advanced)
)
)
) = true
isIsTex_Advanced _ = false
------------------------------------------------------------------------ ------------------------------------------------------------------------
class Doc a where class Doc a where
...@@ -130,17 +146,18 @@ instance docDatabase :: Doc Database where ...@@ -130,17 +146,18 @@ instance docDatabase :: Doc Database where
-- doc News = "Web filtered by News" -- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs" -- doc SocialNetworks = "Web filtered by MicroBlogs"
readDatabase :: String -> Maybe Database instance readDatabase :: Read Database where
readDatabase "All Databases" = Just All_Databases read :: String -> Maybe Database
readDatabase "PubMed" = Just PubMed read "All Databases" = Just All_Databases
readDatabase "HAL" = Just $ HAL Nothing read "PubMed" = Just PubMed
readDatabase "Isidore"= Just Isidore read "HAL" = Just $ HAL Nothing
readDatabase "IsTex" = Just IsTex read "Isidore"= Just Isidore
readDatabase "IsTex_Advanced" = Just IsTex_Advanced read "IsTex" = Just IsTex
-- readDatabase "Web" = Just Web read "IsTex_Advanced" = Just IsTex_Advanced
-- readDatabase "News" = Just News -- read "Web" = Just Web
-- readDatabase "Social Networks" = Just SocialNetworks -- read "News" = Just News
readDatabase _ = Nothing -- read "Social Networks" = Just SocialNetworks
read _ = Nothing
derive instance eqDatabase :: Eq Database derive instance eqDatabase :: Eq Database
...@@ -169,12 +186,12 @@ instance showOrg :: Show Org where ...@@ -169,12 +186,12 @@ instance showOrg :: Show Org where
show (IMT _) = "IMT" show (IMT _) = "IMT"
show (Others _) = "Others" show (Others _) = "Others"
readOrg :: String -> Maybe Org instance readOrg :: Read Org where
readOrg "All_Orgs" = Just $ All_Orgs read "All_Orgs" = Just $ All_Orgs
readOrg "CNRS" = Just $ CNRS $ Set.fromFoldable [] read "CNRS" = Just $ CNRS $ Set.fromFoldable []
readOrg "IMT" = Just $ IMT $ Set.fromFoldable [] read "IMT" = Just $ IMT $ Set.fromFoldable []
readOrg "Others" = Just $ Others $ Set.fromFoldable [] read "Others" = Just $ Others $ Set.fromFoldable []
readOrg _ = Nothing read _ = Nothing
derive instance eqOrg :: Eq Org derive instance eqOrg :: Eq Org
...@@ -248,26 +265,26 @@ instance showIMT_org :: Show IMT_org where ...@@ -248,26 +265,26 @@ instance showIMT_org :: Show IMT_org where
show Telecom_ParisTech = "Telecom_ParisTech" show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis" show Telecom_SudParis = "Telecom_SudParis"
readIMT_org :: String -> Maybe IMT_org instance readIMT_org :: Read IMT_org where
readIMT_org "All_IMT" = Just All_IMT read "All_IMT" = Just All_IMT
readIMT_org "ARMINES" = Just ARMINES read "ARMINES" = Just ARMINES
readIMT_org "Eurecom" = Just Eurecom read "Eurecom" = Just Eurecom
readIMT_org "IMT_Atlantique" = Just IMT_Atlantique read "IMT_Atlantique" = Just IMT_Atlantique
readIMT_org "IMT_Business_School" = Just IMT_Business_School read "IMT_Business_School" = Just IMT_Business_School
readIMT_org "IMT_Lille_Douai" = Just IMT_Lille_Douai read "IMT_Lille_Douai" = Just IMT_Lille_Douai
readIMT_org "IMT_Mines_ALES" = Just IMT_Mines_ALES read "IMT_Mines_ALES" = Just IMT_Mines_ALES
readIMT_org "IMT_Mines_Albi" = Just IMT_Mines_Albi read "IMT_Mines_Albi" = Just IMT_Mines_Albi
readIMT_org "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris read "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
readIMT_org "MINES_ParisTech" = Just MINES_ParisTech read "MINES_ParisTech" = Just MINES_ParisTech
readIMT_org "Mines_Douai" = Just Mines_Douai read "Mines_Douai" = Just Mines_Douai
readIMT_org "Mines_Nantes" = Just Mines_Nantes read "Mines_Nantes" = Just Mines_Nantes
readIMT_org "Mines_SaintEtienne" = Just Mines_SaintEtienne read "Mines_SaintEtienne" = Just Mines_SaintEtienne
readIMT_org "Telecom_Bretagne" = Just Telecom_Bretagne read "Telecom_Bretagne" = Just Telecom_Bretagne
readIMT_org "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management read "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
readIMT_org "Telecom_Lille" = Just Telecom_Lille read "Telecom_Lille" = Just Telecom_Lille
readIMT_org "Telecom_ParisTech" = Just Telecom_ParisTech read "Telecom_ParisTech" = Just Telecom_ParisTech
readIMT_org "Telecom_SudParis" = Just Telecom_SudParis read "Telecom_SudParis" = Just Telecom_SudParis
readIMT_org _ = Nothing read _ = Nothing
imtStructId :: IMT_org -> Array StructId imtStructId :: IMT_org -> Array StructId
imtStructId All_IMT = concat $ map imtStructId allIMTSubOrgs imtStructId All_IMT = concat $ map imtStructId allIMTSubOrgs
......
src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
------------------------------------------------------------------------
share :: Session -> ID -> ShareValue -> Aff (Array ID)
share session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
shareAction :: String -> Action
shareAction username = ShareNode username
------------------------------------------------------------------------
newtype ShareValue = ShareValue
{ text :: String }
instance encodeJsonShareValue :: EncodeJson ShareValue where
encodeJson (ShareValue {text})
= "username" := text
~> jsonEmptyObject
------------------------------------------------------------------------
textInputBox :: Record Tools.TextInputBoxProps -> R.Element
textInputBox = Tools.textInputBox
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Update where module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Array (length, head)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Maybe (Maybe(..), fromMaybe)
-- import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff) import Data.Maybe (Maybe(..))
import Effect.Uncurried (mkEffectFn1) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Types (NodeType(..), readNodeType) import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Utils.Reactix as R2 import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Prelude (Unit, bind, ($), pure)
import Gargantext.Sessions (Session, post) import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Types as GT
import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
{-
updateNode :: Session -> ID -> UpdateNodeParams -> Aff (Array ID) updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateNode session nodeId params = post session $ GR.NodeAPI GT.Node (Just nodeId) "" updateRequest (UpdateNodeParamsList meth) session nodeId = do
-} task <- post session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
data UpdateNodeParams = UpdateNodeParamsList { method :: Int } where
| UpdateNodeParamsGraph { method :: String } p = GR.NodeAPI GT.Node (Just nodeId) "update/nobody"
| UpdateNodeParamsTexts { method :: Int }
updateRequest (UpdateNodeParamsGraph meth) session nodeId = do
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams task <- post session p meth
where pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
encodeJson (UpdateNodeParamsList { method }) where
= "method" := method p = GR.NodeAPI GT.Node (Just nodeId) "update/nobody"
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method }) updateRequest (UpdateNodeParamsTexts meth) session nodeId = do
= "method" := method task <- post session p meth
~> jsonEmptyObject pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
encodeJson (UpdateNodeParamsTexts { method }) where
= "method" := method p = GR.NodeAPI GT.Node (Just nodeId) "update/nobody"
~> jsonEmptyObject
updateRequest (UpdateNodeParamsBoard meth) session nodeId = do
task <- post session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
where
p = GR.NodeAPI GT.Node (Just nodeId) "update/nobody"
---------------------------------------------------------------------- ----------------------------------------------------------------------
type UpdateNodeProps = update :: NodeType
( id :: GT.ID -> (Action -> Aff Unit)
, dispatch :: Action -> Aff Unit -> R.Hooks R.Element
, name :: GT.Name update NodeList dispatch = do
, nodeType :: NodeType meth @( methodList /\ setMethod ) <- R.useState' Basic
, params :: UpdateNodeParams pure $ panel [ -- H.text "Update with"
) formChoiceSafe [Basic, Advanced, WithModel] Basic setMethod
]
(submitButton (UpdateNode $ UpdateNodeParamsList {methodList}) dispatch)
update Graph dispatch = do
meth @( methodGraph /\ setMethod ) <- R.useState' Order1
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 setMethod
]
(submitButton (UpdateNode $ UpdateNodeParamsGraph {methodGraph}) dispatch)
update Texts dispatch = do
meth @( methodTexts /\ setMethod ) <- R.useState' NewNgrams
pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams setMethod
]
(submitButton (UpdateNode $ UpdateNodeParamsTexts {methodTexts}) dispatch)
update Dashboard dispatch = do
meth @( methodBoard /\ setMethod ) <- R.useState' All
pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All setMethod
]
(submitButton (UpdateNode $ UpdateNodeParamsBoard {methodBoard}) dispatch)
update _ _ = pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType
src/Gargantext/Components/Forest/Tree/Node/Action/Update/Types.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Update.Types where
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts }
derive instance eqUpdateNodeParams :: Eq UpdateNodeParams
derive instance genericUpdateNodeParams :: Generic UpdateNodeParams _
instance showUpdateNodeParams :: Show UpdateNodeParams where
show = genericShow
instance decodeJsonUpdateNodeParams :: Argonaut.DecodeJson UpdateNodeParams where
decodeJson = genericSumDecodeJson
instance encodeJsonUpdateNodeParams :: Argonaut.EncodeJson UpdateNodeParams where
encodeJson = genericSumEncodeJson
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
derive instance genericMethod :: Generic Method _
derive instance eqMethod :: Eq Method
instance showMethod :: Show Method where
show = genericShow
instance readMethod :: Read Method where
read "Basic" = Just Basic
read "Advanced" = Just Advanced
read "WithModel" = Just WithModel
read _ = Nothing
instance decodeJsonMethod :: Argonaut.DecodeJson Method where
decodeJson = genericEnumDecodeJson
instance encodeJsonMethod :: Argonaut.EncodeJson Method where
encodeJson = genericEnumEncodeJson
----------------------------------------------------------------------
data GraphMetric = Order1 | Order2
derive instance genericGraphMetric :: Generic GraphMetric _
derive instance eqGraphMetric :: Eq GraphMetric
instance showGraphMetric :: Show GraphMetric where
show = genericShow
instance readGraphMetric :: Read GraphMetric where
read "Order1" = Just Order1
read "Order2" = Just Order2
read _ = Nothing
instance decodeJsonGraphMetric :: Argonaut.DecodeJson GraphMetric where
decodeJson = genericEnumDecodeJson
instance encodeJsonGraphMetric :: Argonaut.EncodeJson GraphMetric where
encodeJson = genericEnumEncodeJson
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
derive instance genericGranularity :: Generic Granularity _
derive instance eqGranularity :: Eq Granularity
instance showGranularity :: Show Granularity where
show = genericShow
instance readGranularity :: Read Granularity where
read "NewNgrams" = Just NewNgrams
read "NewTexts" = Just NewTexts
read "Both" = Just Both
read _ = Nothing
instance decodeJsonGranularity :: Argonaut.DecodeJson Granularity where
decodeJson = genericEnumDecodeJson
instance encodeJsonGranularity :: Argonaut.EncodeJson Granularity where
encodeJson = genericEnumEncodeJson
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
derive instance genericChart :: Generic Charts _
derive instance eqChart :: Eq Charts
instance showChart :: Show Charts where
show = genericShow
instance readChart :: Read Charts where
read "Sources " = Just Sources
read "Authors" = Just Authors
read "Institutes" = Just Institutes
read "Ngrams" = Just Ngrams
read "AllCharts" = Just All
read _ = Nothing
instance decodeJsonChart :: Argonaut.DecodeJson Charts where
decodeJson = genericEnumDecodeJson
instance encodeJsonChart :: Argonaut.EncodeJson Charts where
encodeJson = genericEnumEncodeJson
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Array as A import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect (Effect) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Prelude (class Show, Unit, discard, bind, const, id, map, pure, show, unit, void, ($), read)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude (class Show, Unit, bind, const, discard, map, pure, show, unit, void, ($), (&&), (/=), (<>)) -- UploadFile Action
-- | Action : Upload
actionUpload :: NodeType -> ID -> Session -> (Action -> Aff Unit) -> 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."
import Gargantext.Components.Lang (readLang, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props, FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.FTree (FTree, ID, LNode(..), NTree(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), postWwwUrlencoded, get)
import Gargantext.Types as GT
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
-- UploadFile Action
-- file upload types -- file upload types
data DroppedFile = data DroppedFile =
DroppedFile { contents :: UploadFileContents DroppedFile { contents :: UploadFileContents
, fileType :: Maybe FileType , fileType :: Maybe FileType
, lang :: Maybe Lang , lang :: Lang
} }
type FileHash = String type FileHash = String
...@@ -53,35 +62,36 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt ...@@ -53,35 +62,36 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
fileType :: R.State FileType <- R.useState' CSV fileType@(_ /\ setFileType) <- R.useState' CSV
lang :: R.State (Maybe Lang) <- R.useState' (Just EN) lang@( _chosenLang /\ setLang) <- R.useState' EN
pure $ H.div {} [ let bodies = [ H.div { className:"col-md-6 flex-space-around"}
H.div {} [ H.input { type: "file" [ H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mFile} , on: {change: onChangeContents mFile}
} }
] ]
, H.div {className:"col-md-3 flex-space-around"}
, H.div {} [ R2.select {className: "col-md-12 form-control" [ formChoiceSafe [ CSV
, on: {change: onChangeFileType fileType} , CSV_HAL
} , WOS
( map renderOptionFT [ CSV , PresseRIS
, CSV_HAL ] CSV setFileType
, WOS ]
, PresseRIS
] , H.div {className:"col-md-3 flex-space-around"}
) [ formChoiceSafe [EN, FR, No_extraction, Universal] EN setLang ]
] ]
let footer = H.div {} [ uploadButton { dispatch
, H.div {} [ R2.select {className: "col-md-12 form-control" , fileType
, on: {change: onChangeLang lang} , lang
} (map renderOptionLang [EN, FR]) , id
] , mFile
, nodeType
, H.div {} [ uploadButton {dispatch, fileType, lang, id, mFile, nodeType } ] }
] ]
pure $ panel bodies footer
renderOptionFT :: FileType -> R.Element renderOptionFT :: FileType -> R.Element
renderOptionFT opt = H.option {} [ H.text $ show opt ] renderOptionFT opt = H.option {} [ H.text $ show opt ]
...@@ -101,27 +111,23 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt ...@@ -101,27 +111,23 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name} setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
onChangeFileType :: forall e. R.State FileType -> e -> Effect Unit onChangeFileType :: forall e
. R.State FileType
-> e
-> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do onChangeFileType (fileType /\ setFileType) e = do
setFileType $ const setFileType $ const
$ unsafePartial $ unsafePartial
$ fromJust $ fromJust
$ readFileType $ read
$ R2.unsafeEventValue e $ R2.unsafeEventValue e
onChangeLang :: forall e. R.State (Maybe Lang) -> e -> Effect Unit
onChangeLang (lang /\ setLang) e = do
setLang $ const
$ unsafePartial
$ readLang
$ R2.unsafeEventValue e
type UploadButtonProps = type UploadButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, fileType :: R.State FileType , fileType :: R.State FileType
, id :: GT.ID , id :: GT.ID
, lang :: R.State (Maybe Lang) , lang :: R.State Lang
, mFile :: R.State (Maybe UploadFile) , mFile :: R.State (Maybe UploadFile)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
) )
...@@ -132,12 +138,23 @@ uploadButton props = R.createElement uploadButtonCpt props [] ...@@ -132,12 +138,23 @@ uploadButton props = R.createElement uploadButtonCpt props []
uploadButtonCpt :: R.Component UploadButtonProps uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
where where
cpt {dispatch, fileType: (fileType /\ setFileType), id, lang: (lang /\ setLang), mFile: (mFile /\ setMFile), nodeType} _ = do cpt { dispatch
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ] , fileType: (fileType /\ setFileType)
, id
, lang: (lang /\ setLang)
, mFile: (mFile /\ setMFile)
, nodeType
} _ = pure
$ H.button { className: "btn btn-primary"
, "type" : "button"
, disabled
, style : { width: "100%" }
, on: {click: onClick}
} [ H.text "Upload" ]
where where
disabled = case mFile of disabled = case mFile of
Nothing -> "1" Nothing -> "1"
Just _ -> "" Just _ -> ""
onClick e = do onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile let {name, contents} = unsafePartial $ fromJust mFile
...@@ -146,7 +163,7 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt ...@@ -146,7 +163,7 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
liftEffect $ do liftEffect $ do
setMFile $ const $ Nothing setMFile $ const $ Nothing
setFileType $ const $ CSV setFileType $ const $ CSV
setLang $ const $ Just EN setLang $ const $ EN
-- START File Type View -- START File Type View
type FileTypeProps = type FileTypeProps =
...@@ -163,19 +180,24 @@ fileTypeView p = R.createElement fileTypeViewCpt p [] ...@@ -163,19 +180,24 @@ fileTypeView p = R.createElement fileTypeViewCpt p []
fileTypeViewCpt :: R.Component FileTypeProps fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
where where
cpt {dispatch, droppedFile: (Just (DroppedFile {contents, fileType}) /\ setDroppedFile), isDragOver: (_ /\ setIsDragOver), nodeType} _ = do cpt { dispatch
pure $ H.div tooltipProps $ , droppedFile: Just (DroppedFile {contents, fileType}) /\ setDroppedFile
[ H.div {className: "panel panel-default"} , isDragOver: (_ /\ setIsDragOver)
[ panelHeading , nodeType
, panelBody } _ = pure
, panelFooter $ H.div tooltipProps [ H.div { className: "panel panel-default"}
] [ panelHeading
] , panelBody
, panelFooter
]
]
where where
tooltipProps = { className: "" tooltipProps = { className: ""
, id: "file-type-tooltip" , id : "file-type-tooltip"
, title: "Choose file type" , title : "Choose file type"
, data: {toggle: "tooltip", placement: "right"} , data : { toggle: "tooltip"
, placement: "right"
}
} }
panelHeading = panelHeading =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
...@@ -186,26 +208,28 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt ...@@ -186,26 +208,28 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
[ H.a {className: "btn glyphitem glyphicon glyphicon-remove-circle" [ H.a {className: "btn glyphitem glyphicon glyphicon-remove-circle"
, on: {click: \_ -> do , on: {click: \_ -> do
setDroppedFile $ const Nothing setDroppedFile $ const Nothing
setIsDragOver $ const false setIsDragOver $ const false
} }
, title: "Close"} [] , title: "Close"} []
] ]
] ]
] ]
panelBody = panelBody =
H.div {className: "panel-body"} H.div {className: "panel-body"}
[ R2.select {className: "col-md-12 form-control" [ R2.select {className: "col-md-12 form-control"
, on: {change: onChange} , on: {change: onChange}
} }
(map renderOption [CSV, CSV_HAL, WOS]) (map renderOption [CSV, CSV_HAL, WOS])
] ]
where where
onChange e l = onChange e l =
setDroppedFile $ const $ Just $ DroppedFile $ { contents setDroppedFile $ const $ Just $ DroppedFile $ { contents
, fileType: readFileType $ R2.unsafeEventValue e , fileType: read $ R2.unsafeEventValue e
, lang : readLang $ R2.unsafeEventValue l , lang : fromMaybe EN $ read $ R2.unsafeEventValue l
} }
renderOption opt = H.option {} [ H.text $ show opt ] renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter = panelFooter =
H.div {className: "panel-footer"} H.div {className: "panel-footer"}
[ [
...@@ -253,11 +277,12 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con ...@@ -253,11 +277,12 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q) --p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
bodyParams = [ bodyParams = [ Tuple "_wf_data" (Just contents)
Tuple "_wf_data" (Just contents) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_name" mName
, Tuple "_wf_name" mName ]
]
------------------------------------------------------------------------
uploadTermListView :: Record Props -> R.Element uploadTermListView :: Record Props -> R.Element
uploadTermListView props = R.createElement uploadTermListViewCpt props [] uploadTermListView props = R.createElement uploadTermListViewCpt props []
...@@ -267,18 +292,23 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt ...@@ -267,18 +292,23 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
let body = H.input { type: "file"
pure $ H.div {} [
H.div {} [ H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mFile} , on: {change: onChangeContents mFile}
} }
]
, H.div {} [ uploadTermButton { dispatch, id, mFile, nodeType } ] let footer = H.div {} [ uploadTermButton { dispatch
] , id
, mFile
, nodeType
}
]
onChangeContents :: forall e. R.State (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit pure $ panel [body] footer
onChangeContents :: forall e. R.State (Maybe UploadFile)
-> E.SyntheticEvent_ e
-> Effect Unit
onChangeContents (mFile /\ setMFile) e = do onChangeContents (mFile /\ setMFile) e = do
let mF = R2.inputFileNameWithBlob 0 e let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e E.preventDefault e
...@@ -288,7 +318,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt ...@@ -288,7 +318,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
Just {blob, name} -> void $ launchAff do Just {blob, name} -> void $ launchAff do
contents <- readAsText blob contents <- readAsText blob
liftEffect $ do liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name} setMFile $ const $ Just $ { contents: UploadFileContents contents
, name
}
type UploadTermButtonProps = type UploadTermButtonProps =
...@@ -309,7 +341,7 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt ...@@ -309,7 +341,7 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
where where
disabled = case mFile of disabled = case mFile of
Nothing -> "1" Nothing -> "1"
Just _ -> "" Just _ -> ""
onClick e = do onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile let {name, contents} = unsafePartial $ fromJust mFile
...@@ -319,13 +351,4 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt ...@@ -319,13 +351,4 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
setMFile $ const $ Nothing setMFile $ const $ Nothing
-- | UTils
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "CSV_HAL" = Just CSV_HAL
readFileType "PresseRIS" = Just PresseRIS
readFileType "WOS" = Just WOS
readFileType _ = Nothing
src/Gargantext/Components/Forest/Tree/Node/Action/Upload/Types.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Action.Upload.Types where
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Read, class Show, class Eq)
data FileType = CSV | CSV_HAL | WOS | PresseRIS
derive instance genericFileType :: Generic FileType _
instance eqFileType :: Eq FileType where
eq = genericEq
instance showFileType :: Show FileType where
show = genericShow
instance readFileType :: Read FileType where
read :: String -> Maybe FileType
read "CSV" = Just CSV
read "CSV_HAL" = Just CSV_HAL
read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS
read _ = Nothing
newtype UploadFileContents = UploadFileContents String
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Box where module Gargantext.Components.Forest.Tree.Node.Box where
import Data.Array as A import Data.Array as A
import Data.Map as Map import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.String as S
import Data.Nullable (Nullable, null)
import Data.Tuple (fst, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import Effect.Aff (Aff)
import DOM.Simple.Event
import DOM.Simple.EventListener
import DOM.Simple.Types
import DOM.Simple.Window
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Console
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Web.File.FileReader.Aff (readAsText)
import Gargantext.AsyncTasks as GAT import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (copyFromCorpusView) import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox) import Gargantext.Components.Forest.Tree.Node.Action.Delete (actionDelete)
import Gargantext.Components.Forest.Tree.Node.Action.Update import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), uploadFileView, fileTypeView, uploadTermListView) import Gargantext.Components.Forest.Tree.Node.Action.Download (actionDownload)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..)) import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
import Gargantext.Components.GraphExplorer.API as GraphAPI import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch)
import Gargantext.Components.Lang (allLangs, Lang(EN)) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.NgramsTable.API as NTAPI import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
import Gargantext.Components.Search.SearchBar (searchBar) import Gargantext.Components.Forest.Tree.Node.Action.Upload (actionUpload)
import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex_Advanced) import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePopupS)
import Gargantext.Components.Search.Types (DataField(..)) import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Ends (Frontends, url) import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Sessions (Session)
import Gargantext.Prelude import Gargantext.Types (Name, ID)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post)
import Gargantext.Types (NodeType(..), ID, Name, Reload)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive) import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Tasks =
( onTaskAdd :: GT.AsyncTaskWithType -> Effect Unit
, onTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
, tasks :: Array GT.AsyncTaskWithType
)
tasksStruct :: Int -> R.State GAT.Storage -> R.State Reload -> Record Tasks
tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) = { onTaskAdd, onTaskFinish, tasks }
where
tasks = fromMaybe [] $ Map.lookup id asyncTasks
onTaskAdd t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe (Just [t]) $ (\ts -> Just $ A.cons t ts)) id
onTaskFinish t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe Nothing $ (\ts -> Just $ GAT.removeTaskFromList ts t)) id
type CommonProps = type CommonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, session :: Session , session :: Session
) )
-- Main Node
type NodeMainSpanProps =
( id :: ID
, folderOpen :: R.State Boolean
, frontends :: Frontends
, mCurrentRoute :: Maybe Routes.AppRoute
, name :: Name
, nodeType :: GT.NodeType
, tasks :: Record Tasks
| CommonProps
)
nodeMainSpan :: Record NodeMainSpanProps
-> R.Element
nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el p []
where
el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
cpt props@{id, mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }} _ = do
-- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
popoverRef <- R.useRef null
pure $ H.span (dropProps droppedFile isDragOver) $
[ folderIcon nodeType folderOpen
, if showBox then
Popover.popover { arrow: false
, open: false
, onClose: \_ -> pure unit
, onOpen: \_ -> pure unit
, ref: popoverRef } [
popOverIcon
, mNodePopupView props (onPopoverClose popoverRef)
]
else H.div {} []
, H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id)))
}
[ nodeText { isSelected: mAppRouteId mCurrentRoute == Just id
, name: name' props
} ]
, nodeActions { id
, nodeType
, refreshTree: const $ dispatch RefreshTree
, session }
, fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType}
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id
, onFinish: const $ onTaskFinish t
, session }) tasks)
]
where
SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = do
Popover.setOpen popoverRef false
name' {name, nodeType} = if nodeType == GT.NodeUser then show session else name
folderIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "folder-icon"
, onClick: R2.effToggler folderOpen' }
[ H.i {className: GT.fldr nodeType open} [] ]
popOverIcon =
H.a { className: "settings fa fa-cog" } []
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { id
, dispatch
, name: name' props
, nodeType
, onPopoverClose
, session
}
dropProps droppedFile isDragOver =
{ className: "leaf " <> (dropClass droppedFile isDragOver)
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) e = do
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
contents <- readAsText blob
liftEffect $ setDroppedFile
$ const
$ Just
$ DroppedFile { contents: (UploadFileContents contents)
, fileType: Just CSV
, lang: Just EN
}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
{-
fldr nt open = if open
then "fa fa-globe" -- <> color nt
else "fa fa-folder-globe" -- <> color nt
--else "glyphicon glyphicon-folder-close" <> color nt
where
color GT.NodeUser = ""
color FolderPublic = ""
color FolderShared = " text-warning"
color _ = " text-danger"
-}
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement nodeTextCpt p []
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = R.hooksComponent "G.C.F.T.N.B.nodeText" cpt
where
cpt { isSelected: true, name } _ = do
pure $ H.u {} [
H.b {} [
H.text ("| " <> name <> " | ")
]
]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
-- START nodeActions
type NodeActionsProps =
( id :: ID
, nodeType :: GT.NodeType
, refreshTree :: Unit -> Aff Unit
, session :: Session
)
nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p []
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
where
cpt { id, nodeType: GT.Graph, refreshTree, session } _ = do
useLoader id (graphVersions session) $ \gv ->
nodeActionsGraph { id, graphVersions: gv, session, triggerRefresh: triggerRefresh refreshTree }
cpt { id, nodeType: GT.NodeList, refreshTree, session } _ = do
useLoader { nodeId: id, session } loadCorpusWithChild $
\{ corpusId } ->
nodeActionsNodeList { listId: id
, nodeId: corpusId
, nodeType: GT.TabNgramType GT.CTabTerms
, session
, triggerRefresh: triggerRefresh refreshTree }
cpt _ _ = do
pure $ H.div {} []
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
triggerRefresh refreshTree = refreshTree
type NodeActionsGraphProps =
( id :: ID
, graphVersions :: Record GraphAPI.GraphVersions
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element
nodeActionsGraph p = R.createElement nodeActionsGraphCpt p []
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsGraph" cpt
where
cpt { id, graphVersions, session, triggerRefresh } _ = do
pure $ H.div { className: "node-actions" } [
if graphVersions.gv_graph == Just graphVersions.gv_repo then
H.div {} []
else
graphUpdateButton { id, session, triggerRefresh }
]
type GraphUpdateButtonProps =
( id :: ID
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
graphUpdateButton p = R.createElement graphUpdateButtonCpt p []
graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps
graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt
where
cpt { id, session, triggerRefresh } _ = do
enabled <- R.useState' true
pure $ H.div { className: "update-button " <> if (fst enabled) then "enabled" else "disabled text-muted" } [
H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
]
where
onClick (false /\ _) _ = pure unit
onClick (true /\ setEnabled) _ = do
launchAff_ $ do
liftEffect $ setEnabled $ const false
g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true
triggerRefresh unit
pure unit
type NodeActionsNodeListProps =
(
listId :: GT.ListId
, nodeId :: ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
nodeActionsNodeList p = R.createElement nodeActionsNodeListCpt p []
nodeActionsNodeListCpt :: R.Component NodeActionsNodeListProps
nodeActionsNodeListCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsNodeList" cpt
where
cpt props _ = do
pure $ H.div { className: "node-actions" } [
nodeListUpdateButton props
]
type NodeListUpdateButtonProps =
( listId :: GT.ListId
, nodeId :: ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element
nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p []
nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.nodeListUpdateButton" cpt
where
cpt { listId, nodeId, nodeType, session, triggerRefresh } _ = do
enabled <- R.useState' true
pure $ H.div { className: "update-button "
<> if (fst enabled) then "enabled" else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
]
where
onClick (false /\ _) _ = pure unit
onClick (true /\ setEnabled) _ = do
launchAff_ $ do
liftEffect $ setEnabled $ const false
_ <- NTAPI.updateNodeList { listId, nodeId, nodeType, session }
liftEffect $ setEnabled $ const true
triggerRefresh unit
pure unit
-- END nodeActions
mAppRouteId :: Maybe Routes.AppRoute -> Maybe Int
mAppRouteId (Just (Routes.Folder _ id)) = Just id
mAppRouteId (Just (Routes.FolderPrivate _ id)) = Just id
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 =
( id :: ID
, name :: Name
, nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit
| CommonProps
)
type NodePopupS =
( action :: Maybe NodeAction
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
iconAStyle :: { color :: String iconAStyle :: { color :: String
, paddingTop :: String , paddingTop :: String
...@@ -402,52 +56,65 @@ nodePopupCpt :: R.Component NodePopupProps ...@@ -402,52 +56,65 @@ nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
where where
cpt p _ = do cpt p _ = do
renameBoxOpen <- R.useState' false isOpen <- R.useState' false
iframeRef <- R.useRef null nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' { action : Nothing
nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {action: Nothing, id: p.id, name: p.name, nodeType: p.nodeType} , 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-10 flex-between"} [ 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.div { className : "col-md-1" } [] -- TODO fix names
, H.text $ S.replace (S.Pattern "Node") (S.Replacement " ")
$ S.replace (S.Pattern "Folder") (S.Replacement " ")
$ show p.nodeType
, H.p {className: "text-primary center"} [H.text p.name] , H.p {className: "text-primary center"} [H.text p.name]
] ]
] ]
, panelHeading renameBoxOpen p , panelHeading isOpen p
, panelBody nodePopupState p , panelBody nodePopupState p
, mPanelAction nodePopupState p search , mPanelAction nodePopupState p
] ]
, if nodePopup.action == Just SearchBox then
H.div {} [ searchIframes p search iframeRef ]
else
H.div {} []
] ]
] ]
where where
tooltipProps = { className : "" tooltipProps = { 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 isOpen@(open /\ _) {dispatch, id, name, nodeType} =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ R2.row [ R2.row
[ H.div {className: "col-md-8"} [ H.div {className: "col-md-8 flex-end"}
[ renameBox { dispatch, id, name, nodeType, renameBoxOpen } ] [ textInputBox { boxAction: renameAction
, boxName: "Rename"
, dispatch
, id
, text:name
, isOpen
}
]
, H.div {className: "flex-end"} , H.div {className: "flex-end"}
[ if edit then editIcon renameBoxOpen else H.div {} [] [ if edit then editIcon isOpen else H.div {} []
, H.div {className: "col-md-1"} , H.div {className: "col-md-1"}
[ H.a { "type" : "button" [ H.a { "type" : "button"
, className: glyphicon "remove-circle" , className: glyphicon "window-close"
, on: { click: \e -> p.onPopoverClose $ R2.unsafeEventTarget e } , on : { click: \e -> p.onPopoverClose
, title : "Close"} [] $ R2.unsafeEventTarget e
}
, title : "Close"
} []
] ]
] ]
] ]
...@@ -456,12 +123,12 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -456,12 +123,12 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
SettingsBox {edit, doc, buttons} = settingsBox nodeType SettingsBox {edit, doc, buttons} = settingsBox nodeType
editIcon :: R.State Boolean -> R.Element editIcon :: R.State Boolean -> R.Element
editIcon (false /\ setRenameBoxOpen) = editIcon (false /\ setIsOpen) =
H.div {className : "col-md-1"} H.div {className : "col-md-1"}
[ H.a { className: glyphicon "pencil" [ H.a { className: glyphicon "pencil"
, id : "rename1" , id : "rename1"
, title : "Rename" , title : "Rename"
, on: { click: \_ -> setRenameBoxOpen $ const true } , on: { click: \_ -> setIsOpen $ const true }
} }
[] []
] ]
...@@ -472,27 +139,37 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt ...@@ -472,27 +139,37 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
-> R.Element -> 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.p { "style": {"margin":"10px"}} []
, H.div {className: "flex-center"} , H.div { className: "flex-center"}
$ map (\t -> buttonClick {action: t, state: nodePopupState}) buttons [ buttonClick { action: doc
] , state: nodePopupState
}
]
, H.div {className: "flex-center"}
$ map (\t -> buttonClick { action: t
, state : nodePopupState
}
) buttons
]
-- FIXME trick to increase the size of the box
<> if A.length buttons < 2
then [H.div {className: "col-md-4"} []]
else []
where where
SettingsBox {edit, doc, buttons} = settingsBox nodeType SettingsBox {edit, doc, buttons} = settingsBox nodeType
mPanelAction :: R.State (Record NodePopupS) mPanelAction :: R.State (Record NodePopupS)
-> Record NodePopupProps -> Record NodePopupProps
-> R.State Search
-> R.Element -> R.Element
mPanelAction ({action: Nothing} /\ _) _ _ = H.div {} [] mPanelAction ({action: Nothing } /\ _) _ = H.div {} []
mPanelAction ({action: Just action} /\ _) p search = mPanelAction ({action: Just action} /\ _) props =
panelAction { action panelAction { action
, dispatch : p.dispatch , dispatch : props.dispatch
, id : p.id , id : props.id
, name : p.name , name : props.name
, nodePopup: Just NodePopup , nodePopup: Just NodePopup
, nodeType : p.nodeType , nodeType : props.nodeType
, search , session : props.session
, session : p.session
} }
type ActionState = type ActionState =
...@@ -515,17 +192,17 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt ...@@ -515,17 +192,17 @@ buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
where where
cpt {action: todo, state: (node@{action} /\ setNodePopup)} _ = do cpt {action: todo, state: (node@{action} /\ setNodePopup)} _ = do
pure $ H.div {className: "col-md-1"} pure $ H.div {className: "col-md-1"}
[ H.a { style: iconAStyle [ H.a { style: iconAStyle
, className: glyphiconActive (glyphiconNodeAction todo) , className: glyphiconActive (glyphiconNodeAction todo)
(action == (Just todo) ) (action == (Just todo) )
, id: show todo , id: show todo
, title: show todo , title: show todo
, onClick : mkEffectFn1 , onClick : mkEffectFn1
$ \_ -> setNodePopup $ \_ -> setNodePopup
$ const (node { action = action' }) $ const (node { action = action' })
} }
[] []
] ]
where where
action' = if action == (Just todo) action' = if action == (Just todo)
then Nothing then Nothing
...@@ -540,14 +217,13 @@ type NodeProps = ...@@ -540,14 +217,13 @@ type NodeProps =
type PanelActionProps = type PanelActionProps =
( id :: ID ( id :: ID
, action :: NodeAction , action :: NodeAction
, dispatch :: Action -> Aff Unit , dispatch :: Action -> Aff Unit
, name :: Name , name :: Name
, nodePopup :: Maybe NodePopup , nodePopup :: Maybe NodePopup
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
, search :: R.State Search
) )
panelAction :: Record PanelActionProps -> R.Element panelAction :: Record PanelActionProps -> R.Element
...@@ -564,8 +240,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt ...@@ -564,8 +240,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
cpt {action: Refresh , dispatch, id, nodeType, session} _ = do cpt {action: Refresh , dispatch, id, nodeType, session} _ = update nodeType dispatch
pure $ fragmentPT $ "Update " <> show nodeType
cpt {action: Config , dispatch, id, nodeType, session} _ = do cpt {action: Config , dispatch, id, nodeType, session} _ = do
pure $ fragmentPT $ "Config " <> show nodeType pure $ fragmentPT $ "Config " <> show nodeType
...@@ -577,220 +252,19 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt ...@@ -577,220 +252,19 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
<> "to link the corpus with your Annuaire" <> "to link the corpus with your Annuaire"
<> " (and reciprocally)." <> " (and reciprocally)."
cpt props@{action: SearchBox, search, session, dispatch, nodePopup} _ = cpt {action : Share, dispatch, id, name } _ = do
actionSearch search session dispatch nodePopup isOpen <- R.useState' true
pure $ H.div {} [ textInputBox { boxAction: Share.shareAction
, boxName: "Share"
, dispatch
, id
, text: "username"
, isOpen
} ]
cpt props@{action: SearchBox, id, session, dispatch, nodePopup} _ =
actionSearch session (Just id) dispatch nodePopup
cpt _ _ = do cpt _ _ = do
pure $ H.div {} [] pure $ H.div {} []
-- | Action : Search
actionSearch :: R.State Search
-> Session
-> (Action -> Aff Unit)
-> Maybe NodePopup
-> R.Hooks R.Element
actionSearch search session dispatch nodePopup =
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: searchOn dispatch nodePopup
, search
, session
}
]
where
searchOn :: (Action -> Aff Unit)
-> Maybe NodePopup
-> GT.AsyncTaskWithType
-> Effect Unit
searchOn dispatch p task = do
_ <- launchAff $ dispatch (SearchQuery task)
-- close popup
-- TODO
--snd p $ const Nothing
pure unit
-- | Action : Delete
actionDelete :: NodeType -> (Action -> Aff Unit) -> 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 :: (Action -> Aff Unit) -> 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 -> (Action -> Aff Unit) -> 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 :: String -> R.Element
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
--------------------
-- | Iframes
searchIframes :: Record NodePopupProps
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
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 :: String
-> R.State Search
-> R.Ref (Nullable DOM.Element)
-> R.Element
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))
]
src/Gargantext/Components/Forest/Tree/Node/Box/Types.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Box.Types where
import DOM.Simple as DOM
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT
type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session
)
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit
| CommonProps
)
type NodePopupS =
( action :: Maybe NodeAction
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
src/Gargantext/Components/Forest/Tree/Node/Settings.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Settings where
import Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Data.Array (foldl)
import Gargantext.Types
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
-- | RIGHT Management
if user has access to node then he can do all his related actions
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
data Status a = IsBeta a | IsProd a
data NodeAction = Documentation NodeType
| SearchBox
| Download | Upload | Refresh | Config
| Move | Clone | Delete
| Share | Link NodeType
| Add (Array NodeType)
| CopyFromCorpus
instance eqNodeAction :: Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true
eq Download Download = true
eq Upload Upload = true
eq Refresh Refresh = true
eq Move Move = true
eq Clone Clone = true
eq Delete Delete = true
eq Share Share = true
eq (Link x) (Link y) = (x == y)
eq (Add x) (Add y) = (x == y)
eq CopyFromCorpus CopyFromCorpus = true
eq Config Config = true
eq _ _ = false
instance showNodeAction :: Show NodeAction where
show (Documentation x) = "Documentation of " <> show x
show SearchBox = "SearchBox"
show Download = "Download"
show Upload = "Upload"
show Refresh = "Refresh"
show Move = "Move"
show Clone = "Clone"
show Delete = "Delete"
show Share = "Share"
show Config = "Config"
show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show CopyFromCorpus = "Copy from corpus"
glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-circle"
glyphiconNodeAction Delete = "trash"
glyphiconNodeAction (Add _) = "plus"
glyphiconNodeAction SearchBox = "search"
glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "arrows-h"
glyphiconNodeAction Download = "download"
glyphiconNodeAction CopyFromCorpus = "random"
glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction Move = "share-square-o"
glyphiconNodeAction _ = ""
------------------------------------------------------------------------
data SettingsBox =
SettingsBox { show :: Boolean
, edit :: Boolean
, doc :: NodeAction
, buttons :: Array NodeAction
}
------------------------------------------------------------------------
settingsBox :: NodeType -> SettingsBox
settingsBox NodeUser =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeUser
, buttons : [ Delete ]
}
settingsBox FolderPrivate =
SettingsBox { show : true
, edit : false
, doc : Documentation FolderPrivate
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
]
}
settingsBox Team =
SettingsBox { show : true
, edit : true
, doc : Documentation Team
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Share
, Delete]
}
settingsBox FolderShared =
SettingsBox { show : true
, edit : true
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
-- , Delete
]
}
settingsBox FolderPublic =
SettingsBox { show : true
, edit : false
, doc : Documentation FolderPublic
, buttons : [ Add [ Corpus
, Folder
]
]
}
settingsBox Folder =
SettingsBox { show : true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
, Folder
, Annuaire
]
, Move
, Delete
]
}
settingsBox Corpus =
SettingsBox { show : true
, edit : true
, doc : Documentation Corpus
, buttons : [ Add [ NodeList
, Graph
, Dashboard
]
, SearchBox
, Upload
, Download
, Move
--, Clone
, Link Annuaire
, Delete
]
}
settingsBox Texts =
SettingsBox { show : true
, edit : false
, doc : Documentation Texts
, buttons : [ Refresh
, Upload
, Download
-- , Delete
]
}
settingsBox Graph =
SettingsBox { show : true
, edit : false
, doc : Documentation Graph
, buttons : [ Refresh
, Config
, Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox NodeList =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeList
, buttons : [ Refresh
, Config
, Download
, Upload
, CopyFromCorpus
, Delete
]
}
settingsBox Dashboard =
SettingsBox { show : true
, edit : false
, doc : Documentation Dashboard
, buttons : [ Refresh
, Delete
]
}
settingsBox Annuaire =
SettingsBox { show : true
, edit : false
, doc : Documentation Annuaire
, buttons : [ Upload
, Move
, Delete
]
}
settingsBox _ =
SettingsBox { show : false
, edit : false
, doc : Documentation NodeUser
, buttons : []
}
src/Gargantext/Components/Forest/Tree/Node/Tools.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Tools
where
import Data.Maybe (fromMaybe)
import Data.String as S
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>), read, map, class Read, class Show)
import Gargantext.Types (ID)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
type Body = Array R.Element
type Footer = R.Element
panel :: Body -> Footer -> R.Element
panel bodies submit =
H.div {} [ panelBody bodies, footer submit ]
where
panelBody bs =
H.div {className: "panel-body"}
[ H.div { className: "row"
, style: {"margin":"10px"}
}
[ H.div { className: "col-md-10" }
-- TODO add type for text or form here
[ H.form {className: "form-horizontal"} bs
]
]
]
footer sb =
H.div {className: "panel-footer"}
[ H.div {} []
, H.div { className: "center"} [ sb ]
]
------------------------------------------------------------------------
-- | START Text input
type TextInputBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, text :: String
, isOpen :: R.State Boolean
, boxName :: String
, boxAction :: String -> Action
)
textInputBox :: Record TextInputBoxProps -> R.Element
textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen) } = R.createElement el p []
where
el = R.hooksComponent (boxName <> "Box") cpt
cpt {id, text} _ = do
renameNodeName <- R.useState' text
pure $ H.div {className: "from-group row-no-padding"}
[ textInput renameNodeName
, submitBtn renameNodeName
, cancelBtn
]
where
textInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: (boxName <> " Node")
, defaultValue: text
, className: "form-control"
, onInput: mkEffectFn1 $ setRenameNodeName
<<< const
<<< R2.unsafeEventValue
}
]
submitBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setIsOpen $ const false
launchAff $ dispatch ( boxAction newName )
, title: "Submit"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setIsOpen $ const false
, title: "Cancel"
} []
textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponent (boxName <> "Box") cpt
cpt {text} _ = pure $ H.div {} []
-- | END Rename Box
-- | Sugar Text style
fragmentPT :: String -> R.Element
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
-- | Form Edit input
type DefaultText = String
formEdit :: forall previous next
. DefaultText
-> ((previous -> String)
-> Effect next)
-> R.Element
formEdit defaultValue setter =
H.div {className: "form-group"}
[ H.input { type : "text"
, placeholder : defaultValue
, defaultValue: "Write" <> defaultValue
, className : "form-control"
, onInput : mkEffectFn1
$ setter
<<< const
<<< R2.unsafeEventValue
}
]
-- | Form Choice input
-- if the list of options is not big enough, a button is used instead
formChoiceSafe :: forall a b c
. Read a
=> Show a
=> Array a
-> a
-> ((b -> a) -> Effect c)
-> R.Element
formChoiceSafe [] _ _ = H.div {} []
formChoiceSafe [n] _defaultNodeType setNodeType =
formButton n setNodeType
formChoiceSafe nodeTypes defaultNodeType setNodeType =
formChoice nodeTypes defaultNodeType setNodeType
-- | List Form
formChoice :: forall a b c d
. Read b
=> Show d
=> Array d
-> b
-> ((c -> b) -> Effect a)
-> R.Element
formChoice nodeTypes defaultNodeType setNodeType =
H.div { className: "form-group"}
[ R2.select { className: "form-control"
, onChange : mkEffectFn1
$ setNodeType
<<< const
<<< fromMaybe defaultNodeType
<<< read
<<< R2.unsafeEventValue
}
(map (\opt -> H.option {} [ H.text $ show opt ]) nodeTypes)
]
-- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall a b c
. a
-> ((b -> a) -> Effect c)
-> R.Element
formButton nodeType setNodeType =
H.button { className : "btn btn-primary center"
, type : "button"
, title: "Form Button"
, style : { width: "50%" }
, onClick : mkEffectFn1
$ \_ -> setNodeType ( const nodeType )
} [H.text $ "Go !"]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
H.button { className : "btn btn-primary fa fa-" <> icon action
, type: "button"
, style : { width: "50%" }
, id: S.toLower $ show action
, title: show action
, on: {click: \_ -> launchAff $ dispatch action}
}
[ H.text $ " " <> text action]
type Href = String
submitButtonHref :: Action -> Href -> R.Element
submitButtonHref action href =
H.a { className : "btn btn-primary fa fa-" <> icon action
, style : { width: "50%" }
, href
, target: "_blank"
}
[ H.text $ " " <> text action]
src/Gargantext/Components/Forest/Tree/Node/FTree.purs → src/Gargantext/Components/Forest/Tree/Node/Tools/FTree.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.FTree where module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Prelude hiding (div)
import Gargantext.Components.Lang (Lang)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Routes as GR
import Gargantext.Types as GT import Gargantext.Types as GT
import Prelude hiding (div)
----------------------------------------------------------------------- -----------------------------------------------------------------------
type ID = Int type ID = Int
......
src/Gargantext/Components/Forest/Tree/Node/ProgressBar.purs → src/Gargantext/Components/Forest/Tree/Node/Tools/ProgressBar.purs
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.ProgressBar where module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude import Gargantext.Prelude
...@@ -20,10 +20,8 @@ import Reactix.DOM.HTML as H ...@@ -20,10 +20,8 @@ import Reactix.DOM.HTML as H
data BarType = Bar | Pie data BarType = Bar | Pie
type Props = type Props =
( ( asyncTask :: GT.AsyncTaskWithType
asyncTask :: GT.AsyncTaskWithType
, barType :: BarType , barType :: BarType
, corpusId :: GT.ID , corpusId :: GT.ID
, onFinish :: Unit -> Effect Unit , onFinish :: Unit -> Effect Unit
...@@ -37,7 +35,11 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p [] ...@@ -37,7 +35,11 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
where where
cpt props@{asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}}), barType, corpusId, onFinish} _ = do cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
, barType
, corpusId
, onFinish
} _ = do
(progress /\ setProgress) <- R.useState' 0.0 (progress /\ setProgress) <- R.useState' 0.0
intervalIdRef <- R.useRef Nothing intervalIdRef <- R.useRef Nothing
...@@ -66,9 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt ...@@ -66,9 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
toInt n = unsafePartial $ fromJust $ fromNumber n toInt n = unsafePartial $ fromJust $ fromNumber n
type ProgressIndicatorProps = type ProgressIndicatorProps =
( ( barType :: BarType
barType :: BarType , label :: String
, label :: String
, progress :: Int , progress :: Int
) )
...@@ -97,7 +98,14 @@ progressIndicatorCpt = R.hooksComponent "G.C.F.T.N.PB.progressIndicator" cpt ...@@ -97,7 +98,14 @@ progressIndicatorCpt = R.hooksComponent "G.C.F.T.N.PB.progressIndicator" cpt
] ]
queryProgress :: Record Props -> Aff GT.AsyncProgress queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress {asyncTask: GT.AsyncTaskWithType {task: GT.AsyncTask {id}, typ}, corpusId, session} = get session p queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
, typ
}
, corpusId
, session
} = get session (p typ)
where where
p = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1" -- TODO refactor path
p GT.UpdateNode = NodeAPI GT.Node (Just corpusId) $ path <> id <> "/poll?limit=1"
p _ = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1"
path = GT.asyncTaskTypePath typ path = GT.asyncTaskTypePath typ
src/Gargantext/Components/Forest/Tree/Node/Tools/Sync.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Tools.Sync where
import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Effect.Class (liftEffect)
import Data.Tuple (fst)
import Reactix.DOM.HTML as H
import Reactix as R
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.NgramsTable.API as NTAPI
import Gargantext.Prelude (Unit, bind, const, discard, pure, unit, ($), (<>), (==))
import Gargantext.Types as GT
import Gargantext.Sessions (Session)
-- | Sync Node (Graph)
type NodeActionsGraphProps =
( id :: GT.ID
, graphVersions :: Record GraphAPI.GraphVersions
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element
nodeActionsGraph p = R.createElement nodeActionsGraphCpt p []
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsGraph" cpt
where
cpt { id, graphVersions, session, triggerRefresh } _ = do
pure $ H.div { className: "node-actions" } [
if graphVersions.gv_graph == Just graphVersions.gv_repo then
H.div {} []
else
graphUpdateButton { id, session, triggerRefresh }
]
type GraphUpdateButtonProps =
( id :: GT.ID
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
graphUpdateButton p = R.createElement graphUpdateButtonCpt p []
graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps
graphUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.graphUpdateButton" cpt
where
cpt { id, session, triggerRefresh } _ = do
enabled <- R.useState' true
pure $ H.div { className: "update-button "
<> if (fst enabled)
then "enabled"
else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
]
where
onClick (false /\ _) _ = pure unit
onClick (true /\ setEnabled) _ = do
launchAff_ $ do
liftEffect $ setEnabled $ const false
g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true
triggerRefresh unit
pure unit
-- | Sync Node (List)
type NodeActionsNodeListProps =
(
listId :: GT.ListId
, nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
nodeActionsNodeList p = R.createElement nodeActionsNodeListCpt p []
nodeActionsNodeListCpt :: R.Component NodeActionsNodeListProps
nodeActionsNodeListCpt = R.hooksComponent "G.C.F.T.N.B.nodeActionsNodeList" cpt
where
cpt props _ = do
pure $ H.div { className: "node-actions" } [
nodeListUpdateButton props
]
type NodeListUpdateButtonProps =
( listId :: GT.ListId
, nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, triggerRefresh :: Unit -> Aff Unit
)
nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element
nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p []
nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = R.hooksComponent "G.C.F.T.N.B.nodeListUpdateButton" cpt
where
cpt { listId, nodeId, nodeType, session, triggerRefresh } _ = do
enabled <- R.useState' true
pure $ H.div { className: "update-button "
<> if (fst enabled) then "enabled" else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
]
where
onClick (false /\ _) _ = pure unit
onClick (true /\ setEnabled) _ = do
launchAff_ $ do
liftEffect $ setEnabled $ const false
_ <- NTAPI.updateNodeList { listId, nodeId, nodeType, session }
liftEffect $ setEnabled $ const true
triggerRefresh unit
pure unit
src/Gargantext/Components/Forest/Tree/Node/Tools/Task.purs 0 → 100644
View file @ 0b03d8c1
module Gargantext.Components.Forest.Tree.Node.Tools.Task
where
import Data.Array as A
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Prelude (Unit, discard, identity, ($), (+))
import Gargantext.Types (Reload)
import Gargantext.Types as GT
import Reactix as R
type Tasks =
( onTaskAdd :: GT.AsyncTaskWithType -> Effect Unit
, onTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
, tasks :: Array GT.AsyncTaskWithType
)
tasksStruct :: Int
-> R.State GAT.Storage
-> R.State Reload
-> Record Tasks
tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) =
{ onTaskAdd, onTaskFinish, tasks }
where
tasks = maybe [] identity $ Map.lookup id asyncTasks
onTaskAdd t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe (Just [t])
$ (\ts -> Just $ A.cons t ts)) id
onTaskFinish t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe Nothing $ (\ts -> Just $ GAT.removeTaskFromList ts t)) id
src/Gargantext/Components/GraphExplorer/API.purs
View file @ 0b03d8c1
module Gargantext.Components.GraphExplorer.API where module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Effect (Effect) import Effect.Aff (Aff)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Prelude
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post) import Gargantext.Sessions (Session, get, post)
import Gargantext.Types as GT import Gargantext.Types as GT
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 0b03d8c1
...@@ -2,8 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -2,8 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar
(Props, sidebar) (Props, sidebar)
where where
import Prelude
import Control.Parallel (parTraverse) import Control.Parallel (parTraverse)
import Data.Array (head, last) import Data.Array (head, last)
import Data.Int (fromString) import Data.Int (fromString)
...@@ -16,22 +14,20 @@ import Data.Tuple.Nested ((/\)) ...@@ -16,22 +14,20 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words) import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe) import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType) import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
......
src/Gargantext/Components/Lang.purs
View file @ 0b03d8c1
...@@ -2,8 +2,7 @@ module Gargantext.Components.Lang where ...@@ -2,8 +2,7 @@ module Gargantext.Components.Lang where
import Data.Argonaut (class EncodeJson, encodeJson) import Data.Argonaut (class EncodeJson, encodeJson)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Show, show, class Read)
import Gargantext.Prelude (class Eq, class Show, show)
-- Language used for search -- Language used for search
allLangs :: Array Lang allLangs :: Array Lang
...@@ -16,23 +15,23 @@ allLangs = [ EN ...@@ -16,23 +15,23 @@ allLangs = [ EN
data Lang = FR | EN | Universal | No_extraction data Lang = FR | EN | Universal | No_extraction
instance showLang :: Show Lang where instance showLang :: Show Lang where
show FR = "FR" show FR = "FR"
show EN = "EN" show EN = "EN"
show Universal = "All" show Universal = "All"
show No_extraction = "Nothing" show No_extraction = "Nothing"
derive instance eqLang :: Eq Lang derive instance eqLang :: Eq Lang
readLang :: String -> Maybe Lang instance readLang :: Read Lang where
readLang "FR" = Just FR read "FR" = Just FR
readLang "EN" = Just EN read "EN" = Just EN
readLang "All" = Just Universal read "All" = Just Universal
readLang "Nothing" = Just No_extraction read "Nothing" = Just No_extraction
readLang _ = Nothing read _ = Nothing
instance encodeJsonLang :: EncodeJson Lang where instance encodeJsonLang :: EncodeJson Lang where
encodeJson a = encodeJson (show a) encodeJson a = encodeJson (show a)
-- Language used for the landing page -- Language used for the landing page
data LandingLang = LL_EN | LL_FR data LandingLang = LL_EN | LL_FR
src/Gargantext/Components/Login.purs
View file @ 0b03d8c1
...@@ -63,7 +63,7 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where ...@@ -63,7 +63,7 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.h2 {className: "text-primary center m-a-2"} [ H.h2 {className: "text-primary center m-a-2"}
[ [
-- H.i {className: "material-icons md-36"} [ H.text "control_point" ] -- H.i {className: "material-icons md-36"} [ H.text "control_point" ]
H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ] H.span {className: "icon-text"} [ H.text "GarganText" ] ] ]
closing = H.button { "type": "button", className: "close" closing = H.button { "type": "button", className: "close"
, "data": { dismiss: "modal" } } , "data": { dismiss: "modal" } }
...@@ -208,8 +208,10 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where ...@@ -208,8 +208,10 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
csrfTokenInput :: {} -> R.Element csrfTokenInput :: {} -> R.Element
csrfTokenInput _ = csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken" H.input { type: "hidden"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token , name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken
} -- TODO hard-coded CSRF token
termsCheckbox :: R.State Boolean -> R.Element termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox = termsCheckbox setCheckBox =
......
src/Gargantext/Components/NgramsTable.purs
View file @ 0b03d8c1
...@@ -22,24 +22,22 @@ import Data.Set as Set ...@@ -22,24 +22,22 @@ import Data.Set as Set
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||))
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner) import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Action(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatchR, convOrderBy, filterTermSize, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatchesR)
import Gargantext.Components.NgramsTable.Components as NTC import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatchR, convOrderBy, filterTermSize, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatchesR)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, readTermList, readTermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet) import Gargantext.Utils (queryMatchesLabel, toggleSet)
import Gargantext.Utils.List (sortWith) as L import Gargantext.Utils.List (sortWith) as L
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
type State' = type State' =
CoreState CoreState
...@@ -160,7 +158,7 @@ tableContainerCpt { dispatch ...@@ -160,7 +158,7 @@ tableContainerCpt { dispatch
[ R2.select { id: "picklistmenu" [ R2.select { id: "picklistmenu"
, className: "form-control custom-select" , className: "form-control custom-select"
, defaultValue: (maybe "" show termListFilter) , defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}} , on: {change: setTermListFilter <<< read <<< R2.unsafeEventValue}}
(map optps1 termLists)] (map optps1 termLists)]
] ]
, H.div {className: "col-md-2", style: {marginTop : "6px"}} , H.div {className: "col-md-2", style: {marginTop : "6px"}}
...@@ -168,7 +166,7 @@ tableContainerCpt { dispatch ...@@ -168,7 +166,7 @@ tableContainerCpt { dispatch
[ R2.select {id: "picktermtype" [ R2.select {id: "picktermtype"
, className: "form-control custom-select" , className: "form-control custom-select"
, defaultValue: (maybe "" show termSizeFilter) , defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}} , on: {change: setTermSizeFilter <<< read <<< R2.unsafeEventValue}}
(map optps1 termSizes)] (map optps1 termSizes)]
] ]
, H.div { className: "col-md-2", style: { marginTop: "6px" } } [ , H.div { className: "col-md-2", style: { marginTop: "6px" } } [
...@@ -226,19 +224,27 @@ tableContainerCpt { dispatch ...@@ -226,19 +224,27 @@ tableContainerCpt { dispatch
editor = H.div {} $ maybe [] f ngramsParent editor = H.div {} $ maybe [] f ngramsParent
where where
f ngrams = [ f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
H.p {} [H.text $ "Editing " <> ngramsTermText ngrams] , NTC.renderNgramsTree { ngramsTable
, NTC.renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit } , ngrams
, H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"] , ngramsStyle: []
, H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"] , ngramsClick
] , ngramsEdit
}
, H.button { className: "btn btn-primary"
, on: {click: (const $ dispatch AddTermChildren)}
} [H.text "Save"]
, H.button { className: "btn btn-secondary"
, on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
} [H.text "Cancel"]
]
where where
ngramsTable = ngramsTableCache # at ngrams ngramsTable = ngramsTableCache # at ngrams
<<< _Just <<< _Just
<<< _NgramsElement <<< _NgramsElement
<<< _children <<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren) %~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild true child ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing ngramsClick _ = Nothing
ngramsEdit _ = Nothing ngramsEdit _ = Nothing
......
src/Gargantext/Components/NgramsTable/API.purs
View file @ 0b03d8c1
module Gargantext.Components.NgramsTable.API where module Gargantext.Components.NgramsTable.API where
import Gargantext.Prelude import Effect.Aff (Aff)
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post) import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT import Gargantext.Types as GT
type UpdateNodeListParams = type UpdateNodeListParams =
......
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @ 0b03d8c1
...@@ -2,19 +2,20 @@ module Gargantext.Components.Nodes.Corpus.Chart.Predefined where ...@@ -2,19 +2,20 @@ module Gargantext.Components.Nodes.Corpus.Chart.Predefined where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Reactix as R import Reactix as R
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Prelude
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType) import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
import Reactix as R
data PredefinedChart = data PredefinedChart =
...@@ -23,24 +24,29 @@ data PredefinedChart = ...@@ -23,24 +24,29 @@ data PredefinedChart =
| CInstitutesTree | CInstitutesTree
| CTermsMetrics | CTermsMetrics
derive instance genericPredefinedChart :: Generic PredefinedChart _ derive instance genericPredefinedChart :: Generic PredefinedChart _
instance showPredefinedChart :: Show PredefinedChart where instance showPredefinedChart :: Show PredefinedChart where
show = genericShow show = genericShow
derive instance eqPredefinedChart :: Eq PredefinedChart derive instance eqPredefinedChart :: Eq PredefinedChart
instance ordPredefinedChart :: Ord PredefinedChart where instance ordPredefinedChart :: Ord PredefinedChart where
compare = genericCompare compare = genericCompare
instance decodePredefinedChart :: DecodeJson PredefinedChart where instance decodePredefinedChart :: DecodeJson PredefinedChart where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
pure $ readChart' obj pure $ fromMaybe CDocsHistogram $ read obj
instance encodePredefinedChart :: EncodeJson PredefinedChart where instance encodePredefinedChart :: EncodeJson PredefinedChart where
encodeJson c = encodeJson $ show c encodeJson c = encodeJson $ show c
readChart' :: String -> PredefinedChart instance readPredefinedChart :: Read PredefinedChart where
readChart' "CDocsHistogram" = CDocsHistogram read "CDocsHistogram" = Just CDocsHistogram
readChart' "CAuthorsPie" = CAuthorsPie read "CAuthorsPie" = Just CAuthorsPie
readChart' "CInstitutesTree" = CInstitutesTree read "CInstitutesTree" = Just CInstitutesTree
readChart' "CTermsMetrics" = CTermsMetrics read "CTermsMetrics" = Just CTermsMetrics
readChart' _ = CDocsHistogram read _ = Nothing
allPredefinedCharts :: Array PredefinedChart allPredefinedCharts :: Array PredefinedChart
......
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @ 0b03d8c1
module Gargantext.Components.Nodes.Corpus.Dashboard where module Gargantext.Components.Nodes.Corpus.Dashboard where
import DOM.Simple.Console (log2)
import Data.Array as A import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Prelude
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID) import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props = type Props =
( ( nodeId :: NodeID
nodeId :: NodeID
, session :: Session , session :: Session
) )
...@@ -49,12 +45,11 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt ...@@ -49,12 +45,11 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
where where
onChange :: NodeID -> R.State Int -> DT.Hyperdata -> Array P.PredefinedChart -> Effect Unit onChange :: NodeID -> R.State Int -> DT.Hyperdata -> Array P.PredefinedChart -> Effect Unit
onChange nodeId (_ /\ setReload) (DT.Hyperdata h) charts = do onChange nodeId' (_ /\ setReload) (DT.Hyperdata h) charts = do
launchAff_ do launchAff_ do
DT.saveDashboard { DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts }
hyperdata: DT.Hyperdata $ h { charts = charts } , nodeId:nodeId'
, nodeId , session }
, session }
liftEffect $ setReload $ (+) 1 liftEffect $ setReload $ (+) 1
type LoadedProps = type LoadedProps =
...@@ -127,7 +122,7 @@ renderChartCpt = R.hooksComponent "G.C.N.C.D.renderChart" cpt ...@@ -127,7 +122,7 @@ renderChartCpt = R.hooksComponent "G.C.N.C.D.renderChart" cpt
where where
option pc = option pc =
H.option { value: show pc } [ H.text $ show pc ] H.option { value: show pc } [ H.text $ show pc ]
onSelectChange e = onChange $ P.readChart' value onSelectChange e = onChange $ fromMaybe P.CDocsHistogram $ read value
where where
value = R2.unsafeEventValue e value = R2.unsafeEventValue e
onRemoveClick _ = onRemove unit onRemoveClick _ = onRemove unit
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ 0b03d8c1
module Gargantext.Components.Nodes.Corpus.Types where module Gargantext.Components.Nodes.Corpus.Types where
import Data.Maybe (Maybe(..)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject) import Data.List as List
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List ((:)) import Data.Maybe (Maybe(..))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly) import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Prelude
type Author = String type Author = String
type Description = String type Description = String
...@@ -25,47 +20,47 @@ type MarkdownText = String ...@@ -25,47 +20,47 @@ type MarkdownText = String
type Hash = String type Hash = String
newtype Hyperdata = newtype Hyperdata =
Hyperdata Hyperdata { fields :: List.List FTField }
{
fields :: List.List FTField
}
instance decodeHyperdata :: DecodeJson Hyperdata where instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
fields <- obj .: "fields" fields <- obj .: "fields"
pure $ Hyperdata {fields} pure $ Hyperdata {fields}
instance encodeHyperdata :: EncodeJson Hyperdata where instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {fields}) = do encodeJson (Hyperdata {fields}) = do
"fields" := fields "fields" := fields
~> jsonEmptyObject ~> jsonEmptyObject
newtype Field a = Field { newtype Field a =
name :: String Field { name :: String
, typ :: a , typ :: a
} }
type FTField = Field FieldType type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _ derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where instance eqFTField :: Eq (Field FieldType) where
eq = genericEq eq = genericEq
instance showFTField :: Show (Field FieldType) where instance showFTField :: Show (Field FieldType) where
show = genericShow show = genericShow
data FieldType = data FieldType =
Haskell { Haskell { haskell :: HaskellCode
haskell :: HaskellCode , tag :: Tag
, tag :: Tag }
} | JSON { authors :: Author
| JSON { , desc :: Description
authors :: Author , query :: Query
, desc :: Description , tag :: Tag
, query :: Query , title :: Title
, tag :: Tag }
, title :: Title | Markdown { tag :: Tag
} , text :: MarkdownText
| Markdown { }
tag :: Tag
, text :: MarkdownText
}
isJSON :: FTField -> Boolean isJSON :: FTField -> Boolean
...@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of ...@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of
} }
derive instance genericFieldType :: Generic FieldType _ derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where instance eqFieldType :: Eq FieldType where
eq = genericEq eq = genericEq
instance showFieldType :: Show FieldType where instance showFieldType :: Show FieldType where
show = genericShow show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
...@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where ...@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Markdown {tag, text} pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_ _ -> Left $ "Unsupported 'type' " <> type_
pure $ Field {name, typ} pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) = encodeJson (Field {name, typ}) =
"data" := typ "data" := typ
...@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where ...@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (Haskell _) = "Haskell" typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON" typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown" typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) = encodeJson (Haskell {haskell}) =
"haskell" := haskell "haskell" := haskell
...@@ -146,42 +146,51 @@ instance encodeFieldType :: EncodeJson FieldType where ...@@ -146,42 +146,51 @@ instance encodeFieldType :: EncodeJson FieldType where
~> jsonEmptyObject ~> jsonEmptyObject
defaultHaskell :: FieldType defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell' defaultHaskell = Haskell defaultHaskell'
defaultHaskell' = {
haskell: "" defaultHaskell' :: { haskell :: String, tag :: String }
, tag: "HaskellField" defaultHaskell' = { haskell: ""
} , tag : "HaskellField"
}
defaultJSON :: FieldType defaultJSON :: FieldType
defaultJSON = JSON defaultJSON' defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
, desc: "" defaultJSON' :: { authors :: String
, query: "" , desc :: String
, tag: "JSONField" , query :: String
, title: "" , tag :: String
} , title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown' defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = { defaultMarkdown' :: { tag :: String
tag: "MarkdownField" , text :: String
, text: "# New file" }
} defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField defaultField :: FTField
defaultField = Field { defaultField = Field { name: "New file"
name: "New file" , typ: defaultMarkdown
, typ: defaultMarkdown }
}
newtype CorpusInfo = newtype CorpusInfo =
CorpusInfo CorpusInfo { title :: String
{ title :: String , authors :: String
, authors :: String , desc :: String
, desc :: String , query :: String
, query :: String , totalRecords :: Int
, totalRecords :: Int } }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do decodeJson json = do
......
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @ 0b03d8c1
module Gargantext.Components.Nodes.Dashboard.Types where module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
......
src/Gargantext/Config/REST.purs
View file @ 0b03d8c1
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded, string) import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded)
import Affjax.RequestHeader as ARH import Affjax.RequestHeader as ARH
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log) import DOM.Simple.Console (log)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded import Data.FormURLEncoded as FormURLEncoded
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple)
import Effect.Aff (Aff, throwError) import Effect.Aff (Aff, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Web.XHR.FormData as XHRFormData
type Token = String type Token = String
......
src/Gargantext/Prelude.purs
View file @ 0b03d8c1
module Gargantext.Prelude (module Prelude, logs) module Gargantext.Prelude (module Prelude, logs, id, class Read, read)
where where
import Data.Maybe (Maybe)
import Prelude (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, bottom, clamp, compare, comparing, compose, conj, const, degree, discard, disj, eq, flap, flip, gcd, identity, ifM, join, lcm, liftA1, liftM1, map, max, mempty, min, mod, mul, negate, not, notEq, one, otherwise, pure, recip, show, sub, top, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||)) import Prelude (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, bottom, clamp, compare, comparing, compose, conj, const, degree, discard, disj, eq, flap, flip, gcd, identity, ifM, join, lcm, liftA1, liftM1, map, max, mempty, min, mod, mul, negate, not, notEq, one, otherwise, pure, recip, show, sub, top, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||))
import Effect.Console (log) import Effect.Console (log)
import Effect.Class (class MonadEffect, liftEffect) import Effect.Class (class MonadEffect, liftEffect)
-- | JL: Astonishingly, not in the prelude
-- AD: recent Preludes in Haskell much prefer identity
-- then id can be used as a variable name (in records for instance)
-- since records in Purescript are not the same as in Haskell
-- this behavior is questionable indeed.
id :: forall a. a -> a
id a = a
class Read a where
read :: String -> Maybe a
logs:: forall message effect. logs:: forall message effect.
(MonadEffect effect) (MonadEffect effect)
=> Show message => Show message
...@@ -13,3 +25,5 @@ logs:: forall message effect. ...@@ -13,3 +25,5 @@ logs:: forall message effect.
-> effect Unit -> effect Unit
logs = liftEffect <<< log <<< show logs = liftEffect <<< log <<< show
src/Gargantext/Types.purs
View file @ 0b03d8c1
module Gargantext.Types where module Gargantext.Types where
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array as A import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
...@@ -10,8 +8,10 @@ import Data.Generic.Rep.Eq (genericEq) ...@@ -10,8 +8,10 @@ import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Prelude (class Read, read)
import Prelude
import Prim.Row (class Union) import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
...@@ -44,10 +44,11 @@ instance showTermSize :: Show TermSize where ...@@ -44,10 +44,11 @@ instance showTermSize :: Show TermSize where
show MonoTerm = "MonoTerm" show MonoTerm = "MonoTerm"
show MultiTerm = "MultiTerm" show MultiTerm = "MultiTerm"
readTermSize :: String -> Maybe TermSize instance readTermSize :: Read TermSize where
readTermSize "MonoTerm" = Just MonoTerm read :: String -> Maybe TermSize
readTermSize "MultiTerm" = Just MultiTerm read "MonoTerm" = Just MonoTerm
readTermSize _ = Nothing read "MultiTerm" = Just MultiTerm
read _ = Nothing
termSizes :: Array { desc :: String, mval :: Maybe TermSize } termSizes :: Array { desc :: String, mval :: Maybe TermSize }
termSizes = [ { desc: "All types", mval: Nothing } termSizes = [ { desc: "All types", mval: Nothing }
...@@ -93,11 +94,12 @@ termListName GraphTerm = "Map List" ...@@ -93,11 +94,12 @@ termListName GraphTerm = "Map List"
termListName StopTerm = "Stop List" termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List" termListName CandidateTerm = "Candidate List"
readTermList :: String -> Maybe TermList instance readTermList :: Read TermList where
readTermList "GraphTerm" = Just GraphTerm read :: String -> Maybe TermList
readTermList "StopTerm" = Just StopTerm read "GraphTerm" = Just GraphTerm
readTermList "CandidateTerm" = Just CandidateTerm read "StopTerm" = Just StopTerm
readTermList _ = Nothing read "CandidateTerm" = Just CandidateTerm
read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList } termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing } termLists = [ { desc: "All terms", mval: Nothing }
...@@ -176,30 +178,28 @@ instance showNodeType :: Show NodeType where ...@@ -176,30 +178,28 @@ instance showNodeType :: Show NodeType where
show NodeList = "NodeList" show NodeList = "NodeList"
show Texts = "NodeTexts" show Texts = "NodeTexts"
readNodeType :: String -> NodeType instance readNodeType :: Read NodeType where
readNodeType "NodeUser" = NodeUser read "NodeUser" = Just NodeUser
read "NodeFolder" = Just Folder
readNodeType "NodeFolder" = Folder read "NodeFolderPrivate" = Just FolderPrivate
readNodeType "NodeFolderPrivate" = FolderPrivate read "NodeFolderShared" = Just FolderShared
readNodeType "NodeFolderShared" = FolderShared read "NodeFolderPublic" = Just FolderPublic
readNodeType "NodeFolderPublic" = FolderPublic read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
readNodeType "NodeAnnuaire" = Annuaire read "Document" = Just Url_Document
readNodeType "NodeDashboard" = Dashboard read "NodeGraph" = Just Graph
readNodeType "Document" = Url_Document read "NodePhylo" = Just Phylo
readNodeType "NodeGraph" = Graph read "Individu" = Just Individu
readNodeType "NodePhylo" = Phylo read "Node" = Just Node
readNodeType "Individu" = Individu read "Nodes" = Just Nodes
readNodeType "Node" = Node read "NodeCorpus" = Just Corpus
readNodeType "Nodes" = Nodes read "NodeContact" = Just NodeContact
readNodeType "NodeCorpus" = Corpus read "Tree" = Just Tree
readNodeType "NodeContact" = NodeContact read "NodeTeam" = Just Team
readNodeType "Tree" = Tree read "NodeList" = Just NodeList
readNodeType "NodeTeam" = Team read "NodeTexts" = Just Texts
readNodeType "NodeList" = NodeList read "Annuaire" = Just Annuaire
readNodeType "NodeTexts" = Texts read _ = Nothing
readNodeType "Annuaire" = Annuaire
readNodeType _ = Error
fldr :: NodeType -> Boolean -> String fldr :: NodeType -> Boolean -> String
...@@ -254,7 +254,7 @@ instance eqNodeType :: Eq NodeType where ...@@ -254,7 +254,7 @@ instance eqNodeType :: Eq NodeType where
instance decodeJsonNodeType :: DecodeJson NodeType where instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
pure $ readNodeType obj pure $ fromMaybe Error $ read obj
instance encodeJsonNodeType :: EncodeJson NodeType where instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType encodeJson nodeType = encodeJson $ show nodeType
...@@ -449,7 +449,10 @@ instance showTabType :: Show TabType where ...@@ -449,7 +449,10 @@ instance showTabType :: Show TabType where
type TableResult a = {count :: Int, docs :: Array a} type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a) type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms data Mode = Authors
| Sources
| Institutes
| Terms
derive instance genericMode :: Generic Mode _ derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where instance showMode :: Show Mode where
...@@ -480,6 +483,8 @@ data AsyncTaskType = Form ...@@ -480,6 +483,8 @@ data AsyncTaskType = Form
| GraphT | GraphT
| Query | Query
| AddNode | AddNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _ derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where instance eqAsyncTaskType :: Eq AsyncTaskType where
eq = genericEq eq = genericEq
...@@ -502,35 +507,47 @@ asyncTaskTypePath Form = "add/form/async/" ...@@ -502,35 +507,47 @@ asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/" asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/"
type AsyncTaskID = String type AsyncTaskID = String
data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed data AsyncTaskStatus = Running
| Pending
| Received
| Started
| Failed
| Finished
| Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _ derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
instance showAsyncTaskStatus :: Show AsyncTaskStatus where instance showAsyncTaskStatus :: Show AsyncTaskStatus where
show = genericShow show = genericShow
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where
encodeJson s = encodeJson $ show s encodeJson s = encodeJson $ show s
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
pure $ readAsyncTaskStatus obj pure $ fromMaybe Running $ read obj
readAsyncTaskStatus :: String -> AsyncTaskStatus instance readAsyncTaskStatus :: Read AsyncTaskStatus where
readAsyncTaskStatus "IsFailure" = Failed read "IsFailure" = Just Failed
readAsyncTaskStatus "IsFinished" = Finished read "IsFinished" = Just Finished
readAsyncTaskStatus "IsKilled" = Killed read "IsKilled" = Just Killed
readAsyncTaskStatus "IsPending" = Pending read "IsPending" = Just Pending
readAsyncTaskStatus "IsReceived" = Received read "IsReceived" = Just Received
readAsyncTaskStatus "IsRunning" = Running read "IsRunning" = Just Running
readAsyncTaskStatus "IsStarted" = Started read "IsStarted" = Just Started
readAsyncTaskStatus _ = Running read _ = Nothing
newtype AsyncTask = AsyncTask { newtype AsyncTask =
id :: AsyncTaskID AsyncTask { id :: AsyncTaskID
, status :: AsyncTaskStatus , status :: AsyncTaskStatus
} }
derive instance genericAsyncTask :: Generic AsyncTask _ derive instance genericAsyncTask :: Generic AsyncTask _
instance eqAsyncTask :: Eq AsyncTask where instance eqAsyncTask :: Eq AsyncTask where
eq = genericEq eq = genericEq
...@@ -541,8 +558,8 @@ instance encodeJsonAsyncTask :: EncodeJson AsyncTask where ...@@ -541,8 +558,8 @@ instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
~> jsonEmptyObject ~> jsonEmptyObject
instance decodeJsonAsyncTask :: DecodeJson AsyncTask where instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id <- obj .: "id" id <- obj .: "id"
status <- obj .: "status" status <- obj .: "status"
pure $ AsyncTask { id, status } pure $ AsyncTask { id, status }
...@@ -560,9 +577,9 @@ instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where ...@@ -560,9 +577,9 @@ instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
~> jsonEmptyObject ~> jsonEmptyObject
instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
task <- obj .: "task" task <- obj .: "task"
typ <- obj .: "typ" typ <- obj .: "typ"
pure $ AsyncTaskWithType { task, typ } pure $ AsyncTaskWithType { task, typ }
newtype AsyncProgress = AsyncProgress { newtype AsyncProgress = AsyncProgress {
...@@ -573,9 +590,9 @@ newtype AsyncProgress = AsyncProgress { ...@@ -573,9 +590,9 @@ newtype AsyncProgress = AsyncProgress {
derive instance genericAsyncProgress :: Generic AsyncProgress _ derive instance genericAsyncProgress :: Generic AsyncProgress _
instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id <- obj .: "id" id <- obj .: "id"
log <- obj .: "log" log <- obj .: "log"
status <- obj .: "status" status <- obj .: "status"
pure $ AsyncProgress {id, log, status} pure $ AsyncProgress {id, log, status}
...@@ -588,9 +605,9 @@ newtype AsyncTaskLog = AsyncTaskLog { ...@@ -588,9 +605,9 @@ newtype AsyncTaskLog = AsyncTaskLog {
derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _ derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
events <- obj .: "events" events <- obj .: "events"
failed <- obj .: "failed" failed <- obj .: "failed"
remaining <- obj .: "remaining" remaining <- obj .: "remaining"
succeeded <- obj .: "succeeded" succeeded <- obj .: "succeeded"
pure $ AsyncTaskLog {events, failed, remaining, succeeded} pure $ AsyncTaskLog {events, failed, remaining, succeeded}
......
src/Gargantext/Utils.purs
View file @ 0b03d8c1
...@@ -7,9 +7,9 @@ import Data.Set as Set ...@@ -7,9 +7,9 @@ import Data.Set as Set
import Data.Set (Set) import Data.Set (Set)
import Data.String as S import Data.String as S
-- | Astonishingly, not in the prelude -- | TODO (hard coded)
id :: forall a. a -> a csrfMiddlewareToken :: String
id a = a csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
setterv :: forall nt record field. setterv :: forall nt record field.
Newtype nt record Newtype nt record
...@@ -45,15 +45,12 @@ invertOrdering LT = GT ...@@ -45,15 +45,12 @@ invertOrdering LT = GT
invertOrdering GT = LT invertOrdering GT = LT
invertOrdering EQ = EQ invertOrdering EQ = EQ
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
-- A lens that always returns unit -- A lens that always returns unit
_unit :: forall s. Lens' s Unit _unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s) _unit = lens (\_ -> unit) (\s _ -> s)
glyphicon :: String -> String glyphicon :: String -> String
glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t glyphicon t = "btn glyphitem fa fa-" <> t
glyphiconActive :: String -> Boolean -> String glyphiconActive :: String -> Boolean -> String
glyphiconActive icon b = glyphicon icon <> if b then " active" else "" glyphiconActive icon b = glyphicon icon <> if b then " active" else ""
......
src/Gargantext/Utils/Argonaut.purs
View file @ 0b03d8c1
...@@ -5,7 +5,7 @@ import Prelude ...@@ -5,7 +5,7 @@ import Prelude
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Argonaut (Json) import Data.Argonaut (Json)
import Data.Argonaut as Argonaut import Data.Argonaut as Argonaut
import Data.Either (Either) import Data.Either (Either(..))
import Data.Generic.Rep as GR import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
...@@ -56,6 +56,11 @@ instance genericSumDecodeJsonRepConstructor :: ...@@ -56,6 +56,11 @@ instance genericSumDecodeJsonRepConstructor ::
argument <- genericSumDecodeJsonRep inner argument <- genericSumDecodeJsonRep inner
pure $ GR.Constructor argument pure $ GR.Constructor argument
instance genericSumDecodeJsonRepNoArguments ::
GenericSumDecodeJsonRep (GR.NoArguments) where
genericSumDecodeJsonRep _ = do
pure GR.NoArguments
instance genericSumDecodeJsonRepArgument :: instance genericSumDecodeJsonRepArgument ::
( Argonaut.DecodeJson a ( Argonaut.DecodeJson a
) => GenericSumDecodeJsonRep (GR.Argument a) where ) => GenericSumDecodeJsonRep (GR.Argument a) where
...@@ -79,7 +84,66 @@ instance genericSumEncodeJsonRepConstructor :: ...@@ -79,7 +84,66 @@ instance genericSumEncodeJsonRepConstructor ::
let argument = genericSumEncodeJsonRep inner let argument = genericSumEncodeJsonRep inner
Argonaut.jsonSingletonObject name argument Argonaut.jsonSingletonObject name argument
instance genericSumEncodeJsonRepNoArguments ::
GenericSumEncodeJsonRep GR.NoArguments where
genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull
instance genericSumEncodeJsonRepArgument :: instance genericSumEncodeJsonRepArgument ::
( Argonaut.EncodeJson a ( Argonaut.EncodeJson a
) => GenericSumEncodeJsonRep (GR.Argument a) where ) => GenericSumEncodeJsonRep (GR.Argument a) where
genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f
genericEnumDecodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumDecodeJson rep
=> Json
-> Either String a
genericEnumDecodeJson f =
GR.to <$> genericEnumDecodeJsonRep f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumDecodeJson rep where
genericEnumDecodeJsonRep :: Json -> Either String rep
instance sumEnumDecodeJsonRep ::
( GenericEnumDecodeJson a
, GenericEnumDecodeJson b
) => GenericEnumDecodeJson (GR.Sum a b) where
genericEnumDecodeJsonRep f
= GR.Inl <$> genericEnumDecodeJsonRep f
<|> GR.Inr <$> genericEnumDecodeJsonRep f
instance constructorEnumSumRep ::
( IsSymbol name
) => GenericEnumDecodeJson (GR.Constructor name GR.NoArguments) where
genericEnumDecodeJsonRep f = do
s <- Argonaut.decodeJson f
if s == name
then pure $ GR.Constructor GR.NoArguments
else Left $ "Enum string " <> s <> " did not match expected string " <> name
where
name = reflectSymbol (SProxy :: SProxy name)
genericEnumEncodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumEncodeJson rep
=> a
-> Json
genericEnumEncodeJson f =
genericEnumEncodeJsonRep $ GR.from f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumEncodeJson rep where
genericEnumEncodeJsonRep :: rep -> Json
instance sumGenericEnumEncodeJson ::
( GenericEnumEncodeJson a
, GenericEnumEncodeJson b
) => GenericEnumEncodeJson (GR.Sum a b) where
genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x
instance constructorGenericEnumEncodeJson ::
( IsSymbol name
) => GenericEnumEncodeJson (GR.Constructor name GR.NoArguments) where
genericEnumEncodeJsonRep _ = Argonaut.encodeJson $ reflectSymbol (SProxy :: SProxy name)
src/Gargantext/Utils/Popover.purs
View file @ 0b03d8c1
module Gargantext.Utils.Popover where module Gargantext.Utils.Popover where
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (maybe)
import Data.Nullable (Nullable, toMaybe) import Data.Nullable (Nullable, toMaybe)
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2) import Effect.Uncurried (EffectFn2, runEffectFn2)
import FFI.Simple ((..), (...))
import Reactix as R import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
......
test/Gargantext/Utils/Spec.purs
View file @ 0b03d8c1
...@@ -7,7 +7,7 @@ import Data.Either (Either(..), isLeft) ...@@ -7,7 +7,7 @@ import Data.Either (Either(..), isLeft)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson) import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Crypto as GUC import Gargantext.Utils.Crypto as GUC
import Gargantext.Utils.Math as GUM import Gargantext.Utils.Math as GUM
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
...@@ -27,6 +27,20 @@ instance decodeJsonFruit :: Argonaut.DecodeJson Fruit where ...@@ -27,6 +27,20 @@ instance decodeJsonFruit :: Argonaut.DecodeJson Fruit where
instance encodeJsonFruit :: Argonaut.EncodeJson Fruit where instance encodeJsonFruit :: Argonaut.EncodeJson Fruit where
encodeJson = genericSumEncodeJson encodeJson = genericSumEncodeJson
data EnumTest
= Member1
| Member2
| Member3
derive instance eqEnumTest :: Eq EnumTest
derive instance genericEnumTest :: Generic EnumTest _
instance showEnumTest :: Show EnumTest where
show = genericShow
instance decodeJsonEnumTest :: Argonaut.DecodeJson EnumTest where
decodeJson = genericEnumDecodeJson
instance encodeJsonEnumTest :: Argonaut.EncodeJson EnumTest where
encodeJson = genericEnumEncodeJson
spec :: Spec Unit spec :: Spec Unit
spec = spec =
describe "G.Utils" do describe "G.Utils" do
...@@ -76,3 +90,26 @@ spec = ...@@ -76,3 +90,26 @@ spec =
let result2' = Argonaut.decodeJson result2 let result2' = Argonaut.decodeJson result2
Argonaut.stringify result2 `shouldEqual` """{"Gravy":"hi"}""" Argonaut.stringify result2 `shouldEqual` """{"Gravy":"hi"}"""
result2' `shouldEqual` Right input2 result2' `shouldEqual` Right input2
it "genericEnumDecodeJson works" do
let result1 = Argonaut.decodeJson =<< Argonaut.jsonParser "\"Member1\""
result1 `shouldEqual` Right Member1
let result2 = Argonaut.decodeJson =<< Argonaut.jsonParser "\"Member2\""
result2 `shouldEqual` Right Member2
let result3 = Argonaut.decodeJson =<< Argonaut.jsonParser "\"Failure\""
isLeft (result3 :: Either String EnumTest) `shouldEqual` true
it "genericSumEncodeJson works and loops back with decode" do
let input1 = Member1
let result1 = Argonaut.encodeJson input1
let result1' = Argonaut.decodeJson result1
Argonaut.stringify result1 `shouldEqual` "\"Member1\""
result1' `shouldEqual` Right input1
let input2 = Member2
let result2 = Argonaut.encodeJson input2
let result2' = Argonaut.decodeJson result2
Argonaut.stringify result2 `shouldEqual` "\"Member2\""
result2' `shouldEqual` Right input2
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