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
Expand all Show 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
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.
dist/styles/Login.css
View file @ 0b03d8c1
......@@ -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;
}
......
dist/styles/Login.sass
View file @ 0b03d8c1
......@@ -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
......
package.json
View file @ 0b03d8c1
{
"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",
......
src/Gargantext/AsyncTasks.purs
View file @ 0b03d8c1
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(..))
......
src/Gargantext/Components/DocsTable.purs
View file @ 0b03d8c1
......@@ -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
......
src/Gargantext/Components/Forest.purs
View file @ 0b03d8c1
......@@ -37,19 +37,37 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
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.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"} []
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 0b03d8c1
This diff is collapsed.
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 0b03d8c1
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 !"
-----------------------------------------------------------------------
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ 0b03d8c1
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
......@@ -62,72 +60,18 @@ 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 {} []
]
nodeName@(name' /\ setNodeName) <- R.useState' "Name"
nodeType'@(nt /\ setNodeType) <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
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
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
......
src/Gargantext/Components/Forest/Tree/Node/Action/CopyFrom.purs
View file @ 0b03d8c1
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
cpt { dispatch
, id
, nodeType
, session
} _ =
do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
copyFromCorpusViewLoaded { dispatch
, id
, nodeType
, session
, tree
}
------------------------------------------------------------------------
type CorpusTreeProps =
( tree :: FTree
......@@ -55,8 +54,9 @@ 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
......@@ -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
, -} 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
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]
, 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
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
------------------------------------------------------------------------
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
) 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
......
src/Gargantext/Components/Search/SearchField.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs
View file @ 0b03d8c1
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,24 +74,21 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
, if isCNRS s.datafield
then componentCNRS search
else H.div {} []
]
]
]
, H.div { className : "panel-footer" }
[ if needsLang s.datafield
, H.div {} [ searchIframes search iframeRef ]
, 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) =
let button = submitButton {onSearch, search, session: props.session}
pure $ panel params button
componentIMT (search /\ setSearch) =
R.fragment
[ H.ul {} $ map liCpt allIMTorgs
--, filterInput fi
......@@ -136,7 +105,8 @@ searchFieldComponent = R.hooksComponent "G.C.S.SearchField" cpt
then H.i {} [H.text $ " " <> show org]
else H.text $ " " <> show org
]
componentCNRS (search /\ setSearch) =
componentCNRS (search /\ setSearch) =
R.fragment [
H.div {} []
--, filterInput fi
......@@ -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"]
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 ]
, H.div {className: "center"} [ H.text
$ maybe "TODO: add Doc Instance" doc datafield
]
]
where
liItem :: DataField -> R.Element
......@@ -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
......
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.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
......
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
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 }
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"
instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
updateRequest (UpdateNodeParamsBoard meth) session nodeId = do
task <- post session p meth
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
where
encodeJson (UpdateNodeParamsList { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsGraph { method })
= "method" := method
~> jsonEmptyObject
encodeJson (UpdateNodeParamsTexts { method })
= "method" := method
~> jsonEmptyObject
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
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/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/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.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
......
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
......@@ -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,8 +68,7 @@ asyncProgressBarCpt = R.hooksComponent "G.C.F.T.N.PB.asyncProgressBar" cpt
toInt n = unsafePartial $ fromJust $ fromNumber n
type ProgressIndicatorProps =
(
barType :: BarType
( 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
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
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
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 0b03d8c1
......@@ -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
......
src/Gargantext/Components/Lang.purs
View file @ 0b03d8c1
......@@ -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
......@@ -23,16 +22,16 @@ instance showLang :: Show Lang where
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
src/Gargantext/Components/Login.purs
View file @ 0b03d8c1
......@@ -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 =
......
src/Gargantext/Components/NgramsTable.purs
View file @ 0b03d8c1
......@@ -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,11 +224,19 @@ 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
......@@ -238,7 +244,7 @@ tableContainerCpt { dispatch
<<< _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
......
src/Gargantext/Components/NgramsTable/API.purs
View file @ 0b03d8c1
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 =
......
src/Gargantext/Components/Nodes/Corpus/Chart/Predefined.purs
View file @ 0b03d8c1
......@@ -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
......
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @ 0b03d8c1
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,11 +45,10 @@ 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
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts }
, nodeId:nodeId'
, session }
liftEffect $ setReload $ (+) 1
......@@ -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
......
src/Gargantext/Components/Nodes/Corpus/Types.purs
View file @ 0b03d8c1
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.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.List ((:))
import Data.List as List
import Data.Maybe (Maybe)
import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Prelude
type Author = String
type Description = String
......@@ -25,45 +20,45 @@ type MarkdownText = String
type Hash = String
newtype Hyperdata =
Hyperdata
{
fields :: List.List FTField
}
Hyperdata { fields :: List.List FTField }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
fields <- obj .: "fields"
pure $ Hyperdata {fields}
instance encodeHyperdata :: EncodeJson Hyperdata where
encodeJson (Hyperdata {fields}) = do
"fields" := fields
~> jsonEmptyObject
newtype Field a = Field {
name :: String
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
derive instance genericFTField :: Generic (Field FieldType) _
instance eqFTField :: Eq (Field FieldType) where
eq = genericEq
instance showFTField :: Show (Field FieldType) where
show = genericShow
data FieldType =
Haskell {
haskell :: HaskellCode
Haskell { haskell :: HaskellCode
, tag :: Tag
}
| JSON {
authors :: Author
| JSON { authors :: Author
, desc :: Description
, query :: Query
, tag :: Tag
, title :: Title
}
| Markdown {
tag :: Tag
| Markdown { tag :: Tag
, text :: MarkdownText
}
......@@ -90,10 +85,13 @@ getCorpusInfo as = case List.head (List.filter isJSON as) of
}
derive instance genericFieldType :: Generic FieldType _
instance eqFieldType :: Eq FieldType where
eq = genericEq
instance showFieldType :: Show FieldType where
show = genericShow
instance decodeFTField :: DecodeJson (Field FieldType) where
decodeJson json = do
obj <- decodeJson json
......@@ -118,6 +116,7 @@ instance decodeFTField :: DecodeJson (Field FieldType) where
pure $ Markdown {tag, text}
_ -> Left $ "Unsupported 'type' " <> type_
pure $ Field {name, typ}
instance encodeFTField :: EncodeJson (Field FieldType) where
encodeJson (Field {name, typ}) =
"data" := typ
......@@ -128,6 +127,7 @@ instance encodeFTField :: EncodeJson (Field FieldType) where
typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
instance encodeFieldType :: EncodeJson FieldType where
encodeJson (Haskell {haskell}) =
"haskell" := haskell
......@@ -147,41 +147,50 @@ instance encodeFieldType :: EncodeJson FieldType where
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' = {
haskell: ""
, tag: "HaskellField"
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' = {
authors: ""
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' = {
tag: "MarkdownField"
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field {
name: "New file"
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
newtype CorpusInfo =
CorpusInfo
{ title :: String
CorpusInfo { title :: String
, authors :: String
, desc :: String
, query :: String
, totalRecords :: Int }
, totalRecords :: Int
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
......
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @ 0b03d8c1
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(..))
......
src/Gargantext/Config/REST.purs
View file @ 0b03d8c1
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
......
src/Gargantext/Prelude.purs
View file @ 0b03d8c1
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
src/Gargantext/Types.purs
View file @ 0b03d8c1
module Gargantext.Types where
import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array as A
import Data.Either (Either(..))
......@@ -10,8 +8,10 @@ import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect.Aff (Aff)
import Gargantext.Prelude (class Read, read)
import Prelude
import Prim.Row (class Union)
import URI.Query (Query)
......@@ -44,10 +44,11 @@ instance showTermSize :: Show TermSize where
show MonoTerm = "MonoTerm"
show MultiTerm = "MultiTerm"
readTermSize :: String -> Maybe TermSize
readTermSize "MonoTerm" = Just MonoTerm
readTermSize "MultiTerm" = Just MultiTerm
readTermSize _ = Nothing
instance readTermSize :: Read TermSize where
read :: String -> Maybe TermSize
read "MonoTerm" = Just MonoTerm
read "MultiTerm" = Just MultiTerm
read _ = Nothing
termSizes :: Array { desc :: String, mval :: Maybe TermSize }
termSizes = [ { desc: "All types", mval: Nothing }
......@@ -93,11 +94,12 @@ termListName GraphTerm = "Map List"
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"
readTermList :: String -> Maybe TermList
readTermList "GraphTerm" = Just GraphTerm
readTermList "StopTerm" = Just StopTerm
readTermList "CandidateTerm" = Just CandidateTerm
readTermList _ = Nothing
instance readTermList :: Read TermList where
read :: String -> Maybe TermList
read "GraphTerm" = Just GraphTerm
read "StopTerm" = Just StopTerm
read "CandidateTerm" = Just CandidateTerm
read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing }
......@@ -176,30 +178,28 @@ instance showNodeType :: Show NodeType where
show NodeList = "NodeList"
show Texts = "NodeTexts"
readNodeType :: String -> NodeType
readNodeType "NodeUser" = NodeUser
readNodeType "NodeFolder" = Folder
readNodeType "NodeFolderPrivate" = FolderPrivate
readNodeType "NodeFolderShared" = FolderShared
readNodeType "NodeFolderPublic" = FolderPublic
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeGraph" = Graph
readNodeType "NodePhylo" = Phylo
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeTeam" = Team
readNodeType "NodeList" = NodeList
readNodeType "NodeTexts" = Texts
readNodeType "Annuaire" = Annuaire
readNodeType _ = Error
instance readNodeType :: Read NodeType where
read "NodeUser" = Just NodeUser
read "NodeFolder" = Just Folder
read "NodeFolderPrivate" = Just FolderPrivate
read "NodeFolderShared" = Just FolderShared
read "NodeFolderPublic" = Just FolderPublic
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document
read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo
read "Individu" = Just Individu
read "Node" = Just Node
read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact
read "Tree" = Just Tree
read "NodeTeam" = Just Team
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read _ = Nothing
fldr :: NodeType -> Boolean -> String
......@@ -254,7 +254,7 @@ instance eqNodeType :: Eq NodeType where
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
pure $ fromMaybe Error $ read obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
......@@ -449,7 +449,10 @@ instance showTabType :: Show TabType where
type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms
data Mode = Authors
| Sources
| Institutes
| Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
......@@ -480,6 +483,8 @@ data AsyncTaskType = Form
| GraphT
| Query
| AddNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
eq = genericEq
......@@ -502,35 +507,47 @@ asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/"
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 _
instance showAsyncTaskStatus :: Show AsyncTaskStatus where
show = genericShow
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where
encodeJson s = encodeJson $ show s
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
decodeJson json = do
obj <- decodeJson json
pure $ readAsyncTaskStatus obj
readAsyncTaskStatus :: String -> AsyncTaskStatus
readAsyncTaskStatus "IsFailure" = Failed
readAsyncTaskStatus "IsFinished" = Finished
readAsyncTaskStatus "IsKilled" = Killed
readAsyncTaskStatus "IsPending" = Pending
readAsyncTaskStatus "IsReceived" = Received
readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
id :: AsyncTaskID
pure $ fromMaybe Running $ read obj
instance readAsyncTaskStatus :: Read AsyncTaskStatus where
read "IsFailure" = Just Failed
read "IsFinished" = Just Finished
read "IsKilled" = Just Killed
read "IsPending" = Just Pending
read "IsReceived" = Just Received
read "IsRunning" = Just Running
read "IsStarted" = Just Started
read _ = Nothing
newtype AsyncTask =
AsyncTask { id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance genericAsyncTask :: Generic AsyncTask _
instance eqAsyncTask :: Eq AsyncTask where
eq = genericEq
......
src/Gargantext/Utils.purs
View file @ 0b03d8c1
......@@ -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 ""
......
src/Gargantext/Utils/Argonaut.purs
View file @ 0b03d8c1
This diff is collapsed.
src/Gargantext/Utils/Popover.purs
View file @ 0b03d8c1
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
......
test/Gargantext/Utils/Spec.purs
View file @ 0b03d8c1
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