Skip to content

P
purescript-gargantext
Commit ed807a2e authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge branch 'dev' into dev-search

parents b1c31559 278b0c8c
Hide whitespace changes
Inline Side-by-side
Showing with 3639 additions and 845 deletions
.gitignore
View file @ ed807a2e
...@@ -8,11 +8,15 @@ ...@@ -8,11 +8,15 @@
/.purs* /.purs*
/.psa* /.psa*
/.spago /.spago
bundle.js
# webpack splays purescript modules in dist. we don't want these to be
# added, but we do want static assets to be added
/dist/* /dist/*
!/dist/styles/ !/dist/styles/
/dist/styles/*map
!/dist/examples/ !/dist/examples/
!/dist/fonts/ !/dist/fonts/
!/dist/images/ !/dist/images/
!/dist/js/ !/dist/js/
/dist/styles/*map # css source maps
\ No newline at end of file /dist/styles/*map
README.md
View file @ ed807a2e
...@@ -93,7 +93,67 @@ And run a repl: ...@@ -93,7 +93,67 @@ And run a repl:
yarn repl yarn repl
``` ```
## Note to the contributors ```shell
yarn install && yarn ps-deps
```
### Running a dev server
```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.
```
#### 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
```shell
yarn repl
```
### Building for production
```shell
yarn build
```
Note that a production build takes a little while.
### How do I?
#### Change which backend to connect to?
Edit `Config.purs`. Find the function `endConfig'` just after the
imports and edit `back`. The definitions are not far below, just after
the definitions of the various `front` options.
Example (using `demo.gargantext.org` as backend):
```
endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontRelative
, back : backDemo v }
```
### Contributor notes
Please follow CONTRIBUTING.md Please follow CONTRIBUTING.md
......
bower.json deleted 100644 → 0
View file @ b1c31559
{
"name": "purescript-gargantext",
"ignore": [
"**/.*",
"node_modules",
"bower_components",
"output"
],
"dependencies": {
"purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#cf194360c8ee440978a2b342382fc3fddc65b39e",
"purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1",
"purescript-random": "^4.0.0",
"purescript-css": "^4.0.0"
},
"devDependencies": {
"purescript-psci-support": "^4.0.0"
},
"resolutions": {
"purescript-react": "exports",
"purescript-profunctor-lenses": "^4.0.0"
}
}
build deleted 100755 → 0
View file @ b1c31559
#!/bin/bash
yarn install && yarn rebuild-set && yarn install-ps && yarn pulp --psc-package build && yarn pulp --psc-package browserify --to dist/bundle.js
dist/index.html
View file @ ed807a2e
...@@ -4,13 +4,12 @@ ...@@ -4,13 +4,12 @@
<meta charset="utf-8"/> <meta charset="utf-8"/>
<title>CNRS GarganText</title> <title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet"> <link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet">
<link href="https://use.fontawesome.com/releases/v5.0.8/css/all.css" rel="stylesheet"> <link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">
<link href="styles/login.min.css" rel="stylesheet"> <link href="styles/login.min.css" rel="stylesheet">
<link href="styles/bootstrap.min.css" rel="stylesheet"> <link href="styles/bootstrap.min.css" rel="stylesheet">
<!-- <link href="css/lavish-bootstrap.css" rel="stylesheet"> --> <!-- <link href="styles/lavish-bootstrap.css" rel="stylesheet"> -->
<link rel="stylesheet" type="text/css" href="styles/menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/context-menu.css"/> <link rel="stylesheet" type="text/css" href="styles/context-menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/annotation.css"/> <link rel="stylesheet" type="text/css" href="styles/menu.css"/>
<link href="styles/Login.css" rel="stylesheet"> <link href="styles/Login.css" rel="stylesheet">
<style> <style>
* {margin: 0; padding: 0; list-style: none;} * {margin: 0; padding: 0; list-style: none;}
...@@ -54,7 +53,7 @@ ...@@ -54,7 +53,7 @@
background-color: "#000"; background-color: "#000";
top: 12px; top: 12px;
} }
</style> </style>
</head> </head>
<body> <body>
<div id="app" class ="container-fluid"></div> <div id="app" class ="container-fluid"></div>
......
dist/index.js 0 → 100644
View file @ ed807a2e
// This file is just a wrapper so that webpack will call our main function
require('./Main.purs').main();
install deleted 100644 → 0
View file @ b1c31559
#!/bin/bash
echo "Upgrading nodeJS"
sudo npm cache clean -f
sudo npm install -g n
sudo n stable
sudo n latest
echo "Installing yarn"
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
./build
package.json
View file @ ed807a2e
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
"install-ps": "psc-package install", "install-ps": "psc-package install",
"build": "pulp --psc-package browserify -t dist/bundle.js", "build": "pulp --psc-package browserify -t dist/bundle.js",
"dev": "webpack-dev-server --env dev --mode development",
"repl": "pulp --psc-package repl", "repl": "pulp --psc-package repl",
"clean": "rm -Rf output" "clean": "rm -Rf output"
}, },
...@@ -19,6 +20,9 @@ ...@@ -19,6 +20,9 @@
"react-dom": "^16.8.2", "react-dom": "^16.8.2",
"react-sigma": "git://github.com/np/react-sigma.git#shouldComponentUpdate" "react-sigma": "git://github.com/np/react-sigma.git#shouldComponentUpdate"
}, },
"eslintConfig": {
"extends": "react-app"
},
"devDependencies": { "devDependencies": {
"@babel/cli": "^7.1.5", "@babel/cli": "^7.1.5",
"@babel/core": "^7.1.6", "@babel/core": "^7.1.6",
...@@ -26,13 +30,30 @@ ...@@ -26,13 +30,30 @@
"@babel/preset-react": "^7.0.0", "@babel/preset-react": "^7.0.0",
"@babel/preset-stage-2": "^7.0.0", "@babel/preset-stage-2": "^7.0.0",
"babel-core": "^7.0.0-bridge", "babel-core": "^7.0.0-bridge",
"babel-loader": "^8.0.4",
"clean-webpack-plugin": "^1.0.0",
"css-loader": "^2.1.0",
"envify": "^4.1.0", "envify": "^4.1.0",
"executive": "^1.6.3",
"file-loader": "^3.0.1",
"html-loader": "^0.5.5",
"html-webpack-plugin": "^4.0.0-beta.5",
"http-server": "^0.11.1", "http-server": "^0.11.1",
"mini-css-extract-plugin": "^0.5.0",
"psc-package": "^3.0.1", "psc-package": "^3.0.1",
"pulp": "^12.4.0", "pulp": "^12.4.0",
"purescript": "^0.12.4", "purescript": "^0.12.4",
"purs-loader": "^3.3.0",
"react-testing-library": "^6.1.2", "react-testing-library": "^6.1.2",
"spago": "^0.7.5" "source-map-loader": "^0.2.4",
}, "spago": "^0.7.5",
"version": "0.0.0" "style-loader": "^0.23.1",
"uglify-js": "^3.4.9",
"uglifyify": "^5.0.1",
"webpack": "^4.26.0",
"webpack-cli": "^3.1.2",
"webpack-dev-server": "^3.1.10",
"webpack-node-externals": "^1.7.2",
"xhr2": "^0.1.4"
}
} }
rebuild deleted 100755 → 0
View file @ b1c31559
#!/bin/bash
rm -rf .psc-package output bower_components node_modules
./build
repl deleted 100755 → 0
View file @ b1c31559
#!/bin/bash
yarn repl
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @ ed807a2e
...@@ -19,7 +19,7 @@ import DOM.Simple.Document as Document ...@@ -19,7 +19,7 @@ import DOM.Simple.Document as Document
import DOM.Simple.Types ( DOMRect ) import DOM.Simple.Types ( DOMRect )
import Effect (Effect) import Effect (Effect)
import Effect.Uncurried ( mkEffectFn1 ) import Effect.Uncurried ( mkEffectFn1 )
import FFI.Simple ( (...), (..), (.=), delay ) import FFI.Simple ( (...), (..), delay )
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
...@@ -56,8 +56,17 @@ contextMenuCpt = R.hooksComponent "ContextMenu" cpt ...@@ -56,8 +56,17 @@ contextMenuCpt = R.hooksComponent "ContextMenu" cpt
] ]
] ]
pure $ R.createPortal [ elems root menu rect $ cs ] host pure $ R.createPortal [ elems root menu rect $ cs ] host
elems ref menu (Just rect) = HTML.div (({ ref , className: "context-menu", style: position menu rect} .= "data-toggle" $ "popover") .= "data-placement" $ "right") elems ref menu (Just rect) = HTML.div
elems ref _ _ = HTML.div (({ ref, className: "context-menu" } .= "data-toggle" $ "popover") .= "data-placement" $ "right") { ref
, className: "context-menu"
, style: position menu rect
, data: {toggle: "popover", placement: "right"}
}
elems ref _ _ = HTML.div
{ ref
, className: "context-menu"
, data: {toggle: "popover", placement: "right"}
}
contextMenuEffect contextMenuEffect
:: forall t :: forall t
......
src/Gargantext/Components/DocsTable.purs
View file @ ed807a2e
...@@ -50,6 +50,7 @@ type Props = ...@@ -50,6 +50,7 @@ type Props =
, chart :: ReactElement , chart :: ReactElement
, tabType :: TabType , tabType :: TabType
, listId :: Int , listId :: Int
, corpusId :: Maybe Int
-- ^ tabType is not ideal here since it is too much entangled with tabs and -- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. -- ngramtable. Let's see how this evolves.
} }
...@@ -175,7 +176,7 @@ layoutDocview = simpleSpec performAction render ...@@ -175,7 +176,7 @@ layoutDocview = simpleSpec performAction render
(_documentIdsDeleted <>~ documentIdsToDelete) (_documentIdsDeleted <>~ documentIdsToDelete)
render :: Render State Props Action render :: Render State Props Action
render dispatch {nodeId, tabType, listId, totalRecords, chart} deletionState _ = render dispatch {nodeId, tabType, listId, corpusId, totalRecords, chart} deletionState _ =
[ {- br' [ {- br'
, div [ style {textAlign : "center"}] [ text " Filter " , div [ style {textAlign : "center"}] [ text " Filter "
, input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"] , input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"]
...@@ -188,8 +189,9 @@ layoutDocview = simpleSpec performAction render ...@@ -188,8 +189,9 @@ layoutDocview = simpleSpec performAction render
[ chart [ chart
, div [className "col-md-12"] , div [className "col-md-12"]
[ pageLoader [ pageLoader
{ path: initialPageParams {nodeId, tabType, listId} { path: initialPageParams {nodeId, tabType, listId, corpusId}
, listId , listId
, corpusId
, totalRecords , totalRecords
, deletionState , deletionState
, dispatch , dispatch
...@@ -210,14 +212,14 @@ layoutDocview = simpleSpec performAction render ...@@ -210,14 +212,14 @@ layoutDocview = simpleSpec performAction render
mock :: Boolean mock :: Boolean
mock = false mock = false
type PageParams = {nodeId :: Int, listId :: Int, tabType :: TabType, params :: T.Params} type PageParams = {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType, params :: T.Params}
initialPageParams :: {nodeId :: Int, listId :: Int, tabType :: TabType} -> PageParams initialPageParams :: {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType} -> PageParams
initialPageParams {nodeId, listId, tabType} = initialPageParams {nodeId, listId, corpusId, tabType} =
{nodeId, tabType, listId, params: T.initialParams} {nodeId, tabType, listId, corpusId, params: T.initialParams}
loadPage :: PageParams -> Aff (Array DocumentsView) loadPage :: PageParams -> Aff (Array DocumentsView)
loadPage {nodeId, tabType, listId, params: {limit, offset, orderBy}} = do loadPage {nodeId, tabType, listId, corpusId, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit" logs "loading documents page: loadPage with Offset and limit"
res <- get $ toUrl Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId) res <- get $ toUrl Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let docs = res2corpus <$> res let docs = res2corpus <$> res
...@@ -253,25 +255,27 @@ type PageLoaderProps row = ...@@ -253,25 +255,27 @@ type PageLoaderProps row =
, dispatch :: Action -> Effect Unit , dispatch :: Action -> Effect Unit
, deletionState :: State , deletionState :: State
, listId :: Int , listId :: Int
, corpusId :: Maybe Int
| row | row
} }
renderPage :: forall props path. renderPage :: forall props path.
Render (Loader.State {nodeId :: Int, listId :: Int, tabType :: TabType | path} (Array DocumentsView)) Render (Loader.State {nodeId :: Int, listId :: Int, corpusId :: Maybe Int, tabType :: TabType | path} (Array DocumentsView))
{ totalRecords :: Int { totalRecords :: Int
, dispatch :: Action -> Effect Unit , dispatch :: Action -> Effect Unit
, deletionState :: State , deletionState :: State
, listId :: Int , listId :: Int
, corpusId :: Maybe Int
| props | props
} }
(Loader.Action PageParams) (Loader.Action PageParams)
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner
renderPage loaderDispatch { totalRecords, dispatch, listId renderPage loaderDispatch { totalRecords, dispatch, listId, corpusId
, deletionState: {documentIdsToDelete, documentIdsDeleted, localFavorites}} , deletionState: {documentIdsToDelete, documentIdsDeleted, localFavorites}}
{currentPath: {nodeId, tabType}, loaded: Just res} _ = {currentPath: {nodeId, tabType}, loaded: Just res} _ =
[ T.tableElt [ T.tableElt
{ rows { rows
, setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, params}) , setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, corpusId, params})
, container: T.defaultContainer { title: "Documents" } , container: T.defaultContainer { title: "Documents" }
, colNames: , colNames:
T.ColumnName <$> T.ColumnName <$>
...@@ -287,38 +291,40 @@ renderPage loaderDispatch { totalRecords, dispatch, listId ...@@ -287,38 +291,40 @@ renderPage loaderDispatch { totalRecords, dispatch, listId
where where
gi true = "glyphicon glyphicon-star" gi true = "glyphicon glyphicon-star"
gi false = "glyphicon glyphicon-star-empty" gi false = "glyphicon glyphicon-star-empty"
isChecked _id = Set.member _id documentIdsToDelete
toDelete (DocumentsView {_id}) = Set.member _id documentIdsToDelete toDelete (DocumentsView {_id}) = Set.member _id documentIdsToDelete
isDeleted (DocumentsView {_id}) = Set.member _id documentIdsDeleted isDeleted (DocumentsView {_id}) = Set.member _id documentIdsDeleted
isFavorite {_id,fav} = maybe fav identity (localFavorites ^. at _id) isFavorite {_id,fav} = maybe fav identity (localFavorites ^. at _id)
corpusDocument (Just corpusId) = R.CorpusDocument corpusId
corpusDocument _ = R.Document
rows = (\(DocumentsView r) -> rows = (\(DocumentsView r) ->
let isFav = isFavorite r in let isFav = isFavorite r
toDel = toDelete $ DocumentsView r in
{ row: { row:
[ div [] [ div []
[ a [ className $ gi isFav [ a [ className $ gi isFav
, if (toDelete $ DocumentsView r) then style {textDecoration : "line-through"} , if toDel then style {textDecoration : "line-through"}
else style {textDecoration : "none"} else style {textDecoration : "none"}
, onClick $ (\_-> dispatch $ MarkFavorites r._id (not isFav))] [] , onClick $ (\_-> dispatch $ MarkFavorites r._id (not isFav))] []
] ]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, if (toDelete $ DocumentsView r) then , if toDel then
div [ style {textDecoration : "line-through"}][text (show r.date)] div [ style {textDecoration : "line-through"}][text (show r.date)]
else else
div [ ][text (show r.date)] div [ ][text (show r.date)]
, if (toDelete $ DocumentsView r) then , if toDel then
a [ href (toLink $ R.Document listId r._id) a [ href (toLink $ (corpusDocument corpusId) listId r._id)
, style {textDecoration : "line-through"} , style {textDecoration : "line-through"}
, target "_blank" , target "_blank"
] [ text r.title ] ] [ text r.title ]
else else
a [ href (toLink $ R.Document listId r._id) a [ href (toLink $ (corpusDocument corpusId) listId r._id)
, target "_blank" ] [ text r.title ] , target "_blank" ] [ text r.title ]
, if (toDelete $ DocumentsView r) then , if toDel then
div [style {textDecoration : "line-through"}] [ text r.source] div [style {textDecoration : "line-through"}] [ text r.source]
else else
div [] [ text r.source] div [] [ text r.source]
, input [ _type "checkbox" , input [ _type "checkbox"
, checked (isChecked r._id) , checked toDel
, onClick $ (\_ -> dispatch $ ToggleDocumentToDelete r._id)] , onClick $ (\_ -> dispatch $ ToggleDocumentToDelete r._id)]
] ]
, delete: true , delete: true
......
src/Gargantext/Components/Loader2.purs 0 → 100644
View file @ ed807a2e
module Gargantext.Components.Loader2 where
import Data.Maybe (Maybe(..), isNothing)
import Data.Tuple.Nested ((/\))
import Gargantext.Prelude
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
type State path loaded = { currentPath :: path, loaded :: Maybe loaded }
useLoader
:: forall path loaded
. Eq path
=> Show path
=> path
-> (path -> Aff loaded)
-> (path -> loaded -> R.Element)
-> R.Hooks R.Element
useLoader newPath loader render = do
{currentPath, loaded} /\ setState <- R.useState' { currentPath: newPath, loaded: Nothing }
R.useEffect $
if (isNothing loaded || newPath /= currentPath) then do
logs $ "useLoader " <> show {newPath, currentPath, loadedIsNothing: isNothing loaded}
fiber <- launchAff do
freshlyLoaded <- loader newPath
liftEffect $ setState $ const { currentPath: newPath, loaded: Just freshlyLoaded }
pure $ launchAff_ $ killFiber (error "useLoader") fiber
else do
pure $ pure $ unit
pure case loaded of
Nothing ->
-- TODO load spinner
R.fragment []
Just loadedData ->
render currentPath loadedData
src/Gargantext/Components/Search/SearchField.purs
View file @ ed807a2e
...@@ -14,7 +14,7 @@ import DOM.Simple.Element as Element ...@@ -14,7 +14,7 @@ import DOM.Simple.Element as Element
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect ( Effect ) import Effect ( Effect )
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..), (.=)) import FFI.Simple ((..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.DOM.HTML (text, button, div, input, option, form, span, ul, li, a) import Reactix.DOM.HTML (text, button, div, input, option, form, span, ul, li, a)
...@@ -70,7 +70,9 @@ databaseInput (db /\ setDB) dbs = ...@@ -70,7 +70,9 @@ databaseInput (db /\ setDB) dbs =
onClick = mkEffectFn1 $ \_ -> setDB (const $ Just db) onClick = mkEffectFn1 $ \_ -> setDB (const $ Just db)
dropdownBtnProps = { id: "search-dropdown" dropdownBtnProps = { id: "search-dropdown"
, className: "btn btn-default dropdown-toggle" , className: "btn btn-default dropdown-toggle"
, type: "button"} .= "data-toggle" $ "dropdown" , type: "button"
, data: {toggle: "dropdown"}
}
dropdownBtn (Just db) = button dropdownBtnProps [ span {} [ text (show db) ] ] dropdownBtn (Just db) = button dropdownBtnProps [ span {} [ text (show db) ] ]
dropdownBtn (Nothing) = button dropdownBtnProps [ span {} [ text "-" ] ] dropdownBtn (Nothing) = button dropdownBtnProps [ span {} [ text "-" ] ]
......
src/Gargantext/Components/Tree.purs
View file @ ed807a2e
...@@ -14,16 +14,11 @@ import Data.Newtype (class Newtype) ...@@ -14,16 +14,11 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, runAff) import Effect.Aff (Aff, launchAff, launchAff_, killFiber, runAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1) import Effect.Exception (error)
import FFI.Simple ((..), (.=)) import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Loader as Loader import FFI.Simple ((..))
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactClass, ReactElement) import React (ReactClass, ReactElement)
import React as React import React as React
...@@ -40,12 +35,22 @@ import Web.File.File (toBlob) ...@@ -40,12 +35,22 @@ import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Router as Router
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
type Name = String type Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
type ID = Int type ID = Int
type Props = { root :: ID } data NodePopup = CreatePopup | NodePopup
type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes }
data NTree a = NTree a (Array (NTree a)) data NTree a = NTree a (Array (NTree a))
...@@ -60,11 +65,8 @@ filterNTree p (NTree x ary) = ...@@ -60,11 +65,8 @@ filterNTree p (NTree x ary) =
newtype LNode = LNode { id :: ID newtype LNode = LNode { id :: ID
, name :: String , name :: Name
, nodeType :: NodeType , nodeType :: NodeType}
, popOver :: Boolean
, nodeValue :: String
, createOpen :: Boolean}
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
...@@ -76,10 +78,7 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -76,10 +78,7 @@ instance decodeJsonLNode :: DecodeJson LNode where
nodeType <- obj .: "type" nodeType <- obj .: "type"
pure $ LNode { id : id_ pure $ LNode { id : id_
, name , name
, nodeType , nodeType}
, popOver : false
, nodeValue : ""
, createOpen : false}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do decodeJson json = do
...@@ -92,15 +91,6 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -92,15 +91,6 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
type FTree = NTree LNode type FTree = NTree LNode
setName :: String -> NTree LNode -> NTree LNode
setName v (NTree (LNode s@{name}) ary) = NTree (LNode $ s {name = v}) ary
setPopOver :: Boolean -> NTree LNode -> NTree LNode
setPopOver v (NTree (LNode s@{popOver}) ary) = NTree (LNode $ s {popOver = v}) ary
setCreateOpen :: Boolean -> NTree LNode -> NTree LNode
setCreateOpen v (NTree (LNode s@{createOpen}) ary) = NTree (LNode $ s {createOpen = v}) ary
-- file upload types -- file upload types
data FileType = CSV | PresseRIS data FileType = CSV | PresseRIS
derive instance genericFileType :: Generic FileType _ derive instance genericFileType :: Generic FileType _
...@@ -121,136 +111,96 @@ data DroppedFile = DroppedFile { ...@@ -121,136 +111,96 @@ data DroppedFile = DroppedFile {
type FileHash = String type FileHash = String
data Action = Submit ID String data Action = Submit String
| DeleteNode ID | DeleteNode
| CreateSubmit ID String NodeType | CreateSubmit String NodeType
| SetNodeValue String ID | CurrentNode
| CurrentNode ID | UploadFile FileType UploadFileContents
| UploadFile ID FileType UploadFileContents
type State = { state :: FTree type State = { tree :: FTree
, currentNode :: Maybe ID , mCurrentNode :: Maybe ID
} }
mapFTree :: (FTree -> FTree) -> State -> State mapFTree :: (FTree -> FTree) -> State -> State
mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode} mapFTree f {tree, mCurrentNode} = {tree: f tree, mCurrentNode}
-- TODO: make it a local function -- TODO: make it a local function
performAction :: forall props. PerformAction State props Action --performAction :: forall props. PerformAction State props Action
performAction (DeleteNode nid) _ _ = do performAction :: R.State State -> Action -> Aff Unit
void $ lift $ deleteNode nid
modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
performAction (Submit rid name) _ _ = do performAction ({tree: NTree (LNode {id}) _} /\ setState) DeleteNode = do
void $ lift $ renameNode rid $ RenameValue {name} void $ deleteNode id
--modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
liftEffect $ setState $ mapFTree $ filterNTree $ \(LNode {id: nid}) -> nid /= id
performAction (CreateSubmit nid name nodeType) _ _ = do performAction ({tree: NTree (LNode {id}) _} /\ setState) (Submit name) = do
void $ lift $ createNode nid $ CreateValue {name, nodeType} void $ renameNode id $ RenameValue {name}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid --modifyState_ $ mapFTree $ setNodeName rid name
liftEffect $ setState $ \{tree: NTree (LNode node) arr, mCurrentNode} -> {tree: NTree (LNode node {name = name}) arr, mCurrentNode}
performAction (SetNodeValue v nid) _ _ = performAction ({tree: NTree (LNode {id}) _} /\ _) (CreateSubmit name nodeType) = do
modifyState_ $ mapFTree $ setNodeValue nid v void $ createNode id $ CreateValue {name, nodeType}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (CurrentNode nid) _ _ = performAction ({tree: NTree (LNode {id}) _} /\ setState) CurrentNode =
modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid} --modifyState_ $ \{state: s} -> {state: s, mCurrentNode : Just nid}
liftEffect $ setState $ \{tree} -> {tree, mCurrentNode : Just id}
performAction (UploadFile nid fileType contents) _ _ = do performAction ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- lift $ uploadFile nid fileType contents hashes <- uploadFile id fileType contents
liftEffect $ log2 "uploaded:" hashes liftEffect $ log2 "uploaded:" hashes
toggleIf :: Boolean -> Boolean -> Boolean
toggleIf true = not
toggleIf false = const false
onNode :: ID -> (LNode -> LNode) -> LNode -> LNode
onNode id f l@(LNode node)
| node.id == id = f l
| otherwise = l
--toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode ------------------------------------------------------------------------
--toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
-- where
-- droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
--toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
-- TODO: DRY, NTree.map
setNodeValue :: ID -> String -> NTree LNode -> NTree LNode
setNodeValue sid v (NTree (LNode node@{id}) ary) =
NTree (LNode $ node {nodeValue = nvalue}) $ map (setNodeValue sid v) ary
where
nvalue = if sid == id then v else ""
mCorpusId :: Maybe Router.Routes -> Maybe Int
mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing
type TreeViewProps = { tree :: FTree, mCurrentRoute :: Maybe Router.Routes }
------------------------------------------------------------------------ loadedTreeView :: TreeViewProps -> R.Element
-- TODO loadedTreeView p = R.createElement el p []
-- alignment to the right
nodeOptionsCorp :: Boolean -> Array ReactElement
nodeOptionsCorp activated = case activated of
true -> [ i [className "fab fa-whmcs" ] []]
false -> []
-- TODO
-- alignment to the right
-- on hover make other options available:
nodeOptionsView :: Boolean -> Array ReactElement
nodeOptionsView activated = case activated of
true -> [ i [className "glyphicon glyphicon-refresh" ] []
, i [className "glyphicon glyphicon-upload" ] []
, i [className "glyphicon glyphicon-share"] []
]
false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> ID -> Array ReactElement
nodeOptionsRename d activated id = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
] []
]
false -> []
type LoadedTreeViewProps = Loader.InnerProps Int FTree ()
loadedTreeview :: Spec State LoadedTreeViewProps Action
loadedTreeview = simpleSpec performAction render
where where
render :: Render State LoadedTreeViewProps Action el = R.hooksComponent "LoadedTreeView" cpt
render dispatch _ {state, currentNode} _ = cpt {tree, mCurrentRoute} _ = do
[ div [className "tree"] setState <- R.useState' {tree, mCurrentNode}
[ --toHtml dispatch state currentNode
(R2.scuff $ toHtml dispatch state currentNode)
]
]
treeViewClass :: ReactClass (Loader.InnerProps Int FTree (children :: React.Children))
treeViewClass = createClass "TreeView" loadedTreeview (\{loaded: t} -> {state: t, currentNode: Nothing})
treeLoaderClass :: Loader.LoaderClass Int FTree pure $ H.div {className: "tree"}
treeLoaderClass = Loader.createLoaderClass "TreeLoader" loadNode [ toHtml setState ]
where
treeLoader :: Loader.Props' Int FTree -> ReactElement mCurrentNode = mCorpusId mCurrentRoute
treeLoader props = React.createElement treeLoaderClass props []
treeview :: Spec {} Props Void treeview :: Spec {} Props Void
treeview = simpleSpec defaultPerformAction render treeview = simpleSpec defaultPerformAction render
where where
render :: Render {} Props Void render :: Render {} Props Void
render _ {root} _ _ = render _ props _ _ = [R2.scuff $ R.createElement cpt props []]
[ treeLoader { path: root
, component: treeViewClass cpt =
} ] R.hooksComponent "TreeView" \{root, mCurrentRoute} _children ->
useLoader root loadNode \currentPath loaded ->
loadedTreeView {tree: loaded, mCurrentRoute}
-- START Popup View
nodePopupView :: (Action -> Effect Unit) -> R.State (NTree LNode) -> R.Element type NodePopupProps =
nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}) _) /\ setNodeState) = ( id :: ID
R.createElement el {} [] , name :: Name)
nodePopupView :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
where where
el = R.hooksComponent "NodePopupView" cpt el = R.hooksComponent "NodePopupView" cpt
cpt props _ = do cpt {id, name} _ = do
renameBoxOpen <- R.useState' false renameBoxOpen <- R.useState' false
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
[ H.div {id: "arrow"} [] [ H.div {id: "arrow"} []
...@@ -263,22 +213,26 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen} ...@@ -263,22 +213,26 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
] ]
] ]
where where
tooltipProps = ({ className: "" tooltipProps = { className: ""
, id: "node-popup-tooltip" , id: "node-popup-tooltip"
, title: "Node settings" , title: "Node settings"
} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right" , data: {toggle: "tooltip", placement: "right"}
}
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"} iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
rowClass true = "col-md-10" rowClass true = "col-md-10"
rowClass false = "col-md-8" rowClass false = "col-md-8"
panelHeading renameBoxOpen@(open /\ _) = panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ H.div {className: "row" } [ H.div {className: "row" }
[ H.div {className: rowClass open} [ renameBox d nodeState renameBoxOpen ] [ H.div {className: rowClass open} [ renameBox d {id, name} renameBoxOpen ]
, editIcon renameBoxOpen , editIcon renameBoxOpen
, H.div {className: "col-md-2"} , H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle" [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ const (setPopOver false s) , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} [] ] ] ] , title: "Close"} []
]
]
]
glyphicon t = "glyphitem glyphicon glyphicon-" <> t glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon (false /\ setRenameBoxOpen) = editIcon (false /\ setRenameBoxOpen) =
H.div {className: "col-md-2"} H.div {className: "col-md-2"}
...@@ -286,7 +240,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen} ...@@ -286,7 +240,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, className: "btn glyphitem glyphicon glyphicon-pencil" , className: "btn glyphitem glyphicon glyphicon-pencil"
, id: "rename1" , id: "rename1"
, title: "Rename" , title: "Rename"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen (const true) , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const true
} }
[] []
] ]
...@@ -312,7 +266,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen} ...@@ -312,7 +266,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, title: "Upload [WIP]"} , title: "Upload [WIP]"}
[] []
] ]
, H.div {className: "col-md-4"} , H.div {className: "col-md-4"}
[ H.a {style: iconAStyle [ H.a {style: iconAStyle
, className: (glyphicon "refresh") , className: (glyphicon "refresh")
...@@ -326,7 +280,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen} ...@@ -326,7 +280,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, className: (glyphicon "trash") , className: (glyphicon "trash")
, id: "rename2" , id: "rename2"
, title: "Delete" , title: "Delete"
, onClick: mkEffectFn1 $ (\_-> d $ (DeleteNode id))} , onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[] []
] ]
] ]
...@@ -337,21 +291,29 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen} ...@@ -337,21 +291,29 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, className: (glyphicon "plus") , className: (glyphicon "plus")
, id: "create" , id: "create"
, title: "Create" , title: "Create"
, onClick: mkEffectFn1 $ \_ -> setNodeState (const $ setCreateOpen (not createOpen) $ setPopOver false s) , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const $ Just CreatePopup
} }
[] []
] ]
nodePopupView _ _ = R.createElement el {} [] nodePopupView _ p _ = R.createElement el p []
where where
el = R.hooksComponent "CreateNodeView" cpt el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} [] cpt _ _ = pure $ H.div {} []
-- END Popup View
renameBox :: (Action -> Effect Unit) -> R.State (NTree LNode) -> R.State Boolean -> R.Element
renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameBoxOpen) = R.createElement el {} [] -- START Rename Box
type RenameBoxProps =
( id :: ID
, name :: Name)
renameBox :: (Action -> Aff Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
where where
el = R.hooksComponent "RenameBox" cpt el = R.hooksComponent "RenameBox" cpt
cpt props _ = do cpt {id, name} _ = do
renameNodeName <- R.useState' name renameNodeName <- R.useState' name
pure $ H.div {className: "from-group row-no-padding"} pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName [ renameInput renameNodeName
...@@ -365,34 +327,39 @@ renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameB ...@@ -365,34 +327,39 @@ renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameB
, placeholder: "Rename Node" , placeholder: "Rename Node"
, defaultValue: name , defaultValue: name
, className: "form-control" , className: "form-control"
, onInput: mkEffectFn1 $ \e -> setRenameNodeName (const $ e .. "target" .. "value") , onInput: mkEffectFn1 $ \e -> setRenameNodeName $ const $ e .. "target" .. "value"
} }
] ]
renameBtn (newName /\ _) = renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left" H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button" , type: "button"
, onClick: mkEffectFn1 $ \_ -> do , onClick: mkEffectFn1 $ \_ -> do
setNodeState (setPopOver false <<< setName newName) setRenameBoxOpen $ const false
d (Submit id newName) launchAff $ d $ Submit newName
, title: "Rename" , title: "Rename"
} [] } []
cancelBtn = cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left" H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button" , type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen (const false) , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel" , title: "Cancel"
} [] } []
renameBox _ (s@(NTree (LNode {name}) _) /\ _) (false /\ _) = R.createElement el {} [] renameBox _ p (false /\ _) = R.createElement el p []
where where
el = R.hooksComponent "RenameBox" cpt el = R.hooksComponent "RenameBox" cpt
cpt props _ = pure $ H.div {} [ H.text name ] cpt {name} _ = pure $ H.div {} [ H.text name ]
-- END Rename Box
createNodeView :: (Action -> Effect Unit) -> R.State FTree -> R.Element type CreateNodeProps =
createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNodeState) = R.createElement el {} [] ( id :: ID
, name :: Name)
createNodeView :: (Action -> Aff Unit) -> Record CreateNodeProps -> R.State (Maybe NodePopup) -> R.Element
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
where where
el = R.hooksComponent "CreateNodeView" cpt el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = do cpt {id, name} _ = do
nodeName <- R.useState' "" nodeName <- R.useState' ""
nodeType <- R.useState' Corpus nodeType <- R.useState' Corpus
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
...@@ -403,9 +370,11 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo ...@@ -403,9 +370,11 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
] ]
] ]
where where
tooltipProps = ({ className: "" tooltipProps = { className: ""
, id: "create-node-tooltip" , id: "create-node-tooltip"
, title: "Create new node"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right" , title: "Create new node"
, data: {toggle: "tooltip", placement: "right"}
}
panelHeading = panelHeading =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ H.div {className: "row"} [ H.div {className: "row"}
...@@ -413,7 +382,7 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo ...@@ -413,7 +382,7 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
[ H.h5 {} [H.text "Create Node"] ] [ H.h5 {} [H.text "Create Node"] ]
, H.div {className: "col-md-2"} , H.div {className: "col-md-2"}
[ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle" [ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState (setCreateOpen false) , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} [] , title: "Close"} []
] ]
] ]
...@@ -427,14 +396,14 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo ...@@ -427,14 +396,14 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
[ H.div {className: "form-group"} [ H.div {className: "form-group"}
[ H.input { type: "text" [ H.input { type: "text"
, placeholder: "Node name" , placeholder: "Node name"
, defaultValue: getCreateNodeValue s , defaultValue: name
, className: "form-control" , className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName (const $ e .. "target" .. "value") , onInput: mkEffectFn1 $ \e -> setNodeName $ const $ e .. "target" .. "value"
} }
] ]
, H.div {className: "form-group"} , H.div {className: "form-group"}
[ R2.select { className: "form-control" [ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType (const $ readNodeType $ e .. "target" .. "value") , onChange: mkEffectFn1 $ \e -> setNodeType $ const $ readNodeType $ e .. "target" .. "value"
} }
(map renderOption [Corpus, Folder]) (map renderOption [Corpus, Folder])
] ]
...@@ -448,19 +417,26 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo ...@@ -448,19 +417,26 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
H.div {className: "panel-footer"} H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success" [ H.button {className: "btn btn-success"
, type: "button" , type: "button"
, onClick: mkEffectFn1 $ \_ -> d $ (CreateSubmit id name nt) , onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
launchAff $ d $ CreateSubmit name nt
} [H.text "Create"] } [H.text "Create"]
] ]
createNodeView _ _ = R.createElement el {} [] createNodeView _ _ _ = R.createElement el {} []
where where
el = R.hooksComponent "CreateNodeView" cpt el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} [] cpt props _ = pure $ H.div {} []
fileTypeView :: (Action -> Effect Unit) -> R.State FTree -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element -- START File Type View
fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el {} []
type FileTypeProps =
( id :: ID )
fileTypeView :: (Action -> Aff Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
where where
el = R.hooksComponent "FileTypeView" cpt el = R.hooksComponent "FileTypeView" cpt
cpt props _ = do cpt {id} _ = do
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"} [ H.div {className: "panel panel-default"}
[ panelHeading [ panelHeading
...@@ -469,9 +445,11 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil ...@@ -469,9 +445,11 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
] ]
] ]
where where
tooltipProps = ({ className: "" tooltipProps = { className: ""
, id: "file-type-tooltip" , id: "file-type-tooltip"
, title: "Choose file type"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right" , title: "Choose file type"
, data: {toggle: "tooltip", placement: "right"}
}
panelHeading = panelHeading =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ H.div {className: "row"} [ H.div {className: "row"}
...@@ -480,8 +458,8 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil ...@@ -480,8 +458,8 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
, H.div {className: "col-md-2"} , H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle" [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> do , onClick: mkEffectFn1 $ \_ -> do
setDroppedFile (const Nothing) setDroppedFile $ const Nothing
setIsDragOver (const false) setIsDragOver $ const false
, title: "Close"} [] , title: "Close"} []
] ]
] ]
...@@ -494,7 +472,7 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil ...@@ -494,7 +472,7 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
] ]
where where
onChange = mkEffectFn1 $ \e -> onChange = mkEffectFn1 $ \e ->
setDroppedFile (const $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}) setDroppedFile $ const $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}
renderOption opt = H.option {} [ H.text $ show opt ] renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter = panelFooter =
H.div {className: "panel-footer"} H.div {className: "panel-footer"}
...@@ -504,8 +482,8 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil ...@@ -504,8 +482,8 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
H.button {className: "btn btn-success" H.button {className: "btn btn-success"
, type: "button" , type: "button"
, onClick: mkEffectFn1 $ \_ -> do , onClick: mkEffectFn1 $ \_ -> do
setDroppedFile (const Nothing) setDroppedFile $ const Nothing
d $ (UploadFile id ft contents) launchAff $ d $ UploadFile ft contents
} [H.text "Upload"] } [H.text "Upload"]
Nothing -> Nothing ->
H.button {className: "btn btn-success disabled" H.button {className: "btn btn-success disabled"
...@@ -517,111 +495,139 @@ fileTypeView _ _ (Nothing /\ _) _ = R.createElement el {} [] ...@@ -517,111 +495,139 @@ fileTypeView _ _ (Nothing /\ _) _ = R.createElement el {} []
el = R.hooksComponent "FileTypeView" cpt el = R.hooksComponent "FileTypeView" cpt
cpt props _ = pure $ H.div {} [] cpt props _ = pure $ H.div {} []
getCreateNodeValue :: FTree -> String -- END File Type View
getCreateNodeValue (NTree (LNode {nodeValue}) ary) = nodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> R.Element toHtml :: R.State State -> R.Element
toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} [] --toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
toHtml setState@({tree: (NTree (LNode {id, name, nodeType}) ary), mCurrentNode} /\ _) = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction setState
cpt props _ = do cpt props _ = do
nodeState <- R.useState' s
folderOpen <- R.useState' true folderOpen <- R.useState' true
droppedFile <- R.useState' Nothing
isDragOver <- R.useState' false
pure $ H.ul {} pure $ H.ul {}
[ H.li {} [ H.li {}
( [ mainSpan nodeState folderOpen droppedFile isDragOver ] ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentNode} folderOpen ]
<> childNodes d n ary folderOpen <> childNodes mCurrentNode ary folderOpen
) )
] ]
type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentNode :: Maybe ID)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> R.Element
nodeMainSpan d p folderOpen = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentNode} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (toUrl Front nodeType (Just id))
, style: {"margin-left": "22px"}
, onClick: mkEffectFn1 $ \e -> launchAff $ d $ CurrentNode
}
[ nodeText {isSelected: mCurrentNode == (Just id), name} ]
, popOverIcon popupOpen
, nodePopupView d {id, name} popupOpen
, createNodeView d {id, name} popupOpen
, fileTypeView d {id} droppedFile isDragOver
]
folderIcon folderOpen@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen}
[ H.i {className: fldr open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setPopOver $ toggle
} []
where where
mainSpan :: R.State FTree -> R.State Boolean -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element toggle Nothing = Just NodePopup
mainSpan nodeState folderOpen droppedFile isDragOver = toggle _ = Nothing
H.span (dropProps droppedFile isDragOver) dropProps droppedFile isDragOver = {
[ folderIcon folderOpen className: dropClass droppedFile isDragOver
, H.a { href: if nodeType == Phylo then (toUrl Static nodeType (Just id)) , onDrop: dropHandler droppedFile
else (toUrl Front nodeType (Just id)) , onDragOver: onDragOverHandler isDragOver
, target : if nodeType == Phylo then "blank" else "" , onDragLeave: onDragLeave isDragOver
, style: {"margin-left": "22px"} }
, onClick: mkEffectFn1 $ (\e -> d $ CurrentNode id) dropClass (Just _ /\ _) _ = "file-dropped"
} dropClass _ (true /\ _) = "file-dropped"
[ nodeText s n ] dropClass (Nothing /\ _) _ = ""
, popOverIcon nodeState dropHandler (_ /\ setDroppedFile) = mkEffectFn1 $ \e -> unsafePartial $ do
, nodePopupView d nodeState let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
, createNodeView d nodeState liftEffect $ log2 "drop:" ff
, fileTypeView d nodeState droppedFile isDragOver -- prevent redirection when file is dropped
] E.preventDefault e
folderIcon :: R.State Boolean -> R.Element E.stopPropagation e
folderIcon folderOpen@(open /\ _) = let blob = toBlob $ ff
H.a {onClick: R2.effToggler folderOpen} void $ runAff (\_ -> pure unit) do
[ H.i {className: fldr open} [] ] contents <- readAsText blob
dropProps droppedFile isDragOver = { liftEffect $ setDroppedFile $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
className: dropClass droppedFile isDragOver onDragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
, onDrop: dropHandler droppedFile -- prevent redirection when file is dropped
, onDragOver: dragOverHandler isDragOver -- https://stackoverflow.com/a/6756680/941471
, onDragLeave: dragLeave isDragOver E.preventDefault e
} E.stopPropagation e
dropClass (Just _ /\ _) _ = "file-dropped" setIsDragOver $ const true
dropClass _ (true /\ _) = "file-dropped" onDragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver $ const false
dropClass (Nothing /\ _) _ = ""
dropHandler :: forall e. R.State (Maybe DroppedFile) -> EffectFn1 (E.SyntheticEvent_ e) Unit
dropHandler (_ /\ setDroppedFile) = mkEffectFn1 $ \e -> unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
let blob = toBlob $ ff
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile (const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV})
dragOverHandler :: forall e. R.State Boolean -> EffectFn1 (E.SyntheticEvent_ e) Unit
dragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver (const true)
dragLeave :: forall e. R.State Boolean -> EffectFn1 e Unit
dragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver (const false)
childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) -> R.State Boolean -> Array R.Element
childNodes d n [] _ = []
childNodes d n _ (false /\ _) = []
childNodes d n ary (true /\ _) = map (\cs -> toHtml d cs n) ary
nodeText :: FTree -> Maybe Int -> R.Element
nodeText (NTree (LNode {id, name}) _) n = if n == (Just id) then
H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
else
H.text (name <> " ")
popOverIcon :: R.State FTree -> R.Element
popOverIcon (s@(NTree (LNode {popOver}) _) /\ setNodeState) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setNodeState (setPopOver (not popOver))
} []
fldr :: Boolean -> String fldr :: Boolean -> String
fldr open = if open then "fas fa-folder-open" else "fas fa-folder" fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: Maybe ID -> Array FTree -> R.State Boolean -> Array R.Element
childNodes _ [] _ = []
childNodes _ _ (false /\ _) = []
childNodes n ary (true /\ _) = map (\ctree -> childNode {tree: ctree, mCurrentNode: n}) ary
where
childNode :: State -> R.Element
childNode props = R.createElement el props []
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, mCurrentNode} _ = do
setState <- R.useState' {tree, mCurrentNode}
pure $ toHtml setState
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name )
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
where
el = R.hooksComponent "NodeText" cpt
cpt {isSelected: true, name} _ = do
pure $ H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
loadNode :: ID -> Aff FTree loadNode :: ID -> Aff FTree
-- loadNode a = lift ((get <<< toUrl Back Tree <<< Just) a)
loadNode = get <<< toUrl Back Tree <<< Just loadNode = get <<< toUrl Back Tree <<< Just
----- TREE CRUD Operations ----- TREE CRUD Operations
newtype RenameValue = RenameValue newtype RenameValue = RenameValue
{ {
name :: String name :: Name
} }
instance encodeJsonRenameValue :: EncodeJson RenameValue where instance encodeJsonRenameValue :: EncodeJson RenameValue where
...@@ -631,7 +637,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -631,7 +637,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
newtype CreateValue = CreateValue newtype CreateValue = CreateValue
{ {
name :: String name :: Name
, nodeType :: NodeType , nodeType :: NodeType
} }
......
src/Gargantext/Config.purs
View file @ ed807a2e
...@@ -14,13 +14,10 @@ import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson ...@@ -14,13 +14,10 @@ import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Map (Map)
import Data.Map as DM
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..))
import Gargantext.Router as R import Gargantext.Router as R
import Gargantext.Types import Gargantext.Types (TermList, TermSize(..))
urlPlease :: End -> String -> String urlPlease :: End -> String -> String
urlPlease end path = theEnd.baseUrl <> theEnd.prePath <> path urlPlease end path = theEnd.baseUrl <> theEnd.prePath <> path
...@@ -62,6 +59,11 @@ frontDev = { baseUrl: "https://dev.gargantext.org" ...@@ -62,6 +59,11 @@ frontDev = { baseUrl: "https://dev.gargantext.org"
, prePath: "/#/" , prePath: "/#/"
} }
frontDemo :: Config
frontDemo = { baseUrl: "https://demo.gargantext.org"
, prePath: "/#/"
}
frontProd :: Config frontProd :: Config
frontProd = { baseUrl: "https://gargantext.org" frontProd = { baseUrl: "https://gargantext.org"
, prePath: "/#/" , prePath: "/#/"
...@@ -210,6 +212,7 @@ routesPath R.SearchView = "search" ...@@ -210,6 +212,7 @@ routesPath R.SearchView = "search"
routesPath (R.Folder i) = "folder/" <> show i routesPath (R.Folder i) = "folder/" <> show i
routesPath (R.Corpus i) = "corpus/" <> show i routesPath (R.Corpus i) = "corpus/" <> show i
routesPath R.AddCorpus = "addCorpus" routesPath R.AddCorpus = "addCorpus"
routesPath (R.CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i
routesPath (R.PGraphExplorer i) = "#/" routesPath (R.PGraphExplorer i) = "#/"
routesPath R.Dashboard = "dashboard" routesPath R.Dashboard = "dashboard"
......
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs/Specs.purs
View file @ ed807a2e
...@@ -6,6 +6,7 @@ import Prelude hiding (div) ...@@ -6,6 +6,7 @@ import Prelude hiding (div)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.List (fromFoldable) import Data.List (fromFoldable)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Config (TabType(..), TabSubType(..), PTabNgramType(..)) import Gargantext.Config (TabType(..), TabSubType(..), PTabNgramType(..))
...@@ -48,7 +49,8 @@ statefulTabs = ...@@ -48,7 +49,8 @@ statefulTabs =
{ nodeId, chart { nodeId, chart
, tabType: TabPairing TabDocs , tabType: TabPairing TabDocs
, totalRecords: 4736 , totalRecords: 4736
, listId: loaded.defaultListId}) $ , listId: loaded.defaultListId
, corpusId: Nothing}) $
noState DT.docViewSpec noState DT.docViewSpec
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
......
src/Gargantext/Pages/Corpus/Document.purs
View file @ ed807a2e
...@@ -24,7 +24,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField ...@@ -24,7 +24,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Types (TermList) import Gargantext.Types (TermList)
import Gargantext.Utils.Reactix ( scuff ) import Gargantext.Utils.Reactix ( scuff )
type DocPath = { nodeId :: Int, listIds :: Array Int, tabType :: TabType } type DocPath = { nodeId :: Int, listIds :: Array Int, corpusId :: Maybe Int, tabType :: TabType }
type NodeDocument = NodePoly Document type NodeDocument = NodePoly Document
...@@ -333,8 +333,8 @@ docViewSpec = simpleSpec performAction render ...@@ -333,8 +333,8 @@ docViewSpec = simpleSpec performAction render
badge s = span [className "badge badge-default badge-pill"] [text s] badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata : Document doc} = document
layout :: Spec {} {nodeId :: Int, listId :: Int} Void layout :: Spec {} {nodeId :: Int, listId :: Int, corpusId :: Maybe Int} Void
layout = cmapProps (\{nodeId, listId} -> {nodeId, listIds: [listId], tabType}) layout = cmapProps (\{nodeId, listId, corpusId} -> {nodeId, listIds: [listId], corpusId, tabType})
$ simpleSpec defaultPerformAction render $ simpleSpec defaultPerformAction render
where where
tabType = TabDocument (TabNgramType CTabTerms) tabType = TabDocument (TabNgramType CTabTerms)
......
src/Gargantext/Pages/Corpus/Graph.purs
View file @ ed807a2e
...@@ -419,7 +419,7 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render'] ...@@ -419,7 +419,7 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
Nothing -> Nothing ->
simpleSpec defaultPerformAction defaultRender simpleSpec defaultPerformAction defaultRender
Just treeId -> Just treeId ->
(cmapProps (const {root: treeId}) (noState Tree.treeview)) (cmapProps (const {root: treeId, mCurrentRoute: Nothing}) (noState Tree.treeview))
render' :: Render State {} Action render' :: Render State {} Action
......
src/Gargantext/Pages/Corpus/Tabs/Specs.purs
View file @ ed807a2e
...@@ -8,7 +8,6 @@ import Data.List (fromFoldable) ...@@ -8,7 +8,6 @@ import Data.List (fromFoldable)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Config (TabType(..), TabSubType(..))
import Gargantext.Config (CTabNgramType(..), End(..), Path(..), TabSubType(..), TabType(..), toUrl) import Gargantext.Config (CTabNgramType(..), End(..), Path(..), TabSubType(..), TabType(..), toUrl)
import Gargantext.Pages.Corpus.Tabs.Types (Props) import Gargantext.Pages.Corpus.Tabs.Types (Props)
...@@ -59,22 +58,24 @@ statefulTabs = ...@@ -59,22 +58,24 @@ statefulTabs =
where where
-- TODO totalRecords -- TODO totalRecords
docs = noState ( cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType: TabCorpus TabDocs}) histoSpec docs = noState ( cmapProps (\{path: corpusId} -> {corpusId, tabType: TabCorpus TabDocs}) histoSpec
<> <>
(cmapProps (\{path: nodeId, loaded: loaded} -> (cmapProps (\{path: nodeId, loaded} ->
{ nodeId : nodeId { nodeId
, chart : div [][] , chart : div [][]
, tabType: TabCorpus TabDocs , tabType: TabCorpus TabDocs
, totalRecords: 4737 , totalRecords: 4737
, listId: loaded.defaultListId}) $ noState DT.docViewSpec , listId: loaded.defaultListId
, corpusId: Just nodeId}) $ noState DT.docViewSpec
) )
) )
trash = cmapProps (\{path: nodeId, loaded: loaded} -> trash = cmapProps (\{path: nodeId, loaded} ->
{ nodeId { nodeId
, chart: div [][] , chart: div [][]
, tabType: TabCorpus TabTrash , tabType: TabCorpus TabTrash
, totalRecords: 4736 , totalRecords: 4736
, listId: loaded.defaultListId}) $ noState DT.docViewSpec , listId: loaded.defaultListId
, corpusId: Nothing}) $ noState DT.docViewSpec
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
...@@ -86,13 +87,13 @@ ngramsViewSpec {mode} = ...@@ -86,13 +87,13 @@ ngramsViewSpec {mode} =
) )
where where
tabType = TabCorpus $ TabNgramType $ modeTabType mode tabType = TabCorpus $ TabNgramType $ modeTabType mode
chart Authors = cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType}) pieSpec chart Authors = cmapProps (\{path: corpusId} -> {corpusId, tabType}) pieSpec
chart Sources = cmapProps (\{path: corpusId} -> {corpusId : corpusId, tabType}) barSpec chart Sources = cmapProps (\{path: corpusId} -> {corpusId, tabType}) barSpec
chart Institutes = cmapProps (\{loaded: {defaultListId}, path: corpusId} -> chart Institutes = cmapProps (\{loaded: {defaultListId}, path: corpusId} ->
{corpusId, listId: defaultListId, tabType, limit: (Just 1000)}) {corpusId, listId: defaultListId, tabType, limit: (Just 1000)})
treeSpec treeSpec
chart Terms = cmapProps (\{loaded: {defaultListId}, path: corpusId} -> chart Terms = cmapProps (\{loaded: {defaultListId}, path: corpusId} ->
{corpusId, listId: defaultListId, tabType, limit: (Just 1000)}) {corpusId, listId: defaultListId, tabType, limit: (Just 1000)})
-- TODO limit should be select in the chart by default it is 1000 -- TODO limit should be select in the chart by default it is 1000
......
src/Gargantext/Pages/Layout.purs
View file @ ed807a2e
...@@ -48,6 +48,9 @@ dispatchAction dispatcher _ (Annuaire id) = do ...@@ -48,6 +48,9 @@ dispatchAction dispatcher _ (Annuaire id) = do
dispatchAction dispatcher _ (Folder id) = do dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (CorpusDocument c i n) = do
dispatcher $ SetRoute $ CorpusDocument c i n
dispatchAction dispatcher _ (Document i n) = do dispatchAction dispatcher _ (Document i n) = do
dispatcher $ SetRoute $ Document i n dispatcher $ SetRoute $ Document i n
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ ed807a2e
...@@ -60,7 +60,8 @@ pagesComponent s = case s.currentRoute of ...@@ -60,7 +60,8 @@ pagesComponent s = case s.currentRoute of
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (Document l i) = layout0 $ cmapProps (const {nodeId: i, listId: l}) $ noState Annotation.layout selectSpec (CorpusDocument c l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Just c}) $ noState Annotation.layout
selectSpec (Document l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Nothing}) $ noState Annotation.layout
selectSpec (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
...@@ -89,14 +90,13 @@ layout0 layout = ...@@ -89,14 +90,13 @@ layout0 layout =
withState \st -> withState \st ->
case st.loginState.authData of case st.loginState.authData of
Just (AuthData {tree_id}) -> Just (AuthData {tree_id}) ->
ls $ cmapProps (const {root: tree_id}) as ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute}) as
Nothing -> Nothing ->
outerLayout1 outerLayout1
, rs bs , rs bs
] ]
ls = over _render \render d p s c -> [ ls = over _render \render d p s c -> [
div [ className "col-md-2", style {paddingTop: "60px"} ] $ render d p s c div [ className "col-md-2", style {paddingTop: "60px"} ] $ render d p s c
] ]
rs = over _render \render d p s c -> [ rs = over _render \render d p s c -> [
div [ case (s.loginState.authData) of div [ case (s.loginState.authData) of
...@@ -138,7 +138,7 @@ layout1 layout = ...@@ -138,7 +138,7 @@ layout1 layout =
[ withState \st -> [ withState \st ->
case st.loginState.authData of case st.loginState.authData of
Just (AuthData {tree_id}) -> Just (AuthData {tree_id}) ->
ls $ cmapProps (const {root: tree_id}) as ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute}) as
Nothing -> Nothing ->
outerLayout1 outerLayout1
, rs bs , rs bs
......
src/Gargantext/Router.purs
View file @ ed807a2e
...@@ -21,6 +21,7 @@ data Routes ...@@ -21,6 +21,7 @@ data Routes
| Corpus Int | Corpus Int
| AddCorpus | AddCorpus
| Document Int Int | Document Int Int
| CorpusDocument Int Int Int
| PGraphExplorer Int | PGraphExplorer Int
| Dashboard | Dashboard
| Annuaire Int | Annuaire Int
...@@ -33,6 +34,7 @@ routing = oneOf ...@@ -33,6 +34,7 @@ routing = oneOf
, SearchView <$ route "search" , SearchView <$ route "search"
, AddCorpus <$ route "addCorpus" , AddCorpus <$ route "addCorpus"
, Folder <$> (route "folder" *> int) , Folder <$> (route "folder" *> int)
, CorpusDocument <$> (route "corpus" *> int) <*> (lit "list" *> int) <*> (lit "document" *> int)
, Corpus <$> (route "corpus" *> int) , Corpus <$> (route "corpus" *> int)
, Document <$> (route "list" *> int) <*> (lit "document" *> int) , Document <$> (route "list" *> int) <*> (lit "document" *> int)
, Dashboard <$ route "dashboard" , Dashboard <$ route "dashboard"
...@@ -42,10 +44,10 @@ routing = oneOf ...@@ -42,10 +44,10 @@ routing = oneOf
, ContactPage <$> (route "contact" *> int) , ContactPage <$> (route "contact" *> int)
, Home <$ lit "" , Home <$ lit ""
] ]
where where
route str = lit "" *> lit str route str = lit "" *> lit str
int :: Match Int int :: Match Int
int = floor <$> num int = floor <$> num
...@@ -55,6 +57,7 @@ instance showRoutes :: Show Routes where ...@@ -55,6 +57,7 @@ instance showRoutes :: Show Routes where
show SearchView = "Search" show SearchView = "Search"
show (UserPage i) = "User" <> show i show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i show (ContactPage i) = "Contact" <> show i
show (CorpusDocument _ _ i) = "Document" <> show i
show (Document _ i) = "Document" <> show i show (Document _ i) = "Document" <> show i
show (Corpus i) = "Corpus" <> show i show (Corpus i) = "Corpus" <> show i
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> show i
......
src/Gargantext/Utils/Reactix.purs
View file @ ed807a2e
...@@ -45,4 +45,4 @@ select :: ElemFactory ...@@ -45,4 +45,4 @@ select :: ElemFactory
select = createDOMElement "select" select = createDOMElement "select"
effToggler :: forall e. R.State Boolean -> EffectFn1 e Unit effToggler :: forall e. R.State Boolean -> EffectFn1 e Unit
effToggler (_value /\ setValue) = mkEffectFn1 $ \e -> setValue not effToggler (value /\ setValue) = mkEffectFn1 $ \e -> setValue $ const $ not value
src/index.html 0 → 100644
View file @ ed807a2e
<!doctype>
<html>
<head>
<meta charset="utf-8"/>
<title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet">
<link href="https://use.fontawesome.com/releases/v5.0.8/styles/all.css" rel="stylesheet">
<link href="styles/login.min.css" rel="stylesheet">
<link href="styles/bootstrap.min.css" rel="stylesheet">
<!-- <link href="styles/lavish-bootstrap.css" rel="stylesheet"> -->
<link rel="stylesheet" type="text/css" href="styles/context-menu.css"/>
<link rel="stylesheet" type="text/css" href="styles/menu.css"/>
<link href="styles/Login.css" rel="stylesheet">
<style>
* {margin: 0; padding: 0; list-style: none;}
.tree ul li {
margin-left: 15px;
position: relative;
padding-left: 5px;
}
#toolbar {display : inline;}
#toolbar ul li {display : inline }
#toolbar ul li form {display : inline}
.tree { margin-top : 20px;}
.tree ul li::before {
content: " ";
position: absolute;
width: 1px;
background-color: #000;
top: 5px;
bottom: -12px;
left: -10px;
}
body > .tree ul > li:first-child::before {top: 12px;}
.tree ul li:not(:first-child):last-child::before {display: none;}
.tree ul li:only-child::before {
display: list-item;
content: " ";
position: absolute;
width: 1px;
background-color: "#000";
top: 5px;
bottom: 7px;
height: 7px;
left: -10px;
}
.tree ul li::after {
content: " ";
position: absolute;
left: -10px;
width: 10px;
height: 1px;
background-color: "#000";
top: 12px;
}
</style>
</head>
<body>
<div id="app" class ="container-fluid"></div>
<div id="menu-portal"></div>
<script src="bundle.js"></script>
<script src="js/bootstrap-native.min.js"></script>
</body>
</html>
src/index.js 0 → 100644
View file @ ed807a2e
// This file is just a wrapper so that webpack will call our main function
require('./Main.purs').main();
webpack.config.js 0 → 100644
View file @ ed807a2e
'use strict';
let webpack = require('webpack');
let path = require('path');
let exec = require('executive');
let nodeExternals = require('webpack-node-externals');
let isWebpackDevServer = process.argv.some(a => path.basename(a) === 'webpack-dev-server');
let HtmlWebpackPlugin = require('html-webpack-plugin');
let CleanWebpackPlugin = require('clean-webpack-plugin');
let isWatch = process.argv.some(a => a === '--watch');
// TODO: We have agreed to move to spago, but not done it yet
// let spago_sources = async () =>
// exec.quiet(
// "psc-package sources",
// { options: 'strict' }
// ).then(function (res) {
// let sources = res.stdout.split(/\r?\n/);
// sources.pop(); // extra newline at the end of output
// return sources;
// });
let dist = path.join(__dirname, 'dist');
let src = path.join(__dirname, 'src');
let test = path.join(__dirname, 'test');
// kill when spago
let futured = async () => new Promise((resolve, _) => resolve([]));
module.exports = (env) =>
// spago_sources()
futured()
.then(function (ps_sources) {
ps_sources.push('src/**/*.purs');
// TODO: testing in browser and headless
// if (env === "browser" || env === "headless")
// ps_sources.push('test/Main.purs');
let config = {
cache: true,
mode: 'development',
target: "web",
devtool: 'inline-source-map',
devServer: {
disableHostCheck: true,
contentBase: dist,
compress: true,
port: 8000
},
output: {
path: dist,
filename: 'bundle.js'
},
module: {
rules: [
{test: /\.purs$/,
exclude: /(node_modules)/,
use: [
{loader: "purs-loader",
options: {
src: ps_sources,
output: dist,
pscIde: true,
pscIdeClientArgs: {port: 4002},
pscIdeServerArgs: {port: 4002},
pscArgs: {codegen: "js,sourcemaps"},
pscPackage: true,
bundle: false,
watch: isWatch}},
{loader: "source-map-loader"},
]},
{test: /\.css$/,
exclude: /(node_modules)/,
use: ["style-loader", "css-loader"]},
{test: /\.(png|jpg|gif|svg)$/,
exclude: /(node_modules)/,
use: [ "file-loader" ]},
{test: /\.js$/,
exclude: /(node_modules)/,
use: ["babel-loader", "source-map-loader"]}
]
},
resolve: {
modules: [ 'node_modules' ],
extensions: [ '.purs', '.js']
},
plugins: [
// TODO: can we put the checked-in assets in dist somewhere else
// and move them into place so we can clean?
// new CleanWebpackPlugin(['dist']),
new webpack.LoaderOptionsPlugin({debug: true})
],
entry: path.join(src, "index.js")
};
switch(env) {
case 'dev':
console.log("Serving index.html from template src/index.html")
config.plugins.push(new HtmlWebpackPlugin({
template: path.join(src, "index.html")
}));
break;
// TODO: testing environments - browser and headless
// case 'browser':
// config.plugins.push(new HtmlWebpackPlugin({
// title: "Reactix",
// template: path.join(test, "browser.html")
// }));
// break;
// case 'headless': break;
default:
console.log("unknown env: ", env);
}
return config;
});
yarn.lock
View file @ ed807a2e
This source diff could not be displayed because it is too large. You can view the blob instead.
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