Commit b4aba663 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-node-calc-parser

parents 6e088030 a969007f
...@@ -126,6 +126,20 @@ brew install yarn ...@@ -126,6 +126,20 @@ brew install yarn
For other platforms, please refer to [the yarn website](https://www.yarnpkg.com/). For other platforms, please refer to [the yarn website](https://www.yarnpkg.com/).
#### Purescript build tools
Once you have yarn installed you can install the necessary purescript build tools:
```shell
yarn global add purescript spago pulp
```
In order to use those tools you might need to add the yarn global package install location to your path. On linux this can be done by adding the following line at the end of your `.bashrc` file:
```shell
export PATH="$(yarn global bin):$PATH"
```
## Development ## Development
### Docker environment ### Docker environment
......
This diff is collapsed.
This diff is collapsed.
...@@ -1138,4 +1138,572 @@ select.form-control { ...@@ -1138,4 +1138,572 @@ select.form-control {
width: 100%; width: 100%;
} }
/* fonts */
@font-face {
font-family: "Inter-Regular";
font-style: normal;
font-weight: 400;
src: url("../fonts/phylo/Inter-Regular.woff2") format("woff2"), url("../fonts/phylo/Inter-Regular.woff") format("woff");
}
@font-face {
font-family: "Inter-Bold";
font-style: normal;
font-weight: 700;
src: url("../fonts/phylo/Inter-Bold.woff2") format("woff2"), url("../fonts/phylo/Inter-Bold.woff") format("woff");
}
/* grid */
.phylo {
font-family: "Inter-Regular";
font-size: 16px;
display: grid;
grid-template-columns: repeat(15, 1fr);
grid-template-rows: 2% 7% 7% auto 1%;
grid-gap: 10px;
height: 100vh;
color: #0d1824;
}
/* ---- row 1 ---- */
.phylo-title {
grid-row: 1;
grid-column: 1/2;
align-items: center;
text-align: right;
margin-top: 0.5px;
}
.phylo-folder {
grid-row: 1;
grid-column: 2/16;
align-items: center;
}
/* -------------------- */
.phylo-corpus {
grid-row: 2/3;
grid-column: 1/2;
/*background : #3E75B3;*/
font-size: 14px;
display: flex;
align-items: center;
justify-content: right;
}
.phylo-phylo {
grid-row: 3/4;
grid-column: 1/2;
font-size: 14px;
display: flex;
align-items: center;
justify-content: right;
}
.phylo-corpus-info {
grid-row: 2/3;
grid-column: 2/4;
font-size: 14px;
display: flex;
flex-direction: column;
justify-content: center;
}
.phylo-phylo-info {
grid-row: 3/4;
grid-column: 2/4;
font-size: 14px;
display: flex;
flex-direction: column;
justify-content: center;
}
.phylo-how {
grid-row: 2/4;
grid-column: 1/2;
z-index: 2;
display: flex;
align-items: center;
justify-content: right;
}
.phylo-isoline {
grid-row: 2/4;
grid-column: 3/15;
/*background: rgba(223,216,200,0.25); */
}
.phylo-isoline-info {
grid-row: 2/4;
grid-column: 15/16;
padding-top: 20%;
padding-bottom: 20%;
padding-left: 15px;
}
.phylo-isoline-info .btn-group {
display: initial;
}
/* -------------------- */
.phylo-scape {
grid-row: 4;
grid-column: 1/15;
/*background: #FFCC73;*/
}
.phylo-timeline {
grid-row: 4;
grid-column: 1/2;
}
.phylo-graph {
grid-row: 4;
grid-column: 15/16;
/*background: #FFCC73;*/
}
/* classes */
/* ---------- icons ---------- */
a {
color: inherit;
cursor: pointer;
}
.how {
cursor: pointer;
position: relative;
}
.tooltip {
font-family: "Inter-Regular";
font-size: 14px;
font-style: normal;
font-weight: 400;
}
i.how span {
position: absolute;
width: 300px;
color: #FFFFFF;
background: #0d1824;
height: 30px;
line-height: 30px;
text-align: center;
visibility: hidden;
border-radius: 6px;
}
i.how span:after {
content: "";
position: absolute;
top: 50%;
right: 100%;
margin-top: -8px;
width: 0;
height: 0;
border-right: 8px solid #0d1824;
border-top: 8px solid transparent;
border-bottom: 8px solid transparent;
}
i.how:hover span {
visibility: visible;
left: 100%;
top: 50%;
margin-top: -15px;
margin-left: 15px;
z-index: 999;
}
.switch > .far + .fa,
.switch:hover > .far {
display: none;
}
.switch:hover > .far + .fa {
display: inherit;
color: #0d1824;
}
/* ---------- fonts ---------- */
.font-bold {
font-family: "Inter-Bold";
text-transform: uppercase;
}
.font-small {
color: #0d1824;
font-size: 12px;
}
.header {
/*font-weight: bold;*/
/*text-transform: uppercase;*/
font-weight: 500;
cursor: pointer;
}
.header:hover {
font-weight: bold;
}
/* ---------- input ---------- */
.button {
background-color: white;
border: 1.5px solid #0d1824;
cursor: pointer;
}
.button:hover {
background-color: #0d1824;
color: white;
}
.btn-group button {
margin-top: 1px;
margin-bottom: 1px;
display: block;
width: 40px;
}
.draw {
display: none;
}
.phylo-focus {
fill: #f8381f;
color: #f8381f;
}
.reset {
visibility: hidden;
}
.label {
visibility: hidden;
}
.heading {
visibility: hidden;
}
.export {
visibility: hidden;
}
.headed {
background-color: #0d1824;
color: white;
}
.labeled {
background-color: #0d1824;
color: white;
}
.input-file {
display: inline-block;
cursor: pointer;
}
.input-file:hover {
border-bottom: 1.5px solid #0d1824;
}
.input-name {
font-style: italic;
opacity: 0.7;
font-size: 14px;
padding-left: 6px;
padding-right: 6px;
}
/* ---------- axis ---------- */
.x-axis path {
stroke: #EBE4DD;
stroke-width: 1.5px;
}
.y-axis path {
stroke: #EBE4DD;
stroke-width: 1.5px;
}
.y-highlight {
stroke: #f3be54;
stroke-width: 1.5px;
}
.x-mark {
fill: #4A5C70;
stroke-width: 1px;
stroke: #fff;
}
.x-mark-over {
fill: #f3be54;
}
.x-mark-focus {
fill: #f8381f;
}
.tick text {
font-family: "Inter-Regular";
}
.tick text:hover {
cursor: pointer;
}
.y-label {
font-size: 10px;
font-family: "Inter-Regular";
font-weight: normal;
}
.y-label-bold {
font-size: 12px;
font-family: "Inter-Bold";
font-weight: bold;
}
.y-mark-year-inner {
fill: #4A5C70;
}
.y-mark-year-inner-highlight {
fill: #f3be54;
}
.y-mark-year-outer {
fill: #fff;
stroke: #4A5C70;
stroke-width: 1px;
}
.y-mark-year-outer-highlight {
fill: #fff;
stroke: #f3be54;
stroke-width: 3px;
}
.y-mark-month {
fill: #4A5C70;
}
/* ---------- group ---------- */
.group-outer {
stroke-width: 0.8px;
stroke: #fff;
fill: #fff;
}
.group-inner {
stroke-width: 0.8px;
stroke: #0d1824;
fill: #0d1824;
/*cursor: pointer;*/
z-index: 10;
}
.group-heading {
fill: #fff;
stroke: #B5B5B5;
}
.group-focus {
stroke: #f8381f;
}
.source-focus {
stroke: #67a9cf;
}
.group-unfocus {
stroke: #A9A9A9;
}
.group-path {
cursor: pointer;
}
/* ---------- labels ---------- */
.ngrams {
visibility: hidden;
}
.term {
cursor: pointer;
}
.term:hover {
font-weight: bold;
fill: #f8381f;
}
.term-path {
fill: none;
stroke: #F0684D;
stroke-width: 1.5px;
}
.emerging {
/*text-decoration: underline #F0684D;*/
/*fill:#5AA350;*/
/*fill: #5AA350;*/
fill: #F8381F;
}
.decreasing {
/*text-decoration: underline #74B5FF;*/
fill: #11638F;
}
.path-focus {
fill: none;
stroke: #F0684D;
stroke-width: 1.5px;
}
.path-unfocus {
stroke: #A9A9A9;
}
.path-heading {
stroke: #B5B5B5;
}
/* ---------- phylo ---------- */
.branch-hover {
fill: #f3be54;
opacity: 0.5;
}
/* elements */
#file-path {
display: none;
}
/* axis */
.axisRight {
font-family: "Inter-Regular";
font-size: 10px;
}
/* isoline */
.peak {
stroke: white;
stroke-width: 1px;
font-family: "Inter-Regular";
font-size: 14px;
text-anchor: middle;
visibility: visible;
}
.peak-over {
font-size: 18px;
stroke-width: 2px;
cursor: pointer;
stroke: #f3be54;
z-index: 100;
}
.peak-focus {
font-size: 18px;
stroke-width: 2px;
stroke: #F0684D;
}
.peak-focus-source {
font-size: 18px;
stroke-width: 2px;
stroke: #67a9cf;
}
.peak-label {
text-align: center;
font-family: "Inter-Regular";
font-size: 14px;
font-style: normal;
font-weight: 400;
color: #FFFFFF;
border-radius: 3px;
border-style: solid;
border-width: 2px;
border-color: white;
background: #0d1824;
padding: 5px;
z-index: 10;
position: absolute;
visibility: hidden;
}
.word-cloud {
font-family: "Inter-Regular";
font-size: 12px;
}
.search {
margin-left: 10px;
visibility: hidden;
position: absolute;
z-index: 7;
font-size: 14px;
background-color: transparent;
outline: 0;
border-width: 0 0 2px;
border-color: #0d1824;
}
.search-label {
visibility: hidden;
margin-left: 5px;
}
.search:focus {
border-color: #F0684D;
}
.autocomplete {
margin-left: 10px;
visibility: hidden;
position: absolute;
z-index: 7;
font-size: 14px;
background-color: transparent;
color: silver;
z-index: 1;
border: none;
}
.loading {
visibility: hidden;
}
.phylo-name {
visibility: hidden;
text-transform: capitalize;
font-weight: bold;
}
.select-source {
margin-left: 10px;
display: none;
border: 1.5px solid #0d1824;
cursor: pointer;
outline: 0;
background: transparent;
border-image: none;
outline-offset: -2px;
outline-color: transparent;
box-shadow: none;
-webkit-appearance: none;
}
option {
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;
max-width: 150px;
}
/*# sourceMappingURL=sass.css.map */ /*# sourceMappingURL=sass.css.map */
This diff is collapsed.
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.4.7.2", "version": "0.0.4.8.5",
"scripts": { "scripts": {
"generate-purs-packages-nix": "./nix/generate-purs-packages.nix", "generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
"generate-psc-packages-nix": "./nix/generate-packages-json.bash", "generate-psc-packages-nix": "./nix/generate-packages-json.bash",
...@@ -29,15 +29,20 @@ ...@@ -29,15 +29,20 @@
}, },
"dependencies": { "dependencies": {
"@popperjs/core": "^2.9.2", "@popperjs/core": "^2.9.2",
"@urql/core": "^2.3.3",
"aes-js": "^3.1.1", "aes-js": "^3.1.1",
"base-x": "^3.0.2", "base-x": "^3.0.2",
"bootstrap": "^4.6.0", "bootstrap": "^4.6.0",
"bootstrap-dark": "^1.0.3", "bootstrap-dark": "^1.0.3",
"create-react-class": "^15.6.3", "create-react-class": "^15.6.3",
"d3": "^7.0.0",
"echarts": "^5.1.2", "echarts": "^5.1.2",
"echarts-for-react": "^3.0.1", "echarts-for-react": "^3.0.1",
"graphql": "^15.6.1",
"graphql-ws": "^5.5.0",
"highlightjs": "^9.16.2", "highlightjs": "^9.16.2",
"immer": "^9.0.5", "immer": "^9.0.5",
"isomorphic-unfetch": "^3.1.0",
"prop-types": "^15.6.2", "prop-types": "^15.6.2",
"pullstate": "^1.20.6", "pullstate": "^1.20.6",
"react": "^17.0.2", "react": "^17.0.2",
......
let upstream = let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.14.4-20210826/packages.dhall sha256:eee0765aa98e0da8fc414768870ad588e7cada060f9f7c23c37385c169f74d9f https://github.com/purescript/package-sets/releases/download/psc-0.14.4-20211030/packages.dhall sha256:5cd7c5696feea3d3f84505d311348b9e90a76c4ce3684930a0ff29606d2d816c
let overrides = let overrides =
{ globals = { globals =
...@@ -206,6 +206,26 @@ let additions = ...@@ -206,6 +206,26 @@ let additions =
, repo = "https://github.com/natefaubion/purescript-convertable-options" , repo = "https://github.com/natefaubion/purescript-convertable-options"
, version = "v1.0.0" , version = "v1.0.0"
} }
, d3 =
{ dependencies =
[ "aff"
, "aff-promise"
, "dom-simple"
, "easy-ffi"
, "effect"
, "exceptions"
, "foreign"
, "functions"
, "js-date"
, "maybe"
, "prelude"
, "psci-support"
, "tuples"
, "web-dom"
]
, repo = "https://github.com/cgenie/purescript-d3"
, version = "v0.9.1"
}
} }
in upstream // overrides // additions in upstream // overrides // additions
...@@ -26,6 +26,7 @@ to generate this file without the comments in this block. ...@@ -26,6 +26,7 @@ to generate this file without the comments in this block.
, "control" , "control"
, "convertable-options" , "convertable-options"
, "css" , "css"
, "d3"
, "datetime" , "datetime"
, "dom-filereader" , "dom-filereader"
, "dom-simple" , "dom-simple"
...@@ -41,6 +42,7 @@ to generate this file without the comments in this block. ...@@ -41,6 +42,7 @@ to generate this file without the comments in this block.
, "formula" , "formula"
, "functions" , "functions"
, "globals" , "globals"
, "graphql-client"
, "http-methods" , "http-methods"
, "integers" , "integers"
, "js-timers" , "js-timers"
......
...@@ -4,6 +4,7 @@ module Gargantext.Components.DocsTable where ...@@ -4,6 +4,7 @@ module Gargantext.Components.DocsTable where
import Gargantext.Prelude import Gargantext.Prelude
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Data.Array (any)
import Data.Array as A import Data.Array as A
import Data.Either (Either) import Data.Either (Either)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
...@@ -21,33 +22,36 @@ import Data.Symbol (SProxy(..)) ...@@ -21,33 +22,36 @@ import Data.Symbol (SProxy(..))
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, Milliseconds(..), delay, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Timer (setTimeout)
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..)) import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
import Gargantext.Components.Category (rating) import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..)) import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.DocumentFormCreation (documentFormCreation) import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData, showSource) import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData, showSource)
import Gargantext.Components.Nodes.Lists.Types as NT import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types (SidePanelTriggers)
import Gargantext.Components.Score as GCS
import Gargantext.Components.Nodes.Texts.Types as TextsT import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Reload (reloadContext, textsReloadContext)
import Gargantext.Components.Table as TT import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError, logRESTError) import Gargantext.Config.REST (RESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, delete) import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType') import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
import Gargantext.Types as GT
import Gargantext.Utils (sortWith, (?)) import Gargantext.Utils (sortWith, (?))
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS) import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as GUT import Gargantext.Utils.Toestand as GUT
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON import Simple.JSON as JSON
...@@ -143,19 +147,38 @@ docViewCpt = here.component "docView" cpt where ...@@ -143,19 +147,38 @@ docViewCpt = here.component "docView" cpt where
onDocumentCreationPending /\ onDocumentCreationPendingBox <- onDocumentCreationPending /\ onDocumentCreationPendingBox <-
R2.useBox' false R2.useBox' false
-- Context
mReloadContext <- R.useContext textsReloadContext
-- @toggleModalCallback -- @toggleModalCallback
toggleModal <- pure $ const $ toggleModal <- pure $ const $
T.modify_ not isDocumentModalVisibleBox T.modify_ not isDocumentModalVisibleBox
-- @onCreateDocumentEnd <AsyncProgress>
onCreateDocumentEnd <- pure $ \asyncProgress -> do
here.log2 "[DocsTables] NodeDocument task:" asyncProgress
T.write_ false onDocumentCreationPendingBox
toggleModal unit
case mReloadContext of
Nothing -> pure unit
Just b -> T2.reload b
-- @createDocumentCallback -- @createDocumentCallback
-- @WIP: remote business for document creation
createDocumentCallback <- pure $ \fdata -> launchAff_ do createDocumentCallback <- pure $ \fdata -> launchAff_ do
liftEffect $ T.write_ true onDocumentCreationPendingBox liftEffect $
T.write_ true onDocumentCreationPendingBox
delay $ Milliseconds 2000.0 eTask <- DFC.create session nodeId fdata
liftEffect $ T.write_ false onDocumentCreationPendingBox handleRESTError boxes.errors eTask
\t -> liftEffect $ launchDocumentCreationProgress
boxes
session
nodeId
t
onCreateDocumentEnd
-- Render -- Render
pure $ pure $
...@@ -206,13 +229,54 @@ docViewCpt = here.component "docView" cpt where ...@@ -206,13 +229,54 @@ docViewCpt = here.component "docView" cpt where
, hasCollapsibleBackground: false , hasCollapsibleBackground: false
} }
[ [
documentFormCreation DFC.documentFormCreation
{ callback: createDocumentCallback { callback: createDocumentCallback
, status: onDocumentCreationPending ? Deferred $ Enabled , status: onDocumentCreationPending ? Deferred $ Enabled
} }
] ]
] ]
launchDocumentCreationProgress ::
Boxes
-> Session
-> GT.ID
-> GT.AsyncTaskWithType
-> (GT.AsyncProgress -> Effect Unit)
-> Effect Unit
launchDocumentCreationProgress boxes session nodeId currentTask cbk
= void $ setTimeout 1000 $ launchAff_ $
scanDocumentCreationProgress boxes session nodeId currentTask cbk
scanDocumentCreationProgress ::
Boxes
-> Session
-> GT.ID
-> GT.AsyncTaskWithType
-> (GT.AsyncProgress -> Effect Unit)
-> Aff Unit
scanDocumentCreationProgress boxes session nodeId currentTask cbk = do
eTask <- DFC.createProgress session nodeId currentTask
handleRESTError boxes.errors eTask
\asyncProgress -> liftEffect do
let
GT.AsyncProgress { status } = asyncProgress
endingStatusList =
[ GT.IsFinished
, GT.IsKilled
, GT.IsFailure
]
hasEndingStatus s = any (_ # s # eq) endingStatusList
if (hasEndingStatus status)
then
cbk asyncProgress
else
launchDocumentCreationProgress boxes session nodeId currentTask cbk
---------------------------------------------------
type SearchBarProps = type SearchBarProps =
( query :: T.Box Query ) ( query :: T.Box Query )
......
module Gargantext.Components.DocsTable.DocumentFormCreation module Gargantext.Components.DocsTable.DocumentFormCreation
( documentFormCreation ( documentFormCreation
, FormData , FormData
, create, createProgress
) where ) where
import Gargantext.Prelude import Gargantext.Prelude
...@@ -8,18 +9,25 @@ import Gargantext.Prelude ...@@ -8,18 +9,25 @@ import Gargantext.Prelude
import DOM.Simple.Console (log3) import DOM.Simple.Console (log3)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (foldl, intercalate) import Data.Foldable (foldl, intercalate)
import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..)) import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.FormValidation (VForm, useFormValidation) import Gargantext.Hooks.FormValidation (VForm, useFormValidation)
import Gargantext.Hooks.FormValidation.Unboxed as FV import Gargantext.Hooks.FormValidation.Unboxed as FV
import Gargantext.Hooks.StateRecord (useStateRecord) import Gargantext.Hooks.StateRecord (useStateRecord)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post, get)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp, (?)) import Gargantext.Utils (nbsp, (?))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record (merge) import Record as Record
import Record.Extra (pick) import Record.Extra (pick)
import Type.Proxy (Proxy(..))
type Props = type Props =
( callback :: Record FormData -> Effect Unit ( callback :: Record FormData -> Effect Unit
...@@ -30,7 +38,7 @@ type Props = ...@@ -30,7 +38,7 @@ type Props =
type Options = ( | FormData ) type Options = ( | FormData )
options :: Record Options options :: Record Options
options = merge {} defaultData options = Record.merge {} defaultData
documentFormCreation :: forall r. R2.OptLeaf Options Props r documentFormCreation :: forall r. R2.OptLeaf Options Props r
documentFormCreation = R2.optLeaf component options documentFormCreation = R2.optLeaf component options
...@@ -48,7 +56,7 @@ component = R.hooksComponent "documentFormCreation" cpt where ...@@ -48,7 +56,7 @@ component = R.hooksComponent "documentFormCreation" cpt where
result <- fv.try (\_ -> documentFormValidation state) result <- fv.try (\_ -> documentFormValidation state)
case result of case result of
Left err -> log3 "document form validation error" state err Left err -> log3 "documentFormCreation validation error" state err
Right _ -> props.callback state Right _ -> props.callback state
-- Render -- Render
...@@ -128,13 +136,42 @@ component = R.hooksComponent "documentFormCreation" cpt where ...@@ -128,13 +136,42 @@ component = R.hooksComponent "documentFormCreation" cpt where
[ [
B.formInput $ B.formInput $
{ placeholder: "ex: author1, author2, …" { placeholder: "ex: author1, author2, …"
} `merge` bindStateKey "authors" } `Record.merge` bindStateKey "authors"
, ,
R2.if' (fv.hasError' "authors") $ R2.if' (fv.hasError' "authors") $
H.div { className: "form-group__error" } H.div { className: "form-group__error" }
[ H.text "Please enter at least one author" ] [ H.text "Please enter at least one author" ]
] ]
] ]
,
-- Date
H.div
{ className: intercalate " "
[ "form-group"
, (fv.hasError' "date") ?
"form-group--error" $
mempty
]
}
[
H.div
{ className: "form-group__label" }
[
H.label {} [ H.text $ "Date" ]
]
,
H.div
{ className: "form-group__field" }
[
B.formInput $
{ type: "date"
} `Record.merge` bindStateKey "date"
,
R2.if' (fv.hasError' "date") $
H.div { className: "form-group__error" }
[ H.text "Please enter a valid date" ]
]
]
, ,
-- Abstract -- Abstract
H.div H.div
...@@ -143,7 +180,8 @@ component = R.hooksComponent "documentFormCreation" cpt where ...@@ -143,7 +180,8 @@ component = R.hooksComponent "documentFormCreation" cpt where
] ]
} }
[ [
H.div { className: "form-group__label" } H.div
{ className: "form-group__label" }
[ [
H.label {} [ H.text $ "Abstract" <> nbsp 1 ] H.label {} [ H.text $ "Abstract" <> nbsp 1 ]
, ,
...@@ -152,11 +190,12 @@ component = R.hooksComponent "documentFormCreation" cpt where ...@@ -152,11 +190,12 @@ component = R.hooksComponent "documentFormCreation" cpt where
[ H.text "optional" ] [ H.text "optional" ]
] ]
, ,
H.div { className: "form-group__field" } H.div
{ className: "form-group__field" }
[ [
B.formTextarea $ B.formTextarea $
{ rows: 5 { rows: 5
} `merge` bindStateKey "abstract" } `Record.merge` bindStateKey "abstract"
] ]
] ]
, ,
...@@ -178,6 +217,7 @@ type FormData = ...@@ -178,6 +217,7 @@ type FormData =
( title :: String ( title :: String
, source :: String , source :: String
, authors :: String , authors :: String
, date :: String
, abstract :: String , abstract :: String
) )
...@@ -186,6 +226,7 @@ defaultData = ...@@ -186,6 +226,7 @@ defaultData =
{ title : "" { title : ""
, source : "" , source : ""
, authors : "" , authors : ""
, date : ""
, abstract : "" , abstract : ""
} }
...@@ -196,4 +237,51 @@ documentFormValidation r = foldl append mempty rules ...@@ -196,4 +237,51 @@ documentFormValidation r = foldl append mempty rules
[ FV.nonEmpty "title" r.title [ FV.nonEmpty "title" r.title
, FV.nonEmpty "source" r.source , FV.nonEmpty "source" r.source
, FV.nonEmpty "authors" r.authors , FV.nonEmpty "authors" r.authors
, FV.date "date" r.date
] ]
---------------------------------------------------
create ::
Session
-> GT.ID
-> Record FormData
-> Aff (Either RESTError GT.AsyncTaskWithType)
create session nodeId =
rename
>>> post session request
>=> case _ of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType
{ task
, typ: GT.NodeDocument
}
where
request = GR.NodeAPI GT.Node (Just nodeId)
(GT.asyncTaskTypePath GT.NodeDocument)
rename = Record.rename
(Proxy :: Proxy "source")
(Proxy :: Proxy "sources")
createProgress ::
Session
-> GT.ID
-> GT.AsyncTaskWithType
-> Aff (Either RESTError GT.AsyncProgress)
createProgress
session
nodeId
(GT.AsyncTaskWithType { task: GT.AsyncTask { id } })
=
get session request
where
request = GR.NodeAPI GT.Node (Just nodeId)
(GT.asyncTaskTypePath GT.NodeDocument <> pollParams)
pollParams = "/" <> id <> "/poll?limit1"
...@@ -18,12 +18,13 @@ type GraphId = Int ...@@ -18,12 +18,13 @@ type GraphId = Int
newtype Node = Node { newtype Node = Node {
attributes :: Cluster attributes :: Cluster
, id_ :: String , children :: Array String
, label :: String , id_ :: String
, size :: Int , label :: String
, type_ :: String , size :: Int
, x :: Number , type_ :: String
, y :: Number , x :: Number
, y :: Number
} }
x_coordP = SProxy :: SProxy "x_coord" x_coordP = SProxy :: SProxy "x_coord"
......
...@@ -15,6 +15,7 @@ stEdgeToGET { _original } = _original ...@@ -15,6 +15,7 @@ stEdgeToGET { _original } = _original
stNodeToGET :: Record ST.Node -> GET.Node stNodeToGET :: Record ST.Node -> GET.Node
stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node { stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node {
attributes attributes
, children: []
, id_: id , id_: id
, label , label
, size , size
......
module Gargantext.Components.GraphQL where
import Gargantext.Prelude
import Affjax.RequestHeader as ARH
import Data.Argonaut.Decode (JsonDecodeError)
import Data.Bifunctor (lmap)
import Data.List.Types (NonEmptyList)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Foreign (unsafeToForeign, ForeignError)
import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM)
import Gargantext.Sessions (Session(..))
import Gargantext.Utils.Reactix as R2
import GraphQL.Client.Args (type (==>))
import GraphQL.Client.BaseClients.Urql (UrqlClient, createClient)
import GraphQL.Client.Query (queryWithDecoder)
import GraphQL.Client.Types (class GqlQuery, Client, class QueryClient)
import Simple.JSON as JSON
import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here
here = R2.here "Gargantext.Components.GraphQL"
--client :: Client AffjaxClient Schema Void Void
--client = Client $ AffjaxClient "http://localhost:8008/gql" []
-- | Run a graphQL query with a custom decoder and custom options
gqlQuery ::
forall client schema query returns a b queryOpts mutationOpts.
QueryClient client queryOpts mutationOpts =>
GqlQuery schema query returns =>
JSON.ReadForeign returns =>
--(queryOpts -> queryOpts) ->
(Client client schema a b) ->
String ->
query ->
Aff returns
gqlQuery = queryWithDecoder (unsafeToForeign >>> JSON.read >>> lmap toJsonError)
toJsonError :: NonEmptyList ForeignError -> JsonDecodeError
toJsonError = unsafeCoerce -- map ForeignErrors to JsonDecodeError as you wish
getClient :: Session -> Effect (Client UrqlClient Schema Mutation Void)
getClient (Session { token }) = createClient { headers, url: "http://localhost:8008/gql" }
where
headers = [ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
queryGql ::
forall query returns.
GqlQuery Schema query returns =>
JSON.ReadForeign returns =>
Session
-> String
-> query
-> Aff returns
queryGql session name q = do
--query client name q
client <- liftEffect $ getClient session
gqlQuery (client :: Client UrqlClient Schema Mutation Void) name q
--query_ "http://localhost:8008/gql" (Proxy :: Proxy Schema)
-- Schema
type Schema
= { user_infos :: { user_id :: Int } ==> Array UserInfo
, users :: { user_id :: Int } ==> Array User
}
type Mutation
= { update_user_info :: UserInfoM ==> Int }
module Gargantext.Components.GraphQL.AffjaxSimpleJSONClient
(AffjaxClient(..))
where
import Prelude
import Affjax (Error(..), Response, URL, defaultRequest, printError, request)
import Affjax.RequestBody as RequestBody
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method as Method
import Data.List.NonEmpty as DLN
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff, error, throwError)
import Foreign (unsafeToForeign)
import GraphQL.Client.Types (class QueryClient)
import Simple.JSON as JSON
data AffjaxClient
= AffjaxClient URL (Array RequestHeader)
--
-- instance queryClient :: QueryClient AffjaxClient Unit Unit where
-- clientQuery _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "query" url headers name q vars
-- clientMutation _ (AffjaxClient url headers) name q vars = throwLeft =<< convertJsonResponse =<< queryPostForeign "mutation" url headers name q vars
-- defQueryOpts = const unit
-- defMutationOpts = const unit
--
-- throwLeft :: forall r body. Either Error { body :: body | r } -> Aff body
-- throwLeft = case _ of
-- Left err -> throwError $ error $ printError err
-- Right { body } -> pure body
--
-- queryPostForeign ::
-- forall d.
-- JSON.WriteForeign d =>
-- String -> URL -> Array RequestHeader -> String -> String -> d -> Aff (Either Error (Response String))
-- queryPostForeign opStr url headers queryName q vars = do
-- request
-- defaultRequest
-- { withCredentials = true
-- , url = url
-- , method = Left Method.POST
-- --, responseFormat = ResponseFormat.json
-- , responseFormat = ResponseFormat.string
-- , content =
-- Just
-- -- $ RequestBody.Json
-- -- $ encodeJson
-- $ RequestBody.String
-- $ JSON.writeJSON
-- { query: opStr <> " " <> queryName <> " " <> q
-- , variables: vars
-- , operationName: queryName
-- }
-- , headers = headers <> [ ContentType applicationJSON ]
-- }
--
-- convertJsonResponse :: Either Error (Response String) -> Aff (Either Error (Response Json))
-- convertJsonResponse (Left err) = pure $ Left err
-- convertJsonResponse (Right res@{ body }) = pure $ case JSON.readJSON body of
-- Left err -> Left $ ResponseBodyError (DLN.head err) (res { body = unsafeToForeign body })
-- Right body' -> Right $ res { body = toJSON body' }
--
-- foreign import toJSON :: forall d. JSON.ReadForeign d => d -> Json
--
--
module Gargantext.Components.GraphQL.User where
import Gargantext.Prelude
import Data.Array as A
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import GraphQL.Client.Args (NotNull(..), (=>>))
import GraphQL.Client.Variable (Var(..))
import GraphQL.Client.Variables (withVars)
import Type.Proxy (Proxy(..))
type UserInfo
= { ui_id :: Int
, ui_username :: String
, ui_email :: String
, ui_title :: Maybe String
, ui_source :: Maybe String
, ui_cwFirstName :: Maybe String
, ui_cwLastName :: Maybe String
, ui_cwOrganization :: Array String
, ui_cwLabTeamDepts :: Array String
, ui_cwOffice :: Maybe String
, ui_cwCity :: Maybe String
, ui_cwCountry :: Maybe String
, ui_cwRole :: Maybe String
, ui_cwTouchPhone :: Maybe String
, ui_cwTouchMail :: Maybe String }
type UserInfoM
= { ui_id :: NotNull Int
, ui_username :: String
, ui_email :: String
, ui_title :: String
, ui_source :: String
, ui_cwFirstName :: String
, ui_cwLastName :: String
, ui_cwOrganization :: (Array String)
, ui_cwLabTeamDepts :: (Array String)
, ui_cwOffice :: String
, ui_cwCity :: String
, ui_cwCountry :: String
, ui_cwRole :: String
, ui_cwTouchPhone :: String
, ui_cwTouchMail :: String }
userInfoQuery = { user_infos: { user_id: Var :: _ "id" Int } =>>
{ ui_id: unit
, ui_username: unit
, ui_email: unit
, ui_title: unit
, ui_source: unit
, ui_cwFirstName: unit
, ui_cwLastName: unit
, ui_cwCity: unit
, ui_cwCountry: unit
, ui_cwLabTeamDepts: unit
, ui_cwOrganization: unit
, ui_cwOffice: unit
, ui_cwRole: unit
, ui_cwTouchMail: unit
, ui_cwTouchPhone: unit }
}
_ui_cwFirstName :: Lens' UserInfo String
_ui_cwFirstName = lens getter setter
where
getter ({ ui_cwFirstName: val }) = fromMaybe "" val
setter ui val = ui { ui_cwFirstName = Just val }
_ui_cwLastName :: Lens' UserInfo String
_ui_cwLastName = lens getter setter
where
getter ({ ui_cwLastName: val }) = fromMaybe "" val
setter ui val = ui { ui_cwLastName = Just val }
_ui_cwCity :: Lens' UserInfo String
_ui_cwCity = lens getter setter
where
getter ({ ui_cwCity: val }) = fromMaybe "" val
setter ui val = ui { ui_cwCity = Just val }
_ui_cwCountry :: Lens' UserInfo String
_ui_cwCountry = lens getter setter
where
getter ({ ui_cwCountry: val }) = fromMaybe "" val
setter ui val = ui { ui_cwCountry = Just val }
_ui_cwLabTeamDepts :: Lens' UserInfo (Array String)
_ui_cwLabTeamDepts = lens getter setter
where
getter ({ ui_cwLabTeamDepts: val }) = val
setter ui val = ui { ui_cwLabTeamDepts = val }
_ui_cwLabTeamDeptsFirst :: Lens' UserInfo String
_ui_cwLabTeamDeptsFirst = lens getter setter
where
getter ({ ui_cwLabTeamDepts: val }) = fromMaybe "" $ A.head val
setter ui val = ui { ui_cwLabTeamDepts = fromMaybe [val] $ A.updateAt 0 val ui.ui_cwLabTeamDepts }
_ui_cwOffice :: Lens' UserInfo String
_ui_cwOffice = lens getter setter
where
getter ({ ui_cwOffice: val }) = fromMaybe "" val
setter ui val = ui { ui_cwOffice = Just val }
_ui_cwOrganization :: Lens' UserInfo (Array String)
_ui_cwOrganization = lens getter setter
where
getter ({ ui_cwOrganization: val }) = val
setter ui val = ui { ui_cwOrganization = val }
_ui_cwOrganizationFirst :: Lens' UserInfo String
_ui_cwOrganizationFirst = lens getter setter
where
getter ({ ui_cwOrganization: val }) = fromMaybe "" $ A.head val
setter ui val = ui { ui_cwOrganization = fromMaybe [val] $ A.updateAt 0 val ui.ui_cwOrganization }
_ui_cwRole :: Lens' UserInfo String
_ui_cwRole = lens getter setter
where
getter ({ ui_cwRole: val }) = fromMaybe "" val
setter ui val = ui { ui_cwRole = Just val }
_ui_cwTouchMail :: Lens' UserInfo String
_ui_cwTouchMail = lens getter setter
where
getter ({ ui_cwTouchMail: val }) = fromMaybe "" val
setter ui val = ui { ui_cwTouchMail = Just val }
_ui_cwTouchPhone :: Lens' UserInfo String
_ui_cwTouchPhone = lens getter setter
where
getter ({ ui_cwTouchPhone: val }) = fromMaybe "" val
setter ui val = ui { ui_cwTouchPhone = Just val }
type User
= { u_id :: Int
, u_hyperdata ::
{ shared :: Maybe
{ title :: Maybe String
, source :: Maybe String
, who :: Maybe
{ firstName :: Maybe String
, lastName :: Maybe String
}
, "where" :: Array
{ organization :: Array String }
}
}
, u_username :: String
, u_email :: String
}
showUser { u_id
, u_username
, u_email } = "[" <> show u_id <> "] " <> u_username <> " :: " <> u_email
showMUser u = maybe "" showUser u
...@@ -11,6 +11,7 @@ import Effect.Aff (Aff) ...@@ -11,6 +11,7 @@ import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year) import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.GraphQL.User (UserInfo)
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
...@@ -50,13 +51,13 @@ modeTabType' Books = CTabAuthors ...@@ -50,13 +51,13 @@ modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = type TabsProps =
( boxes :: Boxes ( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState , cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData , defaultListId :: Int
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel)) , sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -68,21 +69,21 @@ tabsCpt = here.component "tabs" cpt where ...@@ -68,21 +69,21 @@ tabsCpt = here.component "tabs" cpt where
yearFilter <- T.useBox (Nothing :: Maybe Year) yearFilter <- T.useBox (Nothing :: Maybe Year)
pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props } pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props }
tabs' yearFilter props@{ boxes, sidePanel } = tabs' yearFilter props@{ boxes, defaultListId, sidePanel } =
[ "Documents" /\ docs [ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents) , "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books) , "Books" /\ ngramsView (viewProps Books)
, "Communication" /\ ngramsView (viewProps Communication) , "Communication" /\ ngramsView (viewProps Communication)
, "Trash" /\ docs -- TODO pass-in trash mode , "Trash" /\ docs -- TODO pass-in trash mode
] where ] where
viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId viewProps mode = Record.merge props { mode }
, mode } totalRecords = 4736 -- TODO lol
totalRecords = 4736 -- TODO lol
docs = DT.docViewLayout (Record.merge { boxes, sidePanel } $ Record.merge dtCommon dtExtra) docs = DT.docViewLayout (Record.merge { boxes, sidePanel } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon dtCommon = RX.pick props :: Record DTCommon
dtExtra = dtExtra =
{ chart: mempty { chart: mempty
, listId: props.contactData.defaultListId --, listId: props.contactData.defaultListId
, listId: defaultListId
, mCorpusId: Nothing , mCorpusId: Nothing
, showSearch: true , showSearch: true
, tabType: TabPairing TabDocs , tabType: TabPairing TabDocs
...@@ -100,8 +101,7 @@ type DTCommon = ...@@ -100,8 +101,7 @@ type DTCommon =
) )
type NgramsViewTabsProps = type NgramsViewTabsProps =
( defaultListId :: Int ( mode :: Mode
, mode :: Mode
| TabsProps ) | TabsProps )
ngramsView :: R2.Leaf NgramsViewTabsProps ngramsView :: R2.Leaf NgramsViewTabsProps
......
...@@ -4,25 +4,27 @@ module Gargantext.Components.Nodes.Annuaire.User ...@@ -4,25 +4,27 @@ module Gargantext.Components.Nodes.Annuaire.User
) )
where where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Either (Either) import Data.Either (Either)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes) import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Components.GraphQL.User (UserInfo)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contact (getUserInfoWithReload, saveUserInfo, contactInfos)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Config.REST (RESTError, logRESTError) import Gargantext.Config.REST (RESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId) import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (FrontendError, NodeType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
...@@ -53,98 +55,10 @@ displayCpt = here.component "display" cpt ...@@ -53,98 +55,10 @@ displayCpt = here.component "display" cpt
[ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ] [ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
, H.div { className: "col-md-1"} [] , H.div { className: "col-md-1"} []
, H.div { className: "col-md-8"} children , H.div { className: "col-md-8"} children
]]]] ]
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
where
item {label, defaultVal, lens} =
contactInfoItem { hyperdata: h
, label
, lens
, onUpdateHyperdata
, placeholder: defaultVal }
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
contactInfoItems =
[ {label: "Last Name" , defaultVal: "Empty Last Name" , lens: _shared <<< _who <<< _lastName }
, {label: "First Name" , defaultVal: "Empty First Name" , lens: _shared <<< _who <<< _firstName }
, {label: "Organisation" , defaultVal: "Empty Organisation" , lens: _shared <<< _ouFirst <<< _organizationJoinComma}
, {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
, {label: "Office" , defaultVal: "Empty Office" , lens: _shared <<< _ouFirst <<< _office }
, {label: "City" , defaultVal: "Empty City" , lens: _shared <<< _ouFirst <<< _city }
, {label: "Country" , defaultVal: "Empty Country" , lens: _shared <<< _ouFirst <<< _country }
, {label: "Role" , defaultVal: "Empty Role" , lens: _shared <<< _ouFirst <<< _role }
, {label: "Phone" , defaultVal: "Empty Phone" , lens: _shared <<< _ouFirst <<< _touch <<< _phone }
, {label: "Mail" , defaultVal: "Empty Mail" , lens: _shared <<< _ouFirst <<< _touch <<< _mail }
]
type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps =
( hyperdata :: HyperdataUser
, label :: String
, lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit
, placeholder :: String
)
contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
where
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
pure $ H.div { className: "form-group row" } [
H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing' isEditing valueRef
]
where
cLens = L.cloneLens lens
item false isEditing valueRef =
H.div { className: "input-group col-sm-6" } [
H.input { className: "form-control"
, defaultValue: placeholder'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-pencil" } []
] ]
] ]
where ]
placeholder' = R.readRef valueRef
onClick _ = T.write_ true isEditing
item true isEditing valueRef =
H.div { className: "input-group col-sm-6" } [
inputWithEnter {
autoFocus: true
, className: "form-control"
, defaultValue: R.readRef valueRef
, onBlur: R.setRef valueRef
, onEnter: onClick
, onValueChanged: R.setRef valueRef
, placeholder
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-floppy-o" } []
]
]
where
onClick _ = do
T.write_ true isEditing
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
onUpdateHyperdata newHyperdata
{- {-
listElement :: Array R.Element -> R.Element listElement :: Array R.Element -> R.Element
...@@ -191,16 +105,16 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where ...@@ -191,16 +105,16 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
cacheState <- T.useBox LT.CacheOn cacheState <- T.useBox LT.CacheOn
useLoader { errorHandler useLoader { errorHandler
, loader: getUserWithReload , loader: getUserInfoWithReload
, path: { nodeId, reload: reload', session } , path: { nodeId, reload: reload', session }
, render: \contactData@{contactNode: Contact {name, hyperdata}} -> , render: \userInfo@{ ui_username } ->
H.ul { className: "col-md-12 list-group" } [ H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name } display { title: fromMaybe "no name" (Just ui_username) }
(contactInfos hyperdata (onUpdateHyperdata reload)) (contactInfos userInfo (onUpdateUserInfo boxes.errors reload))
, Tabs.tabs { , Tabs.tabs {
boxes boxes
, cacheState , cacheState
, contactData , defaultListId: 424242
, frontends , frontends
, nodeId , nodeId
, session , session
...@@ -210,31 +124,26 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where ...@@ -210,31 +124,26 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
} }
where where
errorHandler = logRESTError here "[userLayoutWithKey]" errorHandler = logRESTError here "[userLayoutWithKey]"
onUpdateHyperdata :: T2.ReloadS -> HyperdataUser -> Effect Unit onUpdateUserInfo :: T.Box (Array FrontendError) -> T2.ReloadS -> UserInfo -> Effect Unit
onUpdateHyperdata reload hd = do onUpdateUserInfo errors reload ui = do
launchAff_ $ do launchAff_ $ do
_ <- saveContactHyperdata session nodeId hd res <- saveUserInfo session nodeId ui
liftEffect $ T2.reload reload handleRESTError errors res $ \_ ->
liftEffect $ T2.reload reload
-- | toUrl to get data XXX --saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
getContact :: Session -> Int -> Aff (Either RESTError ContactData) --saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
getContact session id = do
eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
getUserWithReload :: { nodeId :: Int
, reload :: T2.Reload
, session :: Session} -> Aff (Either RESTError ContactData)
getUserWithReload {nodeId, session} = getContact session nodeId
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
-- | toUrl to get data XXX
--getContact :: Session -> Int -> Aff (Either RESTError ContactData)
--getContact session id = do
-- eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
-- -- TODO: we need a default list for the pairings
-- --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
-- --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- -- Just (NodePoly { id: defaultListId }) ->
-- -- pure {contactNode, defaultListId}
-- -- Nothing ->
-- -- throwError $ error "Missing default list"
-- pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
--
...@@ -47,14 +47,14 @@ modeTabType' Patents = CTabAuthors ...@@ -47,14 +47,14 @@ modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors modeTabType' Communication = CTabAuthors
type TabsProps = ( type TabsProps =
boxes :: Boxes ( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState , cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData' , defaultListId :: Int
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sidePanel :: T.Box (Maybe (Record TTypes.SidePanel)) , sidePanel :: T.Box (Maybe (Record TTypes.SidePanel))
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -64,7 +64,7 @@ tabsCpt = here.component "tabs" cpt ...@@ -64,7 +64,7 @@ tabsCpt = here.component "tabs" cpt
where where
cpt { boxes cpt { boxes
, cacheState , cacheState
, contactData: {defaultListId} , defaultListId
, frontends , frontends
, nodeId , nodeId
, session , session
...@@ -134,7 +134,6 @@ type NgramsViewTabsProps = ( ...@@ -134,7 +134,6 @@ type NgramsViewTabsProps = (
ngramsView :: R2.Component NgramsViewTabsProps ngramsView :: R2.Component NgramsViewTabsProps
ngramsView = R.createElement ngramsViewCpt ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt ngramsViewCpt = here.component "ngramsView" cpt
where where
......
module Gargantext.Components.Nodes.Corpus.Phylo where module Gargantext.Components.Nodes.Corpus.Phylo
( phyloLayout
) where
import Gargantext.Prelude import Gargantext.Prelude
( pure, ($) )
-- import Gargantext.Utils.Toestand as T2 import Affjax as AX
-- import Toestand as T import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.PhyloExplorer.Layout (layout)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID) import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Simple.JSON as JSON
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Phylo" here = R2.here "Gargantext.Components.Nodes.Corpus.Phylo"
type Props = ( nodeId :: NodeID, session :: Session ) type Props =
( nodeId :: NodeID
, session :: Session
)
phyloLayout :: R2.Component Props phyloLayout :: R2.Component Props
phyloLayout = R.createElement phyloLayoutCpt phyloLayout = R.createElement phyloLayoutCpt
phyloLayoutCpt :: R.Component Props phyloLayoutCpt :: R.Component Props
phyloLayoutCpt = here.component "phyloLayout" cpt where phyloLayoutCpt = here.component "phyloLayout" cpt where
cpt { nodeId, session } content = do cpt _ _ = do
pure $ H.h1 {} [ H.text "Hello Phylo" ]
fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloDataSet)
fetchedData <- T.useLive T.unequal fetchedDataBox
R.useEffectOnce' $ launchAff_ do
result <- fetchPhyloJSON
liftEffect $ case result of
Left err -> log2 "error" err
Right res -> T.write_ (Just res) fetchedDataBox
pure case fetchedData of
Nothing -> mempty
Just phyloDataSet -> layout { phyloDataSet } []
fetchPhyloJSON :: Aff (Either String PhyloDataSet)
fetchPhyloJSON =
let
-- @WIP remove dumb data
url = "http://localhost:5000/js/knowledge-phylomemy.json"
-- url = "http://localhost:5000/js/vaccines_countries_06_2021.json"
request = AX.defaultRequest
{ url = url
, method = Left GET
, responseFormat = ResponseFormat.string
}
in do
result <- request # AX.request
liftEffect $ case result of
Left err -> pure $ Left $ AX.printError err
Right response -> case JSON.readJSON response.body of
Left err -> pure $ Left $ show err
Right (res :: PhyloJSONSet) -> pure $ Right $ parsePhyloJSONSet res
...@@ -20,6 +20,7 @@ import Gargantext.Components.Nodes.Corpus.Document as D ...@@ -20,6 +20,7 @@ import Gargantext.Components.Nodes.Corpus.Document as D
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, CorpusInfo(..), Hyperdata(..), getCorpusInfo) import Gargantext.Components.Nodes.Corpus.Types (CorpusData, CorpusInfo(..), Hyperdata(..), getCorpusInfo)
import Gargantext.Components.Nodes.Lists.Types as LT import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Components.Reload (textsReloadContext)
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config.REST (logRESTError) import Gargantext.Config.REST (logRESTError)
...@@ -28,6 +29,7 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -28,6 +29,7 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (WithSession, Session, getCacheState) import Gargantext.Sessions (WithSession, Session, getCacheState)
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, SidePanelState(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), ListId, NodeID, SidePanelState(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T import Toestand as T
...@@ -52,11 +54,20 @@ textsLayout = R.createElement textsLayoutCpt ...@@ -52,11 +54,20 @@ textsLayout = R.createElement textsLayoutCpt
textsLayoutCpt :: R.Component Props textsLayoutCpt :: R.Component Props
textsLayoutCpt = here.component "textsLayout" cpt where textsLayoutCpt = here.component "textsLayout" cpt where
cpt { boxes, frontends, nodeId, session } children = do cpt { boxes, frontends, nodeId, session } children = do
pure $ textsLayoutWithKey { key
, boxes _ /\ reloadBox <- R2.useBox' T2.newReload
, frontends
, nodeId pure $
, session } children R.provideContext textsReloadContext (Just reloadBox)
[
textsLayoutWithKey
{ key
, boxes
, frontends
, nodeId
, session } children
]
where where
key = show nodeId key = show nodeId
-- key = show sid <> "-" <> show nodeId -- key = show sid <> "-" <> show nodeId
......
module Gargantext.Components.Nodes.Texts.Types where module Gargantext.Components.Nodes.Texts.Types where
import Data.Maybe (Maybe(..))
import Reactix as R
import Gargantext.Prelude import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Types (ListId, NodeID) import Gargantext.Types (ListId, NodeID)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Toestand as T
data SidePanelState = InitialClosed | Opened | Closed data SidePanelState = InitialClosed | Opened | Closed
derive instance Eq SidePanelState derive instance Eq SidePanelState
...@@ -67,3 +68,13 @@ type SidePanel = ...@@ -67,3 +68,13 @@ type SidePanel =
initialSidePanel :: Maybe (Record SidePanel) initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing initialSidePanel = Nothing
-----------------------------------------------------------------
-- @XXX: This custom context solves a wrong monolithic front design where
-- "DocsTable" component is used for many different use cases
-- Normally we would have use the classic "Gargantext.Components.Reload",
-- but we limit side-effects by using another context reference
textsReloadContext :: R.Context (Maybe (T.Box T2.Reload))
textsReloadContext = R.createContext Nothing
This diff is collapsed.
module Gargantext.Components.PhyloExplorer.Draw
( drawPhylo
, highlightSource
, unhide
, setGlobalDependencies, setGlobalD3Reference
) where
import Gargantext.Prelude
import DOM.Simple (Document, Window, querySelectorAll)
import Data.Either (Either(..))
import Data.Foldable (for_)
import Data.FoldableWithIndex (forWithIndex_)
import Data.Maybe (Maybe(..), maybe)
import Effect (Effect)
import Effect.Uncurried (EffectFn1, EffectFn7, runEffectFn1, runEffectFn7)
import FFI.Simple (applyTo, getProperty, (..), (.=), (.?))
import Gargantext.Components.PhyloExplorer.Types (AncestorLink, Branch, BranchLink, GlobalTerm(..), Group(..), Link, Period, PhyloDataSet(..))
import Graphics.D3.Base (D3, D3Eff)
import Graphics.D3.Selection as D3S
import Graphics.D3.Util (ffi)
foreign import _drawPhylo :: EffectFn7
(Array Branch)
(Array Period)
(Array Group)
(Array Link)
(Array AncestorLink)
(Array BranchLink)
(Array Number)
(Unit)
drawPhylo ::
Array Branch
-> Array Period
-> Array Group
-> Array Link
-> Array AncestorLink
-> Array BranchLink
-> Array Number
-> Effect Unit
drawPhylo = runEffectFn7 _drawPhylo
foreign import _drawWordCloud :: forall a. EffectFn1 (Array a) Unit
drawWordCloud :: forall a. Array a -> Effect Unit
drawWordCloud = runEffectFn1 _drawWordCloud
-----------------------------------------------------------
orDie :: forall err a. Maybe a -> err -> Either err a
orDie (Just a) _ = Right a
orDie Nothing err = Left err
-- @XXX: FFI.Simple `(...)` throws error (JavaScript issue)
-- need to decompose computation
--
-- (?) chained prototype property issue?
applyTo_ :: forall src arg res. src -> String -> Array arg -> res
applyTo_ src name args =
let fn = getProperty name src
in applyTo fn src args
infixl 4 applyTo_ as ~~
-- @WIP: DOM.Simple lack of "ClassList" module
addClass :: forall el. el -> Array String -> Effect Unit
addClass el args = pure $ (el .. "classList") ~~ "add" $ args
removeClass :: forall el. el -> Array String -> Effect Unit
removeClass el args = pure $ (el .. "classList") ~~ "remove" $ args
-- @WIP: "Graphics.D3.Selection" lack of "filter" function
-- @WIP: "Graphics.D3.Selection" lack of "nodes" function
selectionFilter :: forall d. String -> D3S.Selection d -> D3Eff (D3S.Selection D3S.Void)
selectionFilter = ffi ["query", "selection", ""] "selection.filter(query)"
selectionNodes :: forall d el. D3S.Selection d -> D3Eff (Array el)
selectionNodes = ffi ["selection", ""] "selection.nodes()"
-----------------------------------------------------------
setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
setGlobalDependencies w (PhyloDataSet o)
= do
_ <- pure $ (w .= "freq") {}
_ <- pure $ (w .= "nbBranches") o.nbBranches
_ <- pure $ (w .= "nbDocs") o.nbDocs
_ <- pure $ (w .= "nbFoundations") o.nbFoundations
_ <- pure $ (w .= "nbGroups") o.nbGroups
_ <- pure $ (w .= "nbPeriods") o.nbPeriods
_ <- pure $ (w .= "nbTerms") o.nbTerms
_ <- pure $ (w .= "sources") o.sources
_ <- pure $ (w .= "terms") []
_ <- pure $ (w .= "timeScale") o.timeScale
_ <- pure $ (w .= "weighted") o.weighted
(freq :: Array Int) <- pure $ w .. "freq"
(terms :: Array GlobalTerm) <- pure $ w .. "terms"
for_ o.groups \(Group g) -> do
let
f = g.foundation
l = g.label
forWithIndex_ f \idx val ->
let
idx' = show idx
val' = show val
in
-- For each entries in group.foundation array,
-- increment consequently the global window.keys array
case (freq .? val') of
Nothing -> pure $ (freq .= val') 0
Just v -> pure $ (freq .= val') (v +1)
*>
-- For each entries in group.foundation array,
-- if the global window.terms does not have it in property,
-- append an item to the global window.terms
case (terms .? val') of
Just _ -> pure unit
Nothing -> void <<< pure $ (terms .= val') $ GlobalTerm
{ label: l .. idx'
, fdt : val'
}
-- Use FFI native `Array.flat` method (not mutating its caller in this
-- context)
void do
new <- pure $ (terms ~~ "flat") []
pure $ (w .= "terms") new
-- @XXX: prevent PureScript from not injecting D3
setGlobalD3Reference :: Window -> D3 -> Effect Unit
setGlobalD3Reference window d3 = void $ pure $ (window .= "d3") d3
-----------------------------------------------------------
unhide :: Document -> String -> Effect Unit
unhide d s = do
setText s `toElements` "#phyloName"
turnVisible `toElements` "#phyloName"
turnVisible `toElements` ".reset"
turnVisible `toElements` ".label"
turnVisible `toElements` ".heading"
turnVisible `toElements` ".export"
where
toElements fn query = querySelectorAll d query >>= flip for_ fn
turnVisible el = do
style <- pure $ (el .. "style")
pure $ (style .= "visibility") "visible"
setText name el = pure $ (el .= "innerHTML") name
-----------------------------------------------------------
highlightSource :: Window -> String -> Effect Unit
highlightSource window value =
let
hasHighlight = maybe false identity (window .? "highlighted")
hasLdView = maybe false identity (window .? "ldView")
in do
groups <- D3S.rootSelectAll ".group-inner"
if hasHighlight
then
selectionFilter ".source-focus" groups
>>= selectionNodes
>>= flip for_ (flip addClass [ "group-unfocus" ])
else
pure unit
-- unselected all the groups
_ <- selectionNodes groups
>>= flip for_ (flip removeClass [ "source-focus" ])
if hasLdView
then
selectionNodes groups
>>= flip for_ (fill "#f5eee6")
else
selectionNodes groups
>>= flip for_ (fill "#fff")
_ <- D3S.rootSelectAll ".peak"
>>= D3S.classed "peak-focus-source" false
-- select the relevant ones
if (value == "unselect")
then
pure unit
else do
arr <- selectionFilter (".source-" <> value) groups
>>= selectionNodes
drawWordCloud arr
for_ arr selectNodeGroup
where
fill :: forall el. String -> el -> Effect Unit
fill hex el = do
style <- pure $ (el .. "style")
pure $ (style .= "fill") hex
selectNodeGroup :: forall el. el -> Effect Unit
selectNodeGroup el = do
removeClass el [ "group-unfocus" ]
addClass el [ "source-focus" ]
fill "#a6bddb" el
bid <- pure $ (el ~~ "getAttribute") [ "bId" ]
void $
D3S.rootSelect ("#peak-" <> bid)
>>= D3S.classed "peak-focus-source" true
module Gargantext.Components.PhyloExplorer.JSON where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep as GR
import Data.Maybe (Maybe)
import Data.Show.Generic (genericShow)
import Gargantext.Utils.SimpleJSON (untaggedSumRep)
import Simple.JSON as JSON
type GraphData =
( bb :: String
, color :: String
, fontsize :: String
, label :: String
, labelloc :: String
, lheight :: String
, lp :: String
, lwidth :: String
, name :: String
, nodesep :: String
, overlap :: String
, phyloBranches :: String
, phyloDocs :: String
, phyloFoundations :: String
, phyloGroups :: String
, phyloPeriods :: String
, phyloSources :: String
, phyloTerms :: String
, phyloTimeScale :: String
, rank :: String
, ranksep :: String
, ratio :: String
, splines :: String
, style :: String
)
--------------------------------------------------
newtype PhyloJSONSet = PhyloJSONSet
{ _subgraph_cnt :: Int
, directed :: Boolean
, edges :: Array RawEdge
, objects :: Array RawObject
, strict :: Boolean
| GraphData
}
derive instance Generic PhyloJSONSet _
derive instance Eq PhyloJSONSet
instance Show PhyloJSONSet where show = genericShow
derive newtype instance JSON.ReadForeign PhyloJSONSet
--------------------------------------------------
type NodeData =
( height :: String
, label :: String
, name :: String
, nodeType :: String
, pos :: String
, shape :: String
, width :: String
)
data RawObject
= GroupToNode
{ _gvid :: Int
, bId :: String
, branchId :: String
, fontname :: String
, foundation :: String
, frequence :: String
, from :: String
, lbl :: String
, penwidth :: String
, role :: String
, seaLvl :: String
, source :: String
, strFrom :: Maybe String
, strTo :: Maybe String
, support :: String
, to :: String
, weight :: String
| NodeData
}
| BranchToNode
{ _gvid :: Int
, age :: String
, bId :: String
, birth :: String
, branchId :: String
, branch_x :: String
, branch_y :: String
, fillcolor :: String
, fontname :: String
, fontsize :: String
, size :: String
, style :: String
| NodeData
}
| PeriodToNode
{ _gvid :: Int
, fontsize :: String
, from :: String
, strFrom :: Maybe String
, strTo :: Maybe String
, to :: String
| NodeData
}
| Layer
{ _gvid :: Int
, nodes :: Array Int
| GraphData
}
derive instance Generic RawObject _
derive instance Eq RawObject
instance Show RawObject where show = genericShow
instance JSON.ReadForeign RawObject where
readImpl f = GR.to <$> untaggedSumRep f
--------------------------------------------------
type EdgeData =
( color :: String
, head :: Int
, pos :: String
, tail :: Int
, width :: String
)
data RawEdge
= GroupToAncestor
{ _gvid :: Int
, arrowhead :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
, style :: String
| EdgeData
}
| GroupToGroup
{ _gvid :: Int
, constraint :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
| EdgeData
}
| BranchToGroup
{ _gvid :: Int
, arrowhead :: String
, edgeType :: String
| EdgeData
}
| BranchToBranch
{ _gvid :: Int
, arrowhead :: String
, style :: String
| EdgeData
}
| PeriodToPeriod
{ _gvid :: Int
| EdgeData
}
derive instance Generic RawEdge _
derive instance Eq RawEdge
instance Show RawEdge where show = genericShow
instance JSON.ReadForeign RawEdge where
readImpl f = GR.to <$> untaggedSumRep f
module Gargantext.Components.PhyloExplorer.Layout
( layout
) where
import Gargantext.Prelude
import DOM.Simple (document, window)
import Data.Array as Array
import Gargantext.Components.PhyloExplorer.Draw (drawPhylo, highlightSource, setGlobalD3Reference, setGlobalDependencies, unhide)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet(..))
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Graphics.D3.Base (d3)
import Reactix as R
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.PhyloExplorer"
type Props =
( phyloDataSet :: PhyloDataSet
)
layout :: R2.Component Props
layout = R.createElement layoutCpt
layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where
cpt { phyloDataSet: (PhyloDataSet o)
} _ = do
-- States
R.useEffectOnce' $ do
unhide document o.name
setGlobalD3Reference window d3
setGlobalDependencies window (PhyloDataSet o)
drawPhylo
o.branches
o.periods
o.groups
o.links
o.ancestorLinks
o.branchLinks
o.bb
-- Render
pure $
H.div
{ className: "phylo" }
[
-- <!-- row 1 -->
H.div
{ className: "phylo-title font-bold" }
[ H.text "Mèmiescape" ]
,
H.div
{ className: "phylo-folder" }
[
-- <!-- title bar (static mode) -->
H.label
{ id: "phyloName"
, className: "phylo-name"
}
[]
,
-- <!-- folder bar -->
-- H.label
-- { id: "file-label"
-- , for: "file-path"
-- , className: "input-file"
-- }
-- [ H.text "load a phylomemy →" ]
-- ,
-- H.input
-- { id: "file-path"
-- , type: "file"
-- , maxLength: "10"
-- }
-- ,
-- H.label
-- { id: "file-name"
-- , className: "input-name"
-- }
-- []
-- ,
-- H.button
-- { id: "draw"
-- , className: "button draw"
-- }
-- [ H.text "draw" ]
-- ,
-- <!-- source selector -->
R2.select
{ id: "checkSource"
, className: "select-source"
, defaultValue: ""
, on: { change: \e -> highlightSource window e.target.value }
} $
[
H.option
{ disabled: true
, value: ""
}
[ H.text "select a source ↴" ]
,
H.option
{ value: "unselect" }
[ H.text "unselect source ✕" ]
]
<>
flip Array.mapWithIndex o.sources
( \idx val ->
H.option
{ value: idx }
[ H.text val ]
)
,
-- <!-- search bar -->
H.label
{ id: "search-label"
, className: "search-label"
}
[ H.text "find a term →" ]
,
H.input
{ id: "search-box"
, type: "text"
, className: "search"
}
,
H.input
{ id: "search-autocomplete"
, text: "text"
, className: "autocomplete"
, disabled: true
, value: ""
}
]
,
-- <!-- row 2 & 3 -->
phyloCorpus {} []
,
phyloCorpusInfo
{ nbDocs : o.nbDocs
, nbFoundations : o.nbFoundations
, nbPeriods : o.nbPeriods
}
[]
,
phyloHow {} []
,
phyloPhylo {} []
,
phyloPhyloInfo
{ nbTerms : o.nbTerms
, nbGroups : o.nbGroups
, nbBranches : o.nbBranches
}
[]
,
H.div
{ id: "phyloIsoLine"
, className: "phylo-isoline"
}
[]
,
H.div
{ id: "phyloIsolineInfo"
, className: "phylo-isoline-info"
}
[
H.div
{ className: "btn-group" }
[
H.button
{ id: "reset"
, className: "button reset"
}
[
H.i
{ className: "fa fa-arrows-alt" }
[]
]
,
H.button
{ id: "label"
, className: "button label"
}
[
H.i
{ className: "fa fa-dot-circle-o" }
[]
]
,
H.button
{ id: "heading"
, className: "button heading"
}
[
H.i
{ className: "fa fa-sort-alpha-asc" }
[]
]
,
H.button
{ id: "export"
, className: "button export"
}
[
H.i
{ className: "fas fa-camera" }
[]
]
]
]
,
-- <!-- row 4 -->
H.div
{ id: "phyloScape"
, className: "phylo-scape"
}
[]
,
H.div
{ id: "phyloTimeline"
, className: "phylo-timeline"
}
[]
,
H.div
{ id: "phyloGraph"
, className: "phylo-graph"
}
[]
]
--------------------------------------------------------
phyloCorpus :: R2.Component ()
phyloCorpus = R.createElement phyloCorpusCpt
phyloCorpusCpt :: R.Component ()
phyloCorpusCpt = here.component "phyloCorpus" cpt where
cpt _ _ = do
-- Render
pure $
H.div
{ id: "phyloCorpus"
, className: "phylo-corpus"
}
[ H.text "corpus" ]
---------------------------------------------------------
phyloHow :: R2.Component ()
phyloHow = R.createElement phyloHowCpt
phyloHowCpt :: R.Component ()
phyloHowCpt = here.component "phyloHow" cpt where
cpt _ _ = do
-- Render
pure $
H.div
{ id: "phyloHow"
, className: "phylo-how"
}
[
H.a
{ id: "phyloSearch"
, href: "http://maps.gargantext.org/phylo/knowledge_visualization/memiescape/documentation.html"
, target: "_blank"
}
[
H.div
{ className: "switch" }
[
H.i
{ className: "far fa-question-circle how" }
[]
,
H.i
{ className: "fa fa-question-circle how" }
[
H.span
{ className: "tooltip" }
[ H.text "click to see how the phylomemy was built" ]
]
]
]
]
---------------------------------------------------------
phyloPhylo :: R2.Component ()
phyloPhylo = R.createElement phyloPhyloCpt
phyloPhyloCpt :: R.Component ()
phyloPhyloCpt = here.component "phyloPhylo" cpt where
cpt _ _ = do
-- Render
pure $
H.div
{ id: "phyloPhylo"
, className: "phylo-phylo"
}
[ H.text "phylomemy" ]
---------------------------------------------------------
type PhyloCorpusInfoProps =
( nbDocs :: Int
, nbFoundations :: Int
, nbPeriods :: Int
)
phyloCorpusInfo :: R2.Component PhyloCorpusInfoProps
phyloCorpusInfo = R.createElement phyloCorpusInfoCpt
phyloCorpusInfoCpt :: R.Component PhyloCorpusInfoProps
phyloCorpusInfoCpt = here.component "phyloCorpusInfo" cpt where
cpt props _ = do
-- Render
pure $
H.div
{ id: "phyloCorpusInfo"
, className: "phylo-corpus-info"
}
[
H.span
{}
[
H.b {} [ H.text $ show props.nbDocs ]
, H.text $ nbsp 1 <> "docs"
]
,
H.span
{}
[
H.b {} [ H.text $ show props.nbFoundations ]
, H.text $ nbsp 1 <> "foundations"
]
,
H.span
{}
[
H.b {} [ H.text $ show props.nbPeriods ]
, H.text $ nbsp 1 <> "periods"
]
]
---------------------------------------------------------
type PhyloPhyloInfoProps =
( nbTerms :: Int
, nbGroups :: Int
, nbBranches :: Int
)
phyloPhyloInfo :: R2.Component PhyloPhyloInfoProps
phyloPhyloInfo = R.createElement phyloPhyloInfoCpt
phyloPhyloInfoCpt :: R.Component PhyloPhyloInfoProps
phyloPhyloInfoCpt = here.component "phyloPhyloInfo" cpt where
cpt props _ = do
-- Render
pure $
H.div
{ id: "phyloPhyloInfo"
, className: "phylo-phylo-info"
}
[
H.span
{}
[
H.b
{ id: "phyloTerms" }
[ H.text $ show props.nbTerms ]
, H.text $ nbsp 1 <> "terms"
]
,
H.span
{}
[
H.b
{ id: "phyloGroups" }
[ H.text $ show props.nbGroups ]
, H.text $ nbsp 1 <> "groups"
]
,
H.span
{}
[
H.b
{ id: "phyloBranches" }
[ H.text $ show props.nbBranches ]
, H.text $ nbsp 1 <> "branches"
]
]
'use strict';
/**
* @name yearToDate
* @param {string} year
* @returns {Date}
*/
function yearToDate(year) {
var d = new Date();
d.setYear(parseInt(year));
d.setMonth(0);
d.setDate(1);
return d;
}
/**
* @name stringToDate
* @param {string} str
* @returns {Date}
*/
function stringToDate(str) {
var arr = (str.replace('"','')).split('-');
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setMonth(d.getMonth() - 1);
d.setDate(parseInt(arr[2]));
return d;
}
/**
* @name utcStringToDate
* @param {string} str
* @returns {Date}
*/
function utcStringToDate(str) {
var arr = ((str.replace('"','')).replace(' UTC','')).split(/[\s-:]+/);
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setDate(parseInt(arr[2]));
d.setHours(parseInt(arr[3]), parseInt(arr[4]), parseInt(arr[5]))
return d;
}
exports.yearToDate = yearToDate;
exports.stringToDate = stringToDate;
exports.utcStringToDate = utcStringToDate;
This diff is collapsed.
module Gargantext.Components.Reload
( reloadContext
, textsReloadContext ) where
import Data.Maybe (Maybe(..))
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Toestand as T
-- | Reload Context
-- |
-- | Use with `R.provideContext` as a (nested) context
-- |
-- | https://medium.com/@NickIannelli/nested-context-the-underrated-aspect-thats-probably-missing-from-your-react-app-16e73f7d1
reloadContext :: R.Context (Maybe (T.Box T2.Reload))
reloadContext = R.createContext Nothing
-----------------------------------------------------------------
-- @XXX: This custom context solves a wrong monolithic front design where
-- "DocsTable" component is used for many different use cases
-- Normally we would have use the classic "Gargantext.Components.Reload",
-- but we limit side-effects by using another context reference
--
-- See its use in "Gargantext.Components.Nodes.Texts"
textsReloadContext :: R.Context (Maybe (T.Box T2.Reload))
textsReloadContext = R.createContext Nothing
...@@ -22,7 +22,7 @@ defaultBackends = backend' "Demo" "Public Show room" "http ...@@ -22,7 +22,7 @@ defaultBackends = backend' "Demo" "Public Show room" "http
, backend' "Organization" "Hello Word Company" "https://helloword.gargantext.org" , backend' "Organization" "Hello Word Company" "https://helloword.gargantext.org"
, backend' "Networking" "Complex Systems Community" "https://complexsystems.gargantext.org" , backend' "Networking" "Complex Systems Community" "https://complexsystems.gargantext.org"
, backend' "Networking" "Digeing European Project" "https://europa.gargantext.org" , backend' "Networking" "Digeing European Project" "https://europa.gargantext.org"
, backend' "Development" "Main SandBox" "https://dev.gargantext.org" , backend' "Development" "Main SandBox" "https://dev.sub.gargantext.org"
, backend' "Private" "Offline Bunker" "http://localhost:8008" , backend' "Private" "Offline Bunker" "http://localhost:8008"
] ]
...@@ -58,7 +58,7 @@ defaultApps = relative :| [prod, dev, demo, haskell, python, caddy] ...@@ -58,7 +58,7 @@ defaultApps = relative :| [prod, dev, demo, haskell, python, caddy]
where where
relative = frontend "/#/" "" "Relative" relative = frontend "/#/" "" "Relative"
prod = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org" prod = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)" dev = frontend "/#/" "https://dev.sub.gargantext.org" "gargantext.org (dev)"
demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)" demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext" haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
python = frontend "/#/" "http://localhost:8000" "localhost.python" python = frontend "/#/" "http://localhost:8000" "localhost.python"
......
...@@ -152,7 +152,7 @@ postMultipartFormData mtoken url body = do ...@@ -152,7 +152,7 @@ postMultipartFormData mtoken url body = do
, ARH.Accept applicationJSON , ARH.Accept applicationJSON
] <> ] <>
foldMap (\token -> foldMap (\token ->
[ ARH.RequestHeader "Authorization" $ "Bearer " <> token ] [ ARH.RequestHeader "Authorization" $ " " <> token ]
) mtoken ) mtoken
, content = Just $ formData fd , content = Just $ formData fd
} }
......
...@@ -195,7 +195,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) = ...@@ -195,7 +195,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
<> "&listType=" <> show MapTerm -- listId <> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId <> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i -- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
------- misc routing stuff ------- misc routing stuff
......
...@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Boxed ...@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Boxed
, class NonEmpty, nonEmpty , class NonEmpty, nonEmpty
, class Minimum, minimum , class Minimum, minimum
, class Maximum, maximum , class Maximum, maximum
, lowercase, uppercase, email , lowercase, uppercase, email, date
) where ) where
import Gargantext.Prelude import Gargantext.Prelude
...@@ -14,7 +14,7 @@ import Data.String.Regex (test) ...@@ -14,7 +14,7 @@ import Data.String.Regex (test)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Validation.Semigroup (invalid) import Data.Validation.Semigroup (invalid)
import Effect (Effect) import Effect (Effect)
import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern) import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern, datePattern)
import Toestand as T import Toestand as T
class Eq a <= Equals a where class Eq a <= Equals a where
...@@ -75,3 +75,9 @@ email field = T.read >=> case _ of ...@@ -75,3 +75,9 @@ email field = T.read >=> case _ of
input input
| (not $ test emailPattern input) -> pure $ invalid [ field /\ "email" ] | (not $ test emailPattern input) -> pure $ invalid [ field /\ "email" ]
| otherwise -> pure $ pure unit | otherwise -> pure $ pure unit
date :: Field -> T.Box String -> Effect VForm
date field = T.read >=> case _ of
input
| (not $ test datePattern input) -> pure $ invalid [ field /\ "date" ]
| otherwise -> pure $ pure unit
...@@ -8,3 +8,9 @@ ...@@ -8,3 +8,9 @@
* @type {RegExp} * @type {RegExp}
*/ */
exports.emailPattern = /[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?/; exports.emailPattern = /[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?/;
/**
* Date Pattern
* @link https://www.regextester.com/96683
* @type {RegExp}
*/
exports.datePattern = /([12]\d{3}-(0[1-9]|1[0-2])-(0[1-9]|[12]\d|3[01]))/
module Gargantext.Hooks.FormValidation.Types module Gargantext.Hooks.FormValidation.Types
( VForm, EForm, Field ( VForm, EForm, Field
, emailPattern , emailPattern, datePattern
) where ) where
import Gargantext.Prelude import Gargantext.Prelude
...@@ -11,6 +11,7 @@ import Data.Tuple (Tuple) ...@@ -11,6 +11,7 @@ import Data.Tuple (Tuple)
import Data.Validation.Semigroup (V) import Data.Validation.Semigroup (V)
foreign import emailPattern :: Regex foreign import emailPattern :: Regex
foreign import datePattern :: Regex
-- @TODO: types for errors (`Tuple Field String`)? -- @TODO: types for errors (`Tuple Field String`)?
......
...@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Unboxed ...@@ -3,7 +3,7 @@ module Gargantext.Hooks.FormValidation.Unboxed
, class NonEmpty, nonEmpty , class NonEmpty, nonEmpty
, class Minimum, minimum , class Minimum, minimum
, class Maximum, maximum , class Maximum, maximum
, lowercase, uppercase, email , lowercase, uppercase, email, date
) where ) where
import Gargantext.Prelude import Gargantext.Prelude
...@@ -14,7 +14,7 @@ import Data.String.Regex (test) ...@@ -14,7 +14,7 @@ import Data.String.Regex (test)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.Validation.Semigroup (invalid) import Data.Validation.Semigroup (invalid)
import Effect (Effect) import Effect (Effect)
import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern) import Gargantext.Hooks.FormValidation.Types (Field, VForm, emailPattern, datePattern)
class Eq a <= Equals a where class Eq a <= Equals a where
equals :: Field -> a -> a -> Effect VForm equals :: Field -> a -> a -> Effect VForm
...@@ -63,3 +63,8 @@ email :: Field -> String -> Effect VForm ...@@ -63,3 +63,8 @@ email :: Field -> String -> Effect VForm
email field input email field input
| (not $ test emailPattern input) = pure $ invalid [ field /\ "email" ] | (not $ test emailPattern input) = pure $ invalid [ field /\ "email" ]
| otherwise = pure $ pure unit | otherwise = pure $ pure unit
date :: Field -> String -> Effect VForm
date field input
| (not $ test datePattern input) = pure $ invalid [ field /\ "date" ]
| otherwise = pure $ pure unit
...@@ -658,6 +658,7 @@ data AsyncTaskType = AddNode ...@@ -658,6 +658,7 @@ data AsyncTaskType = AddNode
| GraphRecompute | GraphRecompute
| ListUpload | ListUpload
| ListCSVUpload -- legacy v3 CSV upload for lists | ListCSVUpload -- legacy v3 CSV upload for lists
| NodeDocument
| Query | Query
| UpdateNgramsCharts | UpdateNgramsCharts
| UpdateNode | UpdateNode
...@@ -678,6 +679,7 @@ asyncTaskTypePath CorpusFormUpload = "add/form/async/" ...@@ -678,6 +679,7 @@ asyncTaskTypePath CorpusFormUpload = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/" asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath ListUpload = "add/form/async/" asyncTaskTypePath ListUpload = "add/form/async/"
asyncTaskTypePath ListCSVUpload = "csv/add/form/async/" asyncTaskTypePath ListCSVUpload = "csv/add/form/async/"
asyncTaskTypePath NodeDocument = "document/upload/async"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/" asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
......
...@@ -39,7 +39,7 @@ instance ( GenericTaggedSumRep a ...@@ -39,7 +39,7 @@ instance ( GenericTaggedSumRep a
) => GenericTaggedSumRep (GR.Constructor name a) where ) => GenericTaggedSumRep (GR.Constructor name a) where
genericTaggedSumRep f = do genericTaggedSumRep f = do
-- r :: { "type" :: String } <- JSON.read' f -- r :: { "type" :: String } <- JSON.read' f
-- if r."type" == name -- if r."type" == name
-- then withExcept (map $ ErrorAtProperty name) $ GR.Constructor <$> genericTaggedSumRep r -- then withExcept (map $ ErrorAtProperty name) $ GR.Constructor <$> genericTaggedSumRep r
-- else fail $ ForeignError $ "Wrong type tag " <> r."type" <> " where " <> name <> " was expected." -- else fail $ ForeignError $ "Wrong type tag " <> r."type" <> " where " <> name <> " was expected."
r :: FO.Object Foreign <- JSON.read' f r :: FO.Object Foreign <- JSON.read' f
...@@ -60,5 +60,28 @@ instance ( JSON.ReadForeign a ...@@ -60,5 +60,28 @@ instance ( JSON.ReadForeign a
-----------------------------------------------------------
-- | Applying Generics-Rep to decoding untagged JSON values
-- |
-- | https://purescript-simple-json.readthedocs.io/en/latest/generics-rep.html
class UntaggedSumRep rep where
untaggedSumRep :: Foreign -> Foreign.F rep
instance untaggedSumRepSum ::
( UntaggedSumRep a
, UntaggedSumRep b
) => UntaggedSumRep (GR.Sum a b) where
untaggedSumRep f
= GR.Inl <$> untaggedSumRep f
<|> GR.Inr <$> untaggedSumRep f
instance untaggedSumRepConstructor ::
( UntaggedSumRep a
) => UntaggedSumRep (GR.Constructor name a) where
untaggedSumRep f = GR.Constructor <$> untaggedSumRep f
instance untaggedSumRepArgument ::
( JSON.ReadForeign a
) => UntaggedSumRep (GR.Argument a) where
untaggedSumRep f = GR.Argument <$> JSON.readImpl f
This diff is collapsed.
...@@ -8,3 +8,4 @@ ...@@ -8,3 +8,4 @@
@use "_range_slider.sass" @use "_range_slider.sass"
@use "_annotation.sass" @use "_annotation.sass"
@use "_folder_view.sass" @use "_folder_view.sass"
@use "_phylo.scss"
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