Commit 0b03d8c1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-list-charts

parents 16364b1e 8c872d4b
......@@ -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
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+)
* Yarn (Recent)
* A webserver (anything that can serve a static directory will do)
#### NodeJS Installation
### NodeJS
On debian testing, debian unstable or ubuntu:
......@@ -37,32 +36,28 @@ curl -sL https://deb.nodesource.com/setup_11.x | sudo bash -
sudo apt update && sudo apt install nodejs
```
(For Ubuntu)
```shell
curl -sS https://dl.yarnpkg.com/debian/pubkey.gpg | sudo apt-key add -
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)
<!-- TODO: wtf is all this sudo? -->
<!-- To upgrade to latest version (and not current stable) version, you can -->
<!-- use the `n` module from npm to upgrade node: -->
```shell
sudo npm cache clean -f
sudo npm install -g n
sudo n stable
sudo n latest
```
<!-- ```shell -->
<!-- sudo npm cache clean -f -->
<!-- sudo npm install -g n -->
<!-- sudo n stable -->
<!-- sudo n latest -->
<!-- ``` -->
On Mac OS X with homebrew:
### OSX
```shell
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
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
sudo apt update && sudo apt install yarn
```
On Mac OS (with Homebrew):
On Mac OS X with homebrew:
```shell
brew install yarn
```
#### Webservers
Some options:
For other platforms, please refer to [the yarn website](https://www.yarnpkg.com/).
* The `python3` builtin webserver
* Caddy
### Purescript and Javascript dependencies
## Development
Once you have node and yarn installed, you may install deps with:
```shell
yarn install && yarn add psc-package && yarn install-ps && yarn build
```
You need to copy index.html:
```shell
cp src/index.html dist/
yarn install -D && yarn install-ps
```
(Be careful, to update or upgrade your install, maybe you need to remove
old files in node_modules).
### Development
You can compile the purescript code with:
You will likely want to check your work in a browser. We provide a
local development webserver that serves on port 5000 for this purpose:
```shell
yarn compile
yarn server
```
Or run a repl:
To generate a new browser bundle to test:
```shell
yarn repl
```
```shell
yarn install && yarn ps-deps
yarn build
```
### Running a dev server
If you are rapidly iterating and just want to type check your code:
```shell
yarn dev
```
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.
yarn compile
```
#### Purescript IDE integration
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
You may access a purescript repl if you want to explore:
```shell
yarn repl
```
### Compiling styles
We use the `sass` compiler for some of the style files. To convert them to CSS do:
If you need to reinstall dependencies such as after a git pull or branch switch:
```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
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.
Examples:
```shell
yarn sass
```
* `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 -->
<!-- yarn live -->
<!-- ``` -->
### Note to contributors
Note that a production build takes a little while.
Please follow CONTRIBUTING.md
### How do I?
......@@ -194,12 +153,6 @@ endConfig' v = { front : frontRelative
, back : backDemo v }
```
## Note to the contributors
Please follow CONTRIBUTING.md
### How do I?
#### Add a javascript dependency?
Add it to `package.json`, under `dependencies` if it is needed at
......@@ -288,10 +241,9 @@ bigram/2-gram
: A two-word n-gram, e.g. `coffee cup`
trigram/3-gram
: A three-word n-gram, e.g. `coffee cup holder`
<!-- skip-grams are not yet supported -->
<!-- skip-gram -->
<!-- : An n-gram where the words are not all adjacent -->
<!-- k-skip-n-gram -->
<!-- : An n-gram where the words are at most distance k from each other -->
skip-gram
: An n-gram where the words are not all adjacent. Not yet supported.
k-skip-n-gram
: An n-gram where the words are at most distance k from each other.
......@@ -78,9 +78,10 @@ li#rename #rename-a {
background-color: white;
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);
box-shadow: 0 2px 5px rgba(0, 0, 0, 0.2);
height: 600px;
width: 1300px;
}
......
......@@ -70,9 +70,10 @@ li#rename
justify-content: center
background-color: white
border: none
.istex-search.panel
.frame-search.panel
border: 1px solid rgba(0,0,0,0.2)
box-shadow: 0 2px 5px rgba(0,0,0,0.2)
height: 600px
width: 1300px
......
{
"name": "Gargantext",
"version": "0.0.1.5.1",
"version": "0.0.1.5.2",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......@@ -14,7 +14,7 @@
"clean-js": "rm -Rf node_modules",
"clean-ps": "rm -Rf output",
"test": "pulp test",
"start": "serve dist"
"server": "serve dist"
},
"dependencies": {
"create-react-class": "^15.6.3",
......
module Gargantext.AsyncTasks where
import Data.Argonaut (decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut (decodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
......
......@@ -34,7 +34,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
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
......
......@@ -33,27 +33,45 @@ forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
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 (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do
pure $ R.fragment $ A.cons (plus showLogin) trees
where
trees = tree <$> unSessions sessions
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 showLogin =
H.button {on: {click}, className: "btn btn-primary"}
[ H.div { "type": "", className: "fa fa-universal-access fa-lg"} [H.text " Log "]
, H.div {} [H.text " "]
H.button { on: {click}
, className: "btn btn-primary"
}
[ 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-minus-circle fa-lg"} []
]
]
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
......
This diff is collapsed.
module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
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.Maybe (Maybe)
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.Prelude (class Show, Unit)
import Gargantext.Sessions (Session)
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
| UpdateNode GT.AsyncTaskWithType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| RenameNode String
| UpdateNode UpdateNodeParams
| ShareNode String
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| DownloadNode
| RefreshTree
-----------------------------------------------------
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> GT.ID -> Aff GT.ID
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-----------------------------------------------------------------------
instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode"
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 =
( dispatch :: Action -> Aff Unit
......@@ -35,18 +48,27 @@ type Props =
, nodeType :: GT.NodeType
, 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
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
newtype UploadFileContents = UploadFileContents String
text :: Action -> String
text (AddNode _ _ )= "Add !"
text DeleteNode = "Delete !"
text (RenameNode _ )= "Rename !"
text (UpdateNode _ )= "Update !"
text (ShareNode _ )= "Share !"
text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
-----------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Data.Array (length, head)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array (head)
import Data.Maybe (Maybe(..), fromMaybe)
-- import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Types (NodeType(..), readNodeType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, formEdit, formChoiceSafe, panel)
import Gargantext.Prelude (Unit, bind, pure, show, ($), (<>))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
import Gargantext.Types (NodeType(..))
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -23,9 +21,9 @@ addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> GT.ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
-> GT.ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
......@@ -57,77 +55,23 @@ type CreateNodeProps =
)
addNodeView :: Record CreateNodeProps
-> R.Element
-> R.Element
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' "Name"
nodeType' <- 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
)
} []
]
nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe NodeUser $ 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
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"]
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode name' nt) dispatch)
-- END Create Node
......
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 Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
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 Data.Array as A
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Props)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), postWwwUrlencoded, get)
import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
import Reactix as R
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 props = R.createElement copyFromCorpusViewCpt props []
......@@ -38,10 +25,22 @@ copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
copyFromCorpusViewCpt :: R.Component Props
copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
where
cpt {dispatch, id, nodeType, session} _ = do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
cpt { dispatch
, id
, nodeType
, session
} _ =
do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded { dispatch
, id
, nodeType
, session
, tree
}
------------------------------------------------------------------------
type CorpusTreeProps =
( tree :: FTree
......@@ -55,9 +54,10 @@ copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
where
cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } [
H.div { className: "tree" } [copyFromCorpusTreeView p]
]
pure $ H.div { className: "copy-from-corpus" }
[ H.div { className: "tree" }
[copyFromCorpusTreeView p]
]
copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
......@@ -67,11 +67,13 @@ copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeVi
where
cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
, -} H.div { className: "node" } ([ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ H.text name ]
, -} H.div { className: "node" }
( [ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ H.text name ]
] <> children)
] <> children
)
-- ]
where
children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
......@@ -91,10 +93,12 @@ loadCorporaTree session = getCorporaTree session treeId
getCorporaTree :: Session -> Int -> Aff FTree
getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate
, GT.FolderShared
, GT.Team
, GT.FolderPublic
, GT.Folder
, GT.Corpus
, GT.NodeList]
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" typesList
typesList = [ GT.FolderPrivate
, GT.FolderShared
, GT.Team
, GT.FolderPublic
, GT.Folder
, GT.Corpus
, GT.NodeList
]
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)
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]
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 "
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.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Prelude (Unit, bind, const, discard, pure, ($), (<<<))
import Reactix as R
import Reactix.DOM.HTML as H
import Effect.Aff (Aff)
import Prelude (($))
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT
import Gargantext.Types (NodeType, ID, Name)
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Utils.Reactix as R2
import Gargantext.Sessions (Session, get, put, post, delete)
import Gargantext.Sessions (Session, put)
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"
renameAction :: String -> Action
renameAction newName = RenameNode newName
------------------------------------------------------------------------
newtype RenameValue = RenameValue
{ name :: Name }
{ text :: String }
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
encodeJson (RenameValue {text})
= "r_name" := text
~> 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
------------------------------------------------------------------------
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
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))
]
module Gargantext.Components.Search.SearchBar
module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
( Props, searchBar, searchBarCpt
) where
import Data.Tuple.Nested ((/\))
import Data.Nullable (Nullable)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Effect (Effect)
import Gargantext.Components.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.Search.SearchField (Search, searchField)
import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
......@@ -33,10 +28,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
module Gargantext.Components.Search.SearchField
( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex, isIsTex_Advanced) where
module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField
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.String (length)
import Data.Set as Set
import Data.Tuple (fst)
import Data.String (length)
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 Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&), (<), (<$>), (<<<), (<>), (==))
import Gargantext.Data.Array (catMaybes)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
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.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.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
select :: forall props.
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)
import Reactix as R
import Reactix.DOM.HTML as H
defaultSearch :: Search
defaultSearch = { databases: Empty
......@@ -75,18 +50,15 @@ searchFieldComponent :: R.Component Props
searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
where
cpt props@{onSearch, search: search@(s /\ _)} _ = do
pure $
H.div { className: "search-field-group", style: { width: "100%" } }
[
H.div { className: "row" }
[
H.div { className: "col-md-12" }
iframeRef <- R.useRef null
let params =
[ searchInput {search}
, if length s.term < 3 -- search with love : <3
then
H.div {}[]
else
H.div {} [ dataFieldNav search dataFields
, if isExternal s.datafield
then databaseInput search props.databases
else H.div {} []
......@@ -102,46 +74,44 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
, if isCNRS s.datafield
then componentCNRS search
else H.div {} []
, H.div {} [ searchIframes search iframeRef ]
, if needsLang s.datafield
then langNav search props.langs
else H.div {} []
]
]
]
, H.div { className : "panel-footer" }
[ if needsLang s.datafield
then langNav search props.langs
else H.div {} []
, H.div {} []
, H.div {className: "flex-center"}
[submitButton {onSearch, search, session: props.session}]
]
]
eqProps :: Record Props -> Record Props -> Boolean
eqProps p p' = (p.databases == p'.databases )
&& (p.langs == p'.langs )
&& (eqSearch (fst p.search) (fst p'.search))
-- && (fst p.filters == fst p'.filters )
componentIMT (search /\ setSearch) =
R.fragment
[ H.ul {} $ map liCpt allIMTorgs
--, filterInput fi
]
where
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
let button = submitButton {onSearch, search, session: props.session}
pure $ panel params button
componentIMT (search /\ setSearch) =
R.fragment
[ H.ul {} $ map liCpt allIMTorgs
--, filterInput fi
]
where
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
]
isExternal :: Maybe DataField -> Boolean
isExternal (Just (External _)) = true
......@@ -165,16 +135,6 @@ isIsTex ( Just
) = true
isIsTex _ = false
isIsTex_Advanced :: Maybe DataField -> Boolean
isIsTex_Advanced ( Just
( External
( Just ( IsTex_Advanced)
)
)
) = true
isIsTex_Advanced _ = false
isIMT :: Maybe DataField -> Boolean
isIMT ( Just
......@@ -264,9 +224,11 @@ langNav ({lang} /\ setSearch) langs =
------------------------------------------------------------------------
dataFieldNav :: R.State Search -> Array DataField -> R.Element
dataFieldNav ({datafield} /\ setSearch) datafields =
R.fragment [ H.div {className: "text-primary center"} [H.text "with DataField"]
, H.div {className: "nav nav-tabs"} (liItem <$> dataFields)
, H.div {className: "center"} [ H.text $ maybe "" doc datafield ]
R.fragment [ H.div { className: "text-primary center"} [H.text "with DataField"]
, H.div {className: "nav nav-tabs"} (liItem <$> dataFields)
, H.div {className: "center"} [ H.text
$ maybe "TODO: add Doc Instance" doc datafield
]
]
where
liItem :: DataField -> R.Element
......@@ -276,9 +238,9 @@ dataFieldNav ({datafield} /\ setSearch) datafields =
then " active"
else ""
, on: { click: \_ -> setSearch $ _ { datafield = Just df'
, databases = datafield2database df'
, databases = datafield2database df'
}
}
}
-- just one database query for now
-- a list a selected database needs more ergonomy
} [ H.text (show df') ]
......@@ -326,7 +288,7 @@ databaseInput (search /\ setSearch) dbs =
liItem db' = H.option {className : "text-primary center"} [ H.text (show db') ]
onChange e = do
let value = readDatabase $ R2.unsafeEventValue e
let value = read $ R2.unsafeEventValue e
setSearch $ _ { datafield = Just $ External value
, databases = fromMaybe Empty value
}
......@@ -345,7 +307,7 @@ orgInput ({datafield} /\ setSearch) orgs =
liItem org = H.option {className : "text-primary center"} [ H.text (show org) ]
onChange e = do
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
......@@ -392,8 +354,8 @@ searchInputComponent = R.hooksComponent "G.C.S.SearchInput" cpt
type SubmitButtonProps =
( onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: R.State Search
, session :: Session
, search :: R.State Search
, session :: Session
)
submitButton :: Record SubmitButtonProps -> R.Element
......
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.Array (concat)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
import Data.Set (Set)
......@@ -9,17 +9,33 @@ import Data.Set as Set
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
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.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.Sessions (Session(..), post)
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
......@@ -130,17 +146,18 @@ instance docDatabase :: Doc Database where
-- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs"
readDatabase :: String -> Maybe Database
readDatabase "All Databases" = Just All_Databases
readDatabase "PubMed" = Just PubMed
readDatabase "HAL" = Just $ HAL Nothing
readDatabase "Isidore"= Just Isidore
readDatabase "IsTex" = Just IsTex
readDatabase "IsTex_Advanced" = Just IsTex_Advanced
-- readDatabase "Web" = Just Web
-- readDatabase "News" = Just News
-- readDatabase "Social Networks" = Just SocialNetworks
readDatabase _ = Nothing
instance readDatabase :: Read Database where
read :: String -> Maybe Database
read "All Databases" = Just All_Databases
read "PubMed" = Just PubMed
read "HAL" = Just $ HAL Nothing
read "Isidore"= Just Isidore
read "IsTex" = Just IsTex
read "IsTex_Advanced" = Just IsTex_Advanced
-- read "Web" = Just Web
-- read "News" = Just News
-- read "Social Networks" = Just SocialNetworks
read _ = Nothing
derive instance eqDatabase :: Eq Database
......@@ -169,12 +186,12 @@ instance showOrg :: Show Org where
show (IMT _) = "IMT"
show (Others _) = "Others"
readOrg :: String -> Maybe Org
readOrg "All_Orgs" = Just $ All_Orgs
readOrg "CNRS" = Just $ CNRS $ Set.fromFoldable []
readOrg "IMT" = Just $ IMT $ Set.fromFoldable []
readOrg "Others" = Just $ Others $ Set.fromFoldable []
readOrg _ = Nothing
instance readOrg :: Read Org where
read "All_Orgs" = Just $ All_Orgs
read "CNRS" = Just $ CNRS $ Set.fromFoldable []
read "IMT" = Just $ IMT $ Set.fromFoldable []
read "Others" = Just $ Others $ Set.fromFoldable []
read _ = Nothing
derive instance eqOrg :: Eq Org
......@@ -248,26 +265,26 @@ instance showIMT_org :: Show IMT_org where
show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis"
readIMT_org :: String -> Maybe IMT_org
readIMT_org "All_IMT" = Just All_IMT
readIMT_org "ARMINES" = Just ARMINES
readIMT_org "Eurecom" = Just Eurecom
readIMT_org "IMT_Atlantique" = Just IMT_Atlantique
readIMT_org "IMT_Business_School" = Just IMT_Business_School
readIMT_org "IMT_Lille_Douai" = Just IMT_Lille_Douai
readIMT_org "IMT_Mines_ALES" = Just IMT_Mines_ALES
readIMT_org "IMT_Mines_Albi" = Just IMT_Mines_Albi
readIMT_org "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
readIMT_org "MINES_ParisTech" = Just MINES_ParisTech
readIMT_org "Mines_Douai" = Just Mines_Douai
readIMT_org "Mines_Nantes" = Just Mines_Nantes
readIMT_org "Mines_SaintEtienne" = Just Mines_SaintEtienne
readIMT_org "Telecom_Bretagne" = Just Telecom_Bretagne
readIMT_org "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
readIMT_org "Telecom_Lille" = Just Telecom_Lille
readIMT_org "Telecom_ParisTech" = Just Telecom_ParisTech
readIMT_org "Telecom_SudParis" = Just Telecom_SudParis
readIMT_org _ = Nothing
instance readIMT_org :: Read IMT_org where
read "All_IMT" = Just All_IMT
read "ARMINES" = Just ARMINES
read "Eurecom" = Just Eurecom
read "IMT_Atlantique" = Just IMT_Atlantique
read "IMT_Business_School" = Just IMT_Business_School
read "IMT_Lille_Douai" = Just IMT_Lille_Douai
read "IMT_Mines_ALES" = Just IMT_Mines_ALES
read "IMT_Mines_Albi" = Just IMT_Mines_Albi
read "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
read "MINES_ParisTech" = Just MINES_ParisTech
read "Mines_Douai" = Just Mines_Douai
read "Mines_Nantes" = Just Mines_Nantes
read "Mines_SaintEtienne" = Just Mines_SaintEtienne
read "Telecom_Bretagne" = Just Telecom_Bretagne
read "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
read "Telecom_Lille" = Just Telecom_Lille
read "Telecom_ParisTech" = Just Telecom_ParisTech
read "Telecom_SudParis" = Just Telecom_SudParis
read _ = Nothing
imtStructId :: IMT_org -> Array StructId
imtStructId All_IMT = concat $ map imtStructId allIMTSubOrgs
......
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
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 Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Types (NodeType(..), readNodeType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Prelude (Unit, bind, ($), pure)
import Gargantext.Sessions (Session, post)
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.DOM.HTML as H
{-
updateNode :: Session -> ID -> UpdateNodeParams -> Aff (Array ID)
updateNode session nodeId params = post session $ GR.NodeAPI GT.Node (Just nodeId) ""
-}
data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
| UpdateNodeParamsGraph { method :: String }
| UpdateNodeParamsTexts { method :: Int }
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
where
encodeJson (UpdateNodeParamsList { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest (UpdateNodeParamsList 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"
updateRequest (UpdateNodeParamsGraph 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"
updateRequest (UpdateNodeParamsTexts 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"
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 =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, params :: UpdateNodeParams
)
update :: NodeType
-> (Action -> Aff Unit)
-> R.Hooks R.Element
update NodeList dispatch = do
meth @( methodList /\ setMethod ) <- R.useState' Basic
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
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
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
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
)
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 : []
}
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]
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.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
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 Prelude hiding (div)
-----------------------------------------------------------------------
type ID = Int
......
module Gargantext.Components.Forest.Tree.Node.ProgressBar where
module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude
......@@ -20,10 +20,8 @@ import Reactix.DOM.HTML as H
data BarType = Bar | Pie
type Props =
(
asyncTask :: GT.AsyncTaskWithType
( asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, corpusId :: GT.ID
, onFinish :: Unit -> Effect Unit
......@@ -37,7 +35,11 @@ asyncProgressBar p = R.createElement asyncProgressBarCpt p []
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
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
intervalIdRef <- R.useRef Nothing
......@@ -66,9 +68,8 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
toInt n = unsafePartial $ fromJust $ fromNumber n
type ProgressIndicatorProps =
(
barType :: BarType
, label :: String
( barType :: BarType
, label :: String
, progress :: Int
)
......@@ -97,7 +98,14 @@ progressIndicatorCpt = R.hooksComponent "G.C.F.T.N.PB.progressIndicator" cpt
]
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
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
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
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
module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Prelude
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post)
import Gargantext.Types as GT
......
......@@ -2,8 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar
(Props, sidebar)
where
import Prelude
import Control.Parallel (parTraverse)
import Data.Array (head, last)
import Data.Int (fromString)
......@@ -16,22 +14,20 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
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.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends, url)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Types as GT
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 =
( frontends :: Frontends
......
......@@ -2,8 +2,7 @@ module Gargantext.Components.Lang where
import Data.Argonaut (class EncodeJson, encodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Show, show)
import Gargantext.Prelude (class Eq, class Show, show, class Read)
-- Language used for search
allLangs :: Array Lang
......@@ -16,23 +15,23 @@ allLangs = [ EN
data Lang = FR | EN | Universal | No_extraction
instance showLang :: Show Lang where
show FR = "FR"
show EN = "EN"
show Universal = "All"
show FR = "FR"
show EN = "EN"
show Universal = "All"
show No_extraction = "Nothing"
derive instance eqLang :: Eq Lang
readLang :: String -> Maybe Lang
readLang "FR" = Just FR
readLang "EN" = Just EN
readLang "All" = Just Universal
readLang "Nothing" = Just No_extraction
readLang _ = Nothing
instance readLang :: Read Lang where
read "FR" = Just FR
read "EN" = Just EN
read "All" = Just Universal
read "Nothing" = Just No_extraction
read _ = Nothing
instance encodeJsonLang :: EncodeJson Lang where
encodeJson a = encodeJson (show a)
-- Language used for the landing page
data LandingLang = LL_EN | LL_FR
......@@ -63,7 +63,7 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
[ H.h2 {className: "text-primary center m-a-2"}
[
-- 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"
, "data": { dismiss: "modal" } }
......@@ -208,8 +208,10 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
csrfTokenInput :: {} -> R.Element
csrfTokenInput _ =
H.input { type: "hidden", name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
H.input { type: "hidden"
, name: "csrfmiddlewaretoken"
, value: csrfMiddlewareToken
} -- TODO hard-coded CSRF token
termsCheckbox :: R.State Boolean -> R.Element
termsCheckbox setCheckBox =
......
......@@ -22,24 +22,22 @@ import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
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.Loader (loader)
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.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.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
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.List (sortWith) as L
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
type State' =
CoreState
......@@ -160,7 +158,7 @@ tableContainerCpt { dispatch
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
, on: {change: setTermListFilter <<< read <<< R2.unsafeEventValue}}
(map optps1 termLists)]
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
......@@ -168,7 +166,7 @@ tableContainerCpt { dispatch
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
, on: {change: setTermSizeFilter <<< read <<< R2.unsafeEventValue}}
(map optps1 termSizes)]
]
, H.div { className: "col-md-2", style: { marginTop: "6px" } } [
......@@ -226,19 +224,27 @@ tableContainerCpt { dispatch
editor = H.div {} $ maybe [] f ngramsParent
where
f ngrams = [
H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], 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"]
]
f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable
, ngrams
, ngramsStyle: []
, 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
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsElement
<<< _children
%~ 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
ngramsEdit _ = Nothing
......
module Gargantext.Components.NgramsTable.API where
import Gargantext.Prelude
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.NgramsTable.Core as NTC
import Effect.Aff (Aff)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post)
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
type UpdateNodeListParams =
......
......@@ -2,19 +2,20 @@ module Gargantext.Components.Nodes.Corpus.Chart.Predefined where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Prelude
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID, Mode(..), TabSubType(..), TabType(..), modeTabType)
import Reactix as R
data PredefinedChart =
......@@ -23,24 +24,29 @@ data PredefinedChart =
| CInstitutesTree
| CTermsMetrics
derive instance genericPredefinedChart :: Generic PredefinedChart _
instance showPredefinedChart :: Show PredefinedChart where
show = genericShow
derive instance eqPredefinedChart :: Eq PredefinedChart
instance ordPredefinedChart :: Ord PredefinedChart where
compare = genericCompare
instance decodePredefinedChart :: DecodeJson PredefinedChart where
decodeJson json = do
obj <- decodeJson json
pure $ readChart' obj
pure $ fromMaybe CDocsHistogram $ read obj
instance encodePredefinedChart :: EncodeJson PredefinedChart where
encodeJson c = encodeJson $ show c
readChart' :: String -> PredefinedChart
readChart' "CDocsHistogram" = CDocsHistogram
readChart' "CAuthorsPie" = CAuthorsPie
readChart' "CInstitutesTree" = CInstitutesTree
readChart' "CTermsMetrics" = CTermsMetrics
readChart' _ = CDocsHistogram
instance readPredefinedChart :: Read PredefinedChart where
read "CDocsHistogram" = Just CDocsHistogram
read "CAuthorsPie" = Just CAuthorsPie
read "CInstitutesTree" = Just CInstitutesTree
read "CTermsMetrics" = Just CTermsMetrics
read _ = Nothing
allPredefinedCharts :: Array PredefinedChart
......
module Gargantext.Components.Nodes.Corpus.Dashboard where
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
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.Dashboard.Types as DT
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2
import Gargantext.Prelude
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props =
(
nodeId :: NodeID
( nodeId :: NodeID
, session :: Session
)
......@@ -49,12 +45,11 @@ dashboardLayoutCpt = R.hooksComponent "G.C.N.C.D.dashboardLayout" cpt
where
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
DT.saveDashboard {
hyperdata: DT.Hyperdata $ h { charts = charts }
, nodeId
, session }
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts }
, nodeId:nodeId'
, session }
liftEffect $ setReload $ (+) 1
type LoadedProps =
......@@ -127,7 +122,7 @@ renderChartCpt = R.hooksComponent "G.C.N.C.D.renderChart" cpt
where
option 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
value = R2.unsafeEventValue e
onRemoveClick _ = onRemove unit
......
module Gargantext.Components.Nodes.Dashboard.Types where
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
......
module Gargantext.Config.REST where
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.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Array as A
import Data.Either (Either(..))
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple)
import Effect.Aff (Aff, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import Web.XHR.FormData as XHRFormData
type Token = String
......
module Gargantext.Prelude (module Prelude, logs)
module Gargantext.Prelude (module Prelude, logs, id, class Read, read)
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 Effect.Console (log)
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.
(MonadEffect effect)
=> Show message
......@@ -13,3 +25,5 @@ logs:: forall message effect.
-> effect Unit
logs = liftEffect <<< log <<< show
This diff is collapsed.
......@@ -7,9 +7,9 @@ import Data.Set as Set
import Data.Set (Set)
import Data.String as S
-- | Astonishingly, not in the prelude
id :: forall a. a -> a
id a = a
-- | TODO (hard coded)
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
setterv :: forall nt record field.
Newtype nt record
......@@ -45,15 +45,12 @@ invertOrdering LT = GT
invertOrdering GT = LT
invertOrdering EQ = EQ
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
-- A lens that always returns unit
_unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s)
glyphicon :: String -> String
glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t
glyphicon t = "btn glyphitem fa fa-" <> t
glyphiconActive :: String -> Boolean -> String
glyphiconActive icon b = glyphicon icon <> if b then " active" else ""
......
This diff is collapsed.
module Gargantext.Utils.Popover where
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (maybe)
import Data.Nullable (Nullable, toMaybe)
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import FFI.Simple ((..), (...))
import Reactix as R
import Gargantext.Prelude
......
This diff is collapsed.
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