Commit 24e8392f authored by James Laver's avatar James Laver

check it out

parent 1abaea10
...@@ -945,7 +945,7 @@ ...@@ -945,7 +945,7 @@
"prelude", "prelude",
"unsafe-coerce" "unsafe-coerce"
], ],
"repo": "https://github.com/irresponsible/purescript-dom-simple", "repo": "https://github.com/poorscript/purescript-dom-simple",
"version": "v0.2.7" "version": "v0.2.7"
}, },
"dotenv": { "dotenv": {
...@@ -1138,7 +1138,7 @@ ...@@ -1138,7 +1138,7 @@
"nullable", "nullable",
"unsafe-coerce" "unsafe-coerce"
], ],
"repo": "https://github.com/irresponsible/purescript-ffi-simple", "repo": "https://github.com/poorscript/purescript-ffi-simple",
"version": "v0.2.10" "version": "v0.2.10"
}, },
"filterable": { "filterable": {
...@@ -1329,6 +1329,16 @@ ...@@ -1329,6 +1329,16 @@
"repo": "https://github.com/slamdata/purescript-formatters.git", "repo": "https://github.com/slamdata/purescript-formatters.git",
"version": "v4.0.1" "version": "v4.0.1"
}, },
"formula": {
"dependencies": [
"prelude",
"reactix",
"toestand",
"typisch"
],
"repo": "https://github.com/poorscript/purescript-formula",
"version": "v0.2.1"
},
"free": { "free": {
"dependencies": [ "dependencies": [
"catenable-lists", "catenable-lists",
...@@ -3596,10 +3606,11 @@ ...@@ -3596,10 +3606,11 @@
"functions", "functions",
"nullable", "nullable",
"prelude", "prelude",
"tuples",
"unsafe-coerce" "unsafe-coerce"
], ],
"repo": "https://github.com/irresponsible/purescript-reactix", "repo": "https://github.com/poorscript/purescript-reactix",
"version": "v0.4.6" "version": "v0.4.11"
}, },
"read": { "read": {
"dependencies": [ "dependencies": [
...@@ -4431,14 +4442,12 @@ ...@@ -4431,14 +4442,12 @@
"dependencies": [ "dependencies": [
"aff", "aff",
"coroutines", "coroutines",
"web-dom",
"freet", "freet",
"profunctor-lenses", "profunctor-lenses",
"react", "react"
"react-dom"
], ],
"repo": "https://github.com/poorscript/purescript-thermite.git", "repo": "https://github.com/paf31/purescript-thermite.git",
"version": "hide-2020-03-04" "version": "v6.3.1"
}, },
"thermite-dom": { "thermite-dom": {
"dependencies": [ "dependencies": [
...@@ -4458,6 +4467,19 @@ ...@@ -4458,6 +4467,19 @@
"repo": "https://github.com/purescript-contrib/purescript-these.git", "repo": "https://github.com/purescript-contrib/purescript-these.git",
"version": "v4.0.0" "version": "v4.0.0"
}, },
"toestand": {
"dependencies": [
"prelude",
"effect",
"foldable-traversable",
"reactix",
"record",
"tuples",
"typelevel-prelude"
],
"repo": "https://github.com/poorscript/purescript-toestand",
"version": "v0.5.0"
},
"tolerant-argonaut": { "tolerant-argonaut": {
"dependencies": [ "dependencies": [
"argonaut-codecs", "argonaut-codecs",
...@@ -4642,6 +4664,13 @@ ...@@ -4642,6 +4664,13 @@
"repo": "https://github.com/mwalkerwells/purescript-typelevel-rowlist-limits.git", "repo": "https://github.com/mwalkerwells/purescript-typelevel-rowlist-limits.git",
"version": "v0.0.6" "version": "v0.0.6"
}, },
"typisch": {
"dependencies": [
"prelude"
],
"repo": "https://github.com/poorscript/purescript-typisch",
"version": "v0.2.1"
},
"uint": { "uint": {
"dependencies": [ "dependencies": [
"maybe", "maybe",
......
# THIS IS AN AUTOGENERATED FILE. DO NOT EDIT THIS FILE DIRECTLY.
# yarn lockfile v1
lastUpdateCheck 1611671086951
...@@ -4,13 +4,12 @@ ...@@ -4,13 +4,12 @@
### Social contract ### Social contract
1. Use and promote welcoming behavior to respect the [Code of Conduct](https://gitlab.iscpif.fr/humanities/gargantext/blob/master/CODE_OF_CONDUCT.md) 1. Be nice, welcome and treat others with respect: [Code of Conduct](https://gitlab.iscpif.fr/humanities/gargantext/blob/master/CODE_OF_CONDUCT.md)
2. We are a team as whole: here to help each others 2. We are a team as whole: here to help each other
- knowing the unknown is a value but ignoring the unknown is a failure - knowing the unknown is a value but ignoring the unknown is a failure
- do not ask to ask: just ask - do not ask to ask: just ask
- there is no stupid question(s) - there are no stupid questions
- there is no unique solution(s)
3. Watch deadlines individually and collectively 3. Watch deadlines individually and collectively
- at 0% of the time of the task, agree on the /estimate of time to fix the issue. - at 0% of the time of the task, agree on the /estimate of time to fix the issue.
...@@ -82,30 +81,38 @@ Main branches are: ...@@ -82,30 +81,38 @@ Main branches are:
## Technicals ## Technicals
Please configure your editor accordingly (ask for tips if needed or put your tips here)
### Code main guidelines ### Code guidelines
#### Code Design #### Basics
Please configure your editor accordingly (ask for tips if needed or put your tips here) Line length:
* Good lines of code are no more than 80 characters long.
* Acceptable lines of code are no more than 100
* Bad lines of code are no more than 120.
Whitespace:
* 2 spaces per indentation stop, or more if needed by the compiler
* Do not use tab characters.
* Remove trailing whitespace from lines. Includes blank lines.
#### Layout
##### Line length
* all line length should be < 120 chars
##### Identation
* 2 spaces or more if needed by the compiler
* i.e. Tab character is avoided
* avoid trailing spaces, mostly spaces at the end of lines (remove it)
* HTML nodes: * HTML nodes:
``` ```
div [] div {...}
[ div [] [ div {...} [ a {} [...], a {...} [...] ]
[ a [] [...] , div {...}
, a [] [...] , div
] { ...
, div [] , ...
}
[ ... [ ...
, ... , ...
] ]
......
This diff is collapsed.
...@@ -2,20 +2,7 @@ let upstream = ...@@ -2,20 +2,7 @@ let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides = let overrides =
{ thermite = { globals =
{ dependencies =
[ "aff"
, "coroutines"
, "web-dom"
, "freet"
, "profunctor-lenses"
, "react"
, "react-dom"
]
, repo = "https://github.com/poorscript/purescript-thermite.git"
, version = "hide-2020-03-04"
}
, globals =
{ dependencies = [ "functions", "maybe" ] { dependencies = [ "functions", "maybe" ]
, repo = "https://github.com/purescript/purescript-globals" , repo = "https://github.com/purescript/purescript-globals"
, version = "v4.1.0" , version = "v4.1.0"
...@@ -23,33 +10,25 @@ let overrides = ...@@ -23,33 +10,25 @@ let overrides =
} }
let additions = let additions =
{ sequences = { dom-simple =
{ dependencies = { dependencies =
[ "prelude" [ "arrays"
, "console"
, "effect"
, "ffi-simple"
, "functions"
, "nullable"
, "prelude"
, "unsafe-coerce" , "unsafe-coerce"
, "partial"
, "unfoldable"
, "lazy"
, "arrays"
, "profunctor"
, "maybe"
, "tuples"
, "newtype"
] ]
, repo = "https://github.com/hdgarrood/purescript-sequences.git" , repo = "https://github.com/poorscript/purescript-dom-simple"
, version = "v2.1.0" , version = "v0.2.7"
}
, spec-discovery =
{ dependencies =
[ "prelude", "effect", "arrays", "spec", "node-fs" ]
, repo = "https://github.com/purescript-spec/purescript-spec-discovery"
, version = "v4.0.0"
} }
, spec-quickcheck = , dom-filereader =
{ dependencies = { dependencies =
[ "prelude", "aff", "random", "quickcheck", "spec" ] [ "aff", "arraybuffer-types", "web-file", "web-html" ]
, repo = "https://github.com/purescript-spec/purescript-spec-quickcheck" , repo = "https://github.com/nwolverson/purescript-dom-filereader"
, version = "v3.1.0" , version = "v5.0.0"
} }
, ffi-simple = , ffi-simple =
{ dependencies = { dependencies =
...@@ -60,28 +39,14 @@ let additions = ...@@ -60,28 +39,14 @@ let additions =
, "nullable" , "nullable"
, "unsafe-coerce" , "unsafe-coerce"
] ]
, repo = "https://github.com/irresponsible/purescript-ffi-simple" , repo = "https://github.com/poorscript/purescript-ffi-simple"
, version = "v0.2.10" , version = "v0.2.10"
} }
, dom-simple = , formula =
{ dependencies =
[ "arrays"
, "console"
, "effect"
, "ffi-simple"
, "functions"
, "nullable"
, "prelude"
, "unsafe-coerce"
]
, repo = "https://github.com/irresponsible/purescript-dom-simple"
, version = "v0.2.7"
}
, dom-filereader =
{ dependencies = { dependencies =
[ "aff", "arraybuffer-types", "web-file", "web-html" ] [ "prelude", "reactix", "toestand", "typisch" ]
, repo = "https://github.com/nwolverson/purescript-dom-filereader" , repo = "https://github.com/poorscript/purescript-formula"
, version = "v5.0.0" , version = "v0.2.1"
} }
, markdown = , markdown =
{ dependencies = { dependencies =
...@@ -110,10 +75,63 @@ let additions = ...@@ -110,10 +75,63 @@ let additions =
, "functions" , "functions"
, "nullable" , "nullable"
, "prelude" , "prelude"
, "tuples"
, "unsafe-coerce"
]
, repo = "https://github.com/poorscript/purescript-reactix"
, version = "v0.4.11"
}
, read =
{ dependencies =
[ "prelude", "maybe", "strings" ]
, repo = "https://github.com/truqu/purescript-read"
, version = "v1.0.1"
}
, sequences =
{ dependencies =
[ "prelude"
, "unsafe-coerce" , "unsafe-coerce"
, "partial"
, "unfoldable"
, "lazy"
, "arrays"
, "profunctor"
, "maybe"
, "tuples"
, "newtype"
] ]
, repo = "https://github.com/irresponsible/purescript-reactix" , repo = "https://github.com/hdgarrood/purescript-sequences.git"
, version = "v0.4.6" , version = "v2.1.0"
}
, simplecrypto =
{ dependencies =
[ "prelude", "maybe", "node-buffer"]
, repo = "https://github.com/alpacaaa/purescript-simplecrypto"
, version = "v1.0.1"
}
, spec-discovery =
{ dependencies =
[ "prelude", "effect", "arrays", "spec", "node-fs" ]
, repo = "https://github.com/purescript-spec/purescript-spec-discovery"
, version = "v4.0.0"
}
, spec-quickcheck =
{ dependencies =
[ "prelude", "aff", "random", "quickcheck", "spec" ]
, repo = "https://github.com/purescript-spec/purescript-spec-quickcheck"
, version = "v3.1.0"
}
, toestand =
{ dependencies =
[ "prelude", "effect", "foldable-traversable", "reactix"
, "record", "tuples", "typelevel-prelude" ]
, repo = "https://github.com/poorscript/purescript-toestand"
, version = "v0.5.0"
}
, typisch =
{ dependencies = [ "prelude" ]
, repo = "https://github.com/poorscript/purescript-typisch"
, version = "v0.2.1"
} }
, tuples-native = , tuples-native =
{ dependencies = { dependencies =
...@@ -141,24 +159,12 @@ let additions = ...@@ -141,24 +159,12 @@ let additions =
, repo = "https://github.com/slamdata/purescript-uri" , repo = "https://github.com/slamdata/purescript-uri"
, version = "v7.0.0" , version = "v7.0.0"
} }
, read =
{ dependencies =
[ "prelude", "maybe", "strings" ]
, repo = "https://github.com/truqu/purescript-read"
, version = "v1.0.1"
}
, versions = , versions =
{ dependencies = { dependencies =
[ "prelude" ] [ "prelude" ]
, repo = "https://github.com/hdgarrood/purescript-versions.git" , repo = "https://github.com/hdgarrood/purescript-versions.git"
, version = "v5.0.1" , version = "v5.0.1"
} }
, simplecrypto =
{ dependencies =
[ "prelude", "maybe", "node-buffer"]
, repo = "https://github.com/alpacaaa/purescript-simplecrypto"
, version = "v1.0.1"
}
} }
in upstream ⫽ overrides ⫽ additions in upstream ⫽ overrides ⫽ additions
...@@ -15,6 +15,7 @@ ...@@ -15,6 +15,7 @@
"effect", "effect",
"foreign-generic", "foreign-generic",
"foreign-object", "foreign-object",
"formula",
"generics-rep", "generics-rep",
"globals", "globals",
"integers", "integers",
...@@ -29,6 +30,7 @@ ...@@ -29,6 +30,7 @@
"prelude", "prelude",
"psci-support", "psci-support",
"random", "random",
"react",
"reactix", "reactix",
"read", "read",
"record-extra", "record-extra",
...@@ -41,8 +43,9 @@ ...@@ -41,8 +43,9 @@
"string-parsers", "string-parsers",
"strings", "strings",
"stringutils", "stringutils",
"thermite", "toestand",
"tuples-native", "tuples-native",
"typisch",
"uint", "uint",
"uri", "uri",
"versions", "versions",
......
...@@ -17,7 +17,7 @@ import Gargantext.Types as GT ...@@ -17,7 +17,7 @@ import Gargantext.Types as GT
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-async-tasks" localStorageKey = "garg-async-tasks"
...@@ -49,22 +49,22 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) ...@@ -49,22 +49,22 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } })
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = ( type ReductorProps = (
appReload :: GUR.ReloadS reloadRoot :: GUR.ReloadS
, treeReload :: GUR.ReloadS , reloadForest :: GUR.ReloadS
, storage :: Storage , storage :: Storage
) )
type Reductor = R2.Reductor (Record ReductorProps) Action type Reductor = R2.Reductor (Record ReductorProps) Action
type ReductorAction = Action -> Effect Unit type ReductorAction = Action -> Effect Unit
useTasks :: GUR.ReloadS -> GUR.ReloadS -> R.Hooks Reductor useTasks :: GUR.ReloadS -> GUR.ReloadS -> R.Hooks Reductor
useTasks appReload treeReload = R2.useReductor act initializer unit useTasks reloadRoot reloadForest = R2.useReductor act initializer unit
where where
act :: R2.Actor (Record ReductorProps) Action act :: R2.Actor (Record ReductorProps) Action
act a s = action s a act a s = action s a
initializer _ = do initializer _ = do
storage <- getAsyncTasks storage <- getAsyncTasks
pure { appReload, treeReload, storage } pure { reloadRoot, reloadForest, storage }
data Action = data Action =
Insert GT.NodeID GT.AsyncTaskWithType Insert GT.NodeID GT.AsyncTaskWithType
...@@ -72,19 +72,19 @@ data Action = ...@@ -72,19 +72,19 @@ data Action =
| Remove GT.NodeID GT.AsyncTaskWithType | Remove GT.NodeID GT.AsyncTaskWithType
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps) action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action p@{ treeReload, storage } (Insert nodeId t) = do action p@{ reloadForest, storage } (Insert nodeId t) = do
_ <- GUR.bump treeReload _ <- GUR.bump reloadForest
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure $ p { storage = newStorage } pure $ p { storage = newStorage }
action p (Finish nodeId t) = do action p (Finish nodeId t) = do
action p (Remove nodeId t) action p (Remove nodeId t)
action p@{ appReload, treeReload, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do action p@{ reloadRoot, reloadForest, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do
_ <- if GT.asyncTaskTriggersAppReload typ then _ <- if GT.asyncTaskTriggersAppReload typ then
GUR.bump appReload GUR.bump reloadRoot
else else
pure unit pure unit
_ <- if GT.asyncTaskTriggersTreeReload typ then _ <- if GT.asyncTaskTriggersTreeReload typ then
GUR.bump treeReload GUR.bump reloadForest
else else
pure unit pure unit
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
......
module Gargantext.Classes where
textCenter = "text-center"
formControl = "formControl"
module Gargantext.Components.App where module Gargantext.Components.App (app) where
import Data.Array (fromFoldable) import Prelude
import Data.Maybe (Maybe(..), maybe') import Gargantext.Components.App.Data (emptyApp)
import Data.Tuple (fst, snd) import Gargantext.Components.Router (router)
import Reactix as R import Gargantext.Hooks (useHashRouter)
import Gargantext.Router as Router
import Gargantext.Prelude
import Gargantext.Components.Footer (footer)
import Gargantext.Components.Forest (forestLayout, forestLayoutWithTopBar)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Login (login)
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User (userLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contact (contactLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentMainLayout)
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists as Lists
import Gargantext.Components.Nodes.Texts as Texts
import Gargantext.Components.SimpleLayout (simpleLayout)
import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.Router (router)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Sessions (useSessions)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Types as GT import Reactix as R
import Gargantext.Utils.Reload as GUR import Toestand as T
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.App" thisModule = "Gargantext.Components.App"
-- TODO (what does this mean?) app :: R.Element
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc app = R.createElement appCpt {} []
app :: {} -> R.Element
app props = R.createElement appCpt props []
appCpt :: R.Component () appCpt :: R.Component ()
appCpt = R.hooksComponentWithModule thisModule "app" cpt where appCpt = R.hooksComponentWithModule thisModule "app" cpt where
frontends = defaultFrontends
cpt _ _ = do cpt _ _ = do
sessions <- useSessions cell <- T.useCell emptyApp -- global data
route <- useHashRouter router Home views <- T.useFieldViews cell -- read-only access for children
cursors <- T.useFieldCursors cell -- read-write access for children
asyncTasksRef <- R.useRef Nothing tasks <- R.useRef Nothing -- storage for asynchronous tasks
treeReloadRef <- GUR.newI useHashRouter Router.router cursors.route -- Install router to window
pure $ router { views, cursors, tasks } -- Render router component
showLogin <- R.useState' false
backend <- R.useState' Nothing
appReload <- GUR.new
showCorpus <- R.useState' false
handed <- R.useState' GT.RightHanded
let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ]
let forested = forestLayout { appReload
, asyncTasksRef
, backend
, currentRoute: fst route
, frontends
, handed
, sessions: fst sessions
, showLogin: snd showLogin
, treeReloadRef
}
let forestedTB = forestLayoutWithTopBar { appReload
, asyncTasksRef
, backend
, currentRoute: fst route
, frontends
, handed
, sessions: fst sessions
, showLogin: snd showLogin
, treeReloadRef
}
let defaultView _ = forested [
homeLayout { backend
, lang: LL_EN
, publicBackend
, sessions
, visible: showLogin
}
]
let withSession sid f = maybe' defaultView (ff f) (Sessions.lookup sid (fst sessions))
let sessionUpdate s = snd sessions $ Sessions.Update s
pure $ case fst showLogin of
true -> forested [ login { backend, backends, sessions, visible: showLogin } ]
false ->
case fst route of
Annuaire sid nodeId -> withSession sid $ \session -> forested [
annuaireLayout { frontends, nodeId, session }
]
Corpus sid nodeId -> withSession sid $ \session -> forested [
corpusLayout { nodeId, session }
]
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested [
documentMainLayout { listId, mCorpusId: Just corpusId, nodeId, session } []
]
Dashboard sid nodeId -> withSession sid $ \session -> forested [
dashboardLayout { nodeId, session } []
]
Document sid listId nodeId ->
withSession sid $
\session -> forested [
documentMainLayout { listId, mCorpusId: Nothing, nodeId, session } []
]
Folder sid nodeId -> withSession sid $ \session -> forested [ corpusLayout { nodeId, session } ]
FolderPrivate sid nodeId -> withSession sid $ \session -> forested [ corpusLayout { nodeId, session } ]
FolderPublic sid nodeId -> withSession sid $ \session -> forested [ corpusLayout { nodeId, session } ]
FolderShared sid nodeId -> withSession sid $ \session -> forested [ corpusLayout { nodeId, session } ]
Home -> forested [
homeLayout { backend, lang: LL_EN, publicBackend, sessions, visible: showLogin }
]
Lists sid nodeId -> withSession sid $
\session -> Lists.listsWithForest {
forestProps: {
appReload
, asyncTasksRef
, backend
, currentRoute: fst route
, frontends
, handed
, sessions: fst sessions
, showLogin: snd showLogin
, treeReloadRef
}
, listsProps: {
appReload
, asyncTasksRef
, nodeId
, session
, sessionUpdate
, treeReloadRef
}
} []
Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId ->
withSession sid $
\session ->
simpleLayout { handed } [
explorerLayout { asyncTasksRef
, backend
, currentRoute: fst route
, frontends
, graphId
, handed: fst handed
, session
, sessions: (fst sessions)
, showLogin
}
]
RouteFile sid nodeId -> withSession sid $ \session -> forested [ fileLayout { nodeId, session } ]
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested [
frameLayout { nodeId, nodeType: GT.NodeFrameCalc, session }
]
RouteFrameCode sid nodeId -> withSession sid $ \session -> forested [
frameLayout { nodeId, nodeType: GT.NodeFrameNotebook, session }
]
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested [
frameLayout { nodeId, nodeType: GT.NodeFrameWrite, session }
]
Team sid nodeId -> withSession sid $ \session -> forested [
corpusLayout { nodeId, session }
]
Texts sid nodeId -> withSession sid $
\session -> Texts.textsWithForest {
forestProps: {
appReload
, asyncTasksRef
, backend
, currentRoute: fst route
, frontends
, handed
, sessions: fst sessions
, showLogin: snd showLogin
, treeReloadRef
}
, textsProps: {
frontends
, nodeId
, session
, sessionUpdate
}
} []
----------------------------------------------------------------------------------------
-- | TODO refact UserPage and ContactPage
UserPage sid nodeId -> withSession sid $ \session -> forested [
userLayout {
appReload
, asyncTasksRef
, frontends
, nodeId
, session
, treeReloadRef
}
]
ContactPage sid aId nodeId -> withSession sid $ \session -> forested [
contactLayout {
annuaireId: aId
, appReload
, asyncTasksRef
, frontends
, nodeId
, session
, treeReloadRef
}
]
module Gargantext.Components.App.Data (App, Cursors, emptyApp) where
import Data.Set as Set
import Data.Maybe (Maybe(..))
import Toestand as T
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (OpenNodes, Sessions)
import Gargantext.Routes (AppRoute(Home))
import Gargantext.Types (Handed(RightHanded))
import Gargantext.Utils.Toestand as T2
type App =
{ handed :: Handed
, forestOpen :: OpenNodes
, reloadRoot :: Int
, reloadForest :: Int
, route :: AppRoute
, sessions :: Sessions
, showCorpus :: Boolean
, showLogin :: Boolean
}
emptyApp :: App
emptyApp =
{ handed: RightHanded
, route: Home
, forestOpen: Set.empty
, reloadRoot: T2.newReload
, reloadForest: T2.newReload
, sessions: Sessions.empty
, showCorpus: false
, showLogin: false
}
type Cursors =
{ handed :: T.Cursor Handed
, forestOpen :: T.Cursor OpenNodes
, reloadRoot :: T.Cursor Int
, reloadForest :: T.Cursor Int
, route :: T.Cursor AppRoute
, sessions :: T.Cursor Sessions
, showCorpus :: T.Cursor Boolean
, showLogin :: T.Cursor Boolean
}
...@@ -22,7 +22,8 @@ import Effect.Aff (Aff) ...@@ -22,7 +22,8 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
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 Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Category (caroussel, rating) import Gargantext.Components.Category (caroussel, rating)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star(..), decodeStar) import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star(..), decodeStar)
...@@ -42,6 +43,7 @@ import Gargantext.Utils.CacheAPI as GUC ...@@ -42,6 +43,7 @@ import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS) import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.DocsTable" thisModule = "Gargantext.Components.DocsTable"
...@@ -49,16 +51,16 @@ thisModule = "Gargantext.Components.DocsTable" ...@@ -49,16 +51,16 @@ thisModule = "Gargantext.Components.DocsTable"
type TotalRecords = Int type TotalRecords = Int
type Path a = ( type Path a =
corpusId :: Int ( corpusId :: Int
, listId :: Int , listId :: Int
, frontends :: Frontends , frontends :: Frontends
, session :: Session , session :: Session
, tabType :: TabSubType a , tabType :: TabSubType a
) )
type LayoutProps = ( type LayoutProps =
cacheState :: R.State NT.CacheState ( cacheState :: R.State NT.CacheState
, frontends :: Frontends , frontends :: Frontends
, chart :: R.Element , chart :: R.Element
, listId :: Int , listId :: Int
...@@ -74,8 +76,8 @@ type LayoutProps = ( ...@@ -74,8 +76,8 @@ type LayoutProps = (
, totalRecords :: Int , totalRecords :: Int
) )
type PageLayoutProps = ( type PageLayoutProps =
cacheState :: R.State NT.CacheState ( cacheState :: R.State NT.CacheState
, frontends :: Frontends , frontends :: Frontends
, key :: String -- NOTE Necessary to clear the component when cache state changes , key :: String -- NOTE Necessary to clear the component when cache state changes
, listId :: Int , listId :: Int
......
module Gargantext.Components.Footer where module Gargantext.Components.Footer where
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Footer" thisModule = "Gargantext.Components.Footer"
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
type FooterProps = type FooterProps s = ( session :: s )
(
session :: Sessions.Session
)
footer :: Record FooterProps -> R.Element footer :: forall cell c. T.Read cell c => Record (FooterProps cell) -> R.Element
footer props = R.createElement footerCpt props [] footer props = R.createElement footerCpt props []
footerCpt :: R.Component FooterProps footerCpt :: forall cell c. T.Read cell c => R.Component (FooterProps cell)
footerCpt = R.hooksComponentWithModule thisModule "footer" cpt footerCpt = R.hooksComponentWithModule thisModule "footer" cpt where
where cpt { session } _ =
cpt { session } _ = do pure $ H.div { className: "container" } [ H.hr {}, H.footer {} [] ]
pure $ H.div
{ className: "container" }
[ H.hr {}
, H.footer {} []
]
This diff is collapsed.
This diff is collapsed.
module Gargantext.Components.Forest.Tree.Node where module Gargantext.Components.Forest.Tree.Node where
import Gargantext.Prelude
import Data.Array (reverse) import Data.Array (reverse)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Tuple (snd) import Data.Symbol (SProxy(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
...@@ -11,8 +12,8 @@ import Effect.Class (liftEffect) ...@@ -11,8 +12,8 @@ import Effect.Class (liftEffect)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record
import Gargantext.Prelude import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
...@@ -32,21 +33,21 @@ import Gargantext.Hooks.Loader (useLoader) ...@@ -32,21 +33,21 @@ import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Version as GV import Gargantext.Version as GV
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID) import Gargantext.Types (Name, ID, reverseHanded)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR import Gargantext.Utils.Toestand as T2
thisModule :: String here :: R2.Here
thisModule = "Gargantext.Components.Forest.Tree.Node" here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node -- Main Node
type NodeMainSpanProps = ( type NodeMainSpanProps =
appReload :: GUR.ReloadS ( reloadRoot :: T.Cursor T2.Reload
, asyncTasks :: GAT.Reductor , tasks :: GAT.Reductor
, currentRoute :: Routes.AppRoute , route :: Routes.AppRoute
, folderOpen :: R.State Boolean , folderOpen :: T.Cursor Boolean
, frontends :: Frontends , frontends :: Frontends
, id :: ID , id :: ID
, isLeaf :: IsLeaf , isLeaf :: IsLeaf
...@@ -62,7 +63,7 @@ nodeSpan :: R2.Component NodeMainSpanProps ...@@ -62,7 +63,7 @@ nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt nodeSpan = R.createElement nodeSpanCpt
nodeSpanCpt :: R.Component NodeMainSpanProps nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt nodeSpanCpt = here.component "nodeSpan" cpt
where where
cpt props children = do cpt props children = do
pure $ H.div {} ([ nodeMainSpan props [] ] <> children) pure $ H.div {} ([ nodeMainSpan props [] ] <> children)
...@@ -71,11 +72,11 @@ nodeMainSpan :: R2.Component NodeMainSpanProps ...@@ -71,11 +72,11 @@ nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt nodeMainSpan = R.createElement nodeMainSpanCpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where where
cpt props@{ appReload cpt props@{ reloadRoot
, asyncTasks: (asyncTasks /\ dispatchAsyncTasks) , tasks: (tasks /\ dispatchAsyncTasks)
, currentRoute , route
, dispatch , dispatch
, folderOpen , folderOpen
, frontends , frontends
...@@ -90,32 +91,17 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -90,32 +91,17 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
-- only 1 popup at a time is allowed to be opened -- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile) droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false isDragOver <- R.useState' false
popoverRef <- R.useRef null popoverRef <- R.useRef null
R.useEffect' $ do R.useEffect' $ do
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
let isSelected = Just route == Routes.nodeTypeAppRoute nodeType (sessionId session) id
let ordering =
case handed of
GT.LeftHanded -> reverse
GT.RightHanded -> identity
let isSelected = Just currentRoute == Routes.nodeTypeAppRoute nodeType (sessionId session) id
pure $ H.span (dropProps droppedFile isDragOver) pure $ H.span (dropProps droppedFile isDragOver)
$ ordering $ switchHanded
[ folderIcon nodeType folderOpen [ folderIcon nodeType folderOpen
, chevronIcon isLeaf handed nodeType folderOpen , chevronIcon isLeaf handed nodeType folderOpen
, nodeLink { frontends , nodeLink { frontends, handed, folderOpen, id, isSelected
, handed , name: name' props, nodeType, session } []
, folderOpen
, id
, isSelected
, name: name' props
, nodeType
, session
} []
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } , fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
...@@ -124,7 +110,7 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -124,7 +110,7 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
, onFinish: onTaskFinish id t , onFinish: onTaskFinish id t
, session , session
} }
) $ GAT.getTasks asyncTasks id ) $ GAT.getTasks tasks id
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
then GV.versionView {session} then GV.versionView {session}
...@@ -146,13 +132,11 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -146,13 +132,11 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
, session , session
, triggerRefresh: const $ dispatch RefreshTree , triggerRefresh: const $ dispatch RefreshTree
} }
] handed
]
where where
onTaskFinish id t _ = do onTaskFinish id t _ = do
dispatchAsyncTasks $ GAT.Finish id t dispatchAsyncTasks $ GAT.Finish id t
GUR.bump appReload T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
...@@ -182,17 +166,12 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -182,17 +166,12 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
} [] ] } [] ]
folderIcon nodeType (open /\ setOpen) = folderIcon nodeType (open /\ setOpen) =
H.a { className: "folder-icon" H.a { className: "folder-icon", on: { click: \_ -> setOpen $ not } }
, on: { click: \_ -> setOpen $ not } [ H.i {className: GT.fldr nodeType open} [] ]
} [ popOverIcon =
H.i {className: GT.fldr nodeType open} [] H.a { className: "settings fa fa-cog"
] , title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them." } []
popOverIcon = H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them."
} []
dropProps droppedFile isDragOver = dropProps droppedFile isDragOver =
{ className: "leaf " <> (dropClass droppedFile isDragOver) { className: "leaf " <> (dropClass droppedFile isDragOver)
, on: { drop: dropHandler droppedFile , on: { drop: dropHandler droppedFile
...@@ -240,49 +219,44 @@ fldr nt open = if open ...@@ -240,49 +219,44 @@ fldr nt open = if open
-- START nodeActions -- START nodeActions
type NodeActionsProps = type NodeActionsCommon =
( id :: ID ( id :: ID
, nodeType :: GT.NodeType , session :: Session
, session :: Session , refresh :: Unit -> Aff Unit
, triggerRefresh :: Unit -> Aff Unit
) )
type NodeActionsProps = ( nodeType :: GT.NodeType | NodeActionsCommon )
nodeActions :: Record NodeActionsProps -> R.Element nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p [] nodeActions p = R.createElement nodeActionsCpt p []
nodeActionsCpt :: R.Component NodeActionsProps nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponentWithModule thisModule "nodeActions" cpt nodeActionsCpt = here.component "nodeActions" cpt where
where cpt props _ = pure (child props.nodeType) where
cpt { id nodeActionsP = SProxy :: SProxy "nodeType"
, nodeType: GT.Graph childProps = Record.delete nodeActionsP props
, session child GT.NodeList = listNodeActions childProps
, triggerRefresh child GT.Graph = graphNodeActions childProps
} _ = do child _ = H.div {} []
useLoader id (graphVersions session) $ \gv -> graphNodeActions :: R2.Leaf NodeActionsCommon
nodeActionsGraph { id graphNodeActions props = R.createElement graphNodeActionsCpt props []
, graphVersions: gv
, session graphNodeActionsCpt :: R.Component NodeActionsCommon
, triggerRefresh graphNodeActionsCpt = here.component "graphNodeActions" cpt where
} cpt { id, session, refresh } _ =
useLoader id (graphVersions session) $ \gv ->
cpt { id nodeActionsGraph { graphVersions: gv, session, id, refresh }
, nodeType: GT.NodeList graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
, session
, triggerRefresh listNodeActions :: R2.Leaf NodeActionsCommon
} _ = do listNodeActions props = R.createElement listNodeActionsCpt props []
useLoader { nodeId: id, session } loadCorpusWithChild $
\{ corpusId } -> listNodeActionsCpt :: R.Component NodeActionsCommon
nodeActionsNodeList { listId: id listNodeActionsCpt = here.component "listNodeActions" cpt where
, nodeId: corpusId cpt { id, session, refresh } _ =
, nodeType: GT.TabNgramType GT.CTabTerms useLoader { nodeId: id, session } loadCorpusWithChild $ \{ corpusId } ->
, session nodeActionsNodeList
, triggerRefresh { listId: id, nodeId: corpusId, session, refresh: refresh
} , nodeType: GT.TabNgramType GT.CTabTerms }
cpt _ _ = do
pure $ H.div {} []
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
-- END nodeActions
module Gargantext.Components.Forest.Tree.Node.Action.Contact where module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Prelude (($)) import Formula as F
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 Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..)) import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
...@@ -18,71 +20,61 @@ import Gargantext.Types (ID) ...@@ -18,71 +20,61 @@ import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.Forest.Tree.Node.Action.Contact" here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
------------------------------------------------------------------------
contactReq :: Session -> ID -> AddContactParams -> Aff ID contactReq :: Session -> ID -> AddContactParams -> Aff ID
contactReq session nodeId = contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact" post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
------------------------------------------------------------------------
type TextInputBoxProps = type TextInputBoxProps =
( id :: ID ( id :: ID
, dispatch :: Action -> Aff Unit , dispatch :: Action -> Aff Unit
, params :: Record AddContactProps , params :: Record AddContactProps
, isOpen :: R.State Boolean , isOpen :: T.Cursor Boolean
, boxName :: String , boxName :: String
, boxAction :: AddContactParams -> Action , boxAction :: AddContactParams -> Action
) )
type AddContactProps = ( firstname :: String, lastname :: String) type AddContactProps = ( firstname :: String, lastname :: String)
textInputBox :: Record TextInputBoxProps -> R.Element textInputBox :: R2.Leaf TextInputBoxProps
textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen), params } = R.createElement el p [] textInputBox props = R.createElement textInputBoxCpt props []
where
{firstname, lastname} = params
el = R.hooksComponentWithModule thisModule (boxName <> "Box") cpt
cpt {id, params:params'} _ = do
let {firstname, lastname} = params'
stateFirstname <- R.useState' firstname
stateLastname <- R.useState' lastname
pure $ H.div {className: "from-group row"}
[ textInput stateFirstname firstname
, textInput stateLastname lastname
, submitBtn stateFirstname stateLastname
, cancelBtn
]
where
textInput (_ /\ set) default =
H.div {className: "col-md-8"}
[ H.input { className: "form-control"
, defaultValue: default
, on: { input: set
<<< const
<<< R.unsafeEventValue }
, placeholder: (boxName <> " Node")
, type: "text"
}
]
submitBtn (val1 /\ _) (val2 /\ _) =
H.a {className: "btn glyphitem fa fa-ok col-md-2 pull-left"
, type: "button"
, on: { click: \_ -> do
setIsOpen $ const false
launchAff $ dispatch ( boxAction (AddContactParams {firstname:val1, lastname:val2} ))
}
, title: "Submit"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left"
, on: { click: \_ -> setIsOpen $ const false }
, title: "Cancel"
, type: "button"
} []
textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponentWithModule thisModule (boxName <> "Box") cpt
cpt {} _ = pure $ H.div {} []
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useCell firstname <*> T.useCell lastname
where
content false _ _ = H.div {} []
content true firstName lastName =
H.div { className: "from-group row" }
[ textInput firstName
, textInput lastName
, submitBtn firstName lastName
, cancelBtn
] where
textInput value =
H.div {className: "col-md-8"}
[ F.bindInput
{ value, className: "form-control", type: "text"
, placeholder: (boxName <> " Node") } ]
submitBtn first last =
H.a
{ className: "btn glyphitem fa fa-ok col-md-2 pull-left"
, type: "button", on: { click }, title:"Submit"
} [] where
click _ = do
firstname <- T.read first
lastname <- T.read last
_ <- T.write false isOpen
launchAff $
dispatch (boxAction $ AddContactParams { firstname, lastname })
cancelBtn =
H.a
{ className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left"
, on: { click }, title: "Cancel", type: "button"
} [] where
click _ = void $ T.write false isOpen
...@@ -13,8 +13,8 @@ import Gargantext.Types as GT ...@@ -13,8 +13,8 @@ import Gargantext.Types as GT
type CommonProps = type CommonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, session :: Session , session :: Session
, handed :: GT.Handed , handed :: GT.Handed
) )
type NodePopupProps = type NodePopupProps =
......
...@@ -13,17 +13,22 @@ type Name = String ...@@ -13,17 +13,22 @@ type Name = String
type FTree = NTree LNode type FTree = NTree LNode
data NTree a = NTree a (Array (NTree a)) data NTree a = NTree a (Array (NTree a))
type Tree = { tree :: FTree type Tree = { tree :: FTree
, asyncTasks :: Array GT.AsyncTaskWithType , tasks :: Array GT.AsyncTaskWithType
} }
fTreeID :: FTree -> ID
fTreeID (NTree (LNode { id }) _) = id
instance ntreeFunctor :: Functor NTree where instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary) map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode = LNode { id :: ID newtype LNode =
, name :: Name LNode
, nodeType :: GT.NodeType { id :: ID
, parent_id :: Maybe ID , name :: Name
} , nodeType :: GT.NodeType
, parent_id :: Maybe ID
}
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
......
...@@ -23,7 +23,7 @@ type NodeActionsGraphProps = ...@@ -23,7 +23,7 @@ type NodeActionsGraphProps =
( id :: GT.ID ( id :: GT.ID
, graphVersions :: Record GraphAPI.GraphVersions , graphVersions :: Record GraphAPI.GraphVersions
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Aff Unit , refresh :: Unit -> Aff Unit
) )
nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element nodeActionsGraph :: Record NodeActionsGraphProps -> R.Element
...@@ -32,18 +32,18 @@ nodeActionsGraph p = R.createElement nodeActionsGraphCpt p [] ...@@ -32,18 +32,18 @@ nodeActionsGraph p = R.createElement nodeActionsGraphCpt p []
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = R.hooksComponentWithModule thisModule "nodeActionsGraph" cpt nodeActionsGraphCpt = R.hooksComponentWithModule thisModule "nodeActionsGraph" cpt
where where
cpt { id, graphVersions, session, triggerRefresh } _ = do cpt { id, graphVersions, session, refresh } _ = do
pure $ H.div { className: "node-actions" } [ pure $ H.div { className: "node-actions" } [
if graphVersions.gv_graph == Just graphVersions.gv_repo then if graphVersions.gv_graph == Just graphVersions.gv_repo then
H.div {} [] H.div {} []
else else
graphUpdateButton { id, session, triggerRefresh } graphUpdateButton { id, session, refresh }
] ]
type GraphUpdateButtonProps = type GraphUpdateButtonProps =
( id :: GT.ID ( id :: GT.ID
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Aff Unit , refresh :: Unit -> Aff Unit
) )
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
...@@ -52,7 +52,7 @@ graphUpdateButton p = R.createElement graphUpdateButtonCpt p [] ...@@ -52,7 +52,7 @@ graphUpdateButton p = R.createElement graphUpdateButtonCpt p []
graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps
graphUpdateButtonCpt = R.hooksComponentWithModule thisModule "graphUpdateButton" cpt graphUpdateButtonCpt = R.hooksComponentWithModule thisModule "graphUpdateButton" cpt
where where
cpt { id, session, triggerRefresh } _ = do cpt { id, session, refresh } _ = do
enabled <- R.useState' true enabled <- R.useState' true
pure $ H.div { className: "update-button " pure $ H.div { className: "update-button "
...@@ -69,7 +69,7 @@ graphUpdateButtonCpt = R.hooksComponentWithModule thisModule "graphUpdateButton" ...@@ -69,7 +69,7 @@ graphUpdateButtonCpt = R.hooksComponentWithModule thisModule "graphUpdateButton"
liftEffect $ setEnabled $ const false liftEffect $ setEnabled $ const false
g <- GraphAPI.updateGraphVersions { graphId: id, session } g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ setEnabled $ const true liftEffect $ setEnabled $ const true
triggerRefresh unit refresh unit
pure unit pure unit
-- | Sync Node (List) -- | Sync Node (List)
...@@ -79,7 +79,7 @@ type NodeActionsNodeListProps = ...@@ -79,7 +79,7 @@ type NodeActionsNodeListProps =
, nodeId :: GT.ID , nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType , nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Aff Unit , refresh :: Unit -> Aff Unit
) )
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
...@@ -98,7 +98,7 @@ type NodeListUpdateButtonProps = ...@@ -98,7 +98,7 @@ type NodeListUpdateButtonProps =
, nodeId :: GT.ID , nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType , nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session , session :: Session
, triggerRefresh :: Unit -> Aff Unit , refresh :: Unit -> Aff Unit
) )
nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element
...@@ -107,7 +107,7 @@ nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p [] ...@@ -107,7 +107,7 @@ nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p []
nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateButton" cpt nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateButton" cpt
where where
cpt { listId, nodeId, nodeType, session, triggerRefresh } _ = do cpt { listId, nodeId, nodeType, session, refresh } _ = do
enabled <- R.useState' true enabled <- R.useState' true
pure $ H.div {} [] {- { className: "update-button " pure $ H.div {} [] {- { className: "update-button "
...@@ -122,6 +122,6 @@ nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateB ...@@ -122,6 +122,6 @@ nodeListUpdateButtonCpt = R.hooksComponentWithModule thisModule "nodeListUpdateB
liftEffect $ setEnabled $ const false liftEffect $ setEnabled $ const false
_ <- NTAPI.updateNodeList { listId, nodeId, nodeType, session } _ <- NTAPI.updateNodeList { listId, nodeId, nodeType, session }
liftEffect $ setEnabled $ const true liftEffect $ setEnabled $ const true
triggerRefresh unit refresh unit
pure unit pure unit
-} -}
module Gargantext.Components.Forms where module Gargantext.Components.Forms where
import Record as Record
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2
clearfix :: {} -> R.Element clearfix :: R.Element
clearfix _ = H.div {className: "clearfix"} [] clearfix = H.div { className: "clearfix" } []
formGroup :: Array R.Element -> R.Element formGroup :: Array R.Element -> R.Element
formGroup = H.div {className: "form-group"} formGroup = H.div { className: "form-group" }
center :: Array R.Element -> R.Element center :: Array R.Element -> R.Element
center = H.div {className: "center"} center = H.div { className: "center" }
card :: Array R.Element -> R.Element card :: Array R.Element -> R.Element
card = H.div {className: "card"} card = H.div { className: "card" }
cardBlock :: Array R.Element -> R.Element cardBlock :: Array R.Element -> R.Element
cardBlock = H.div {className: "card-block"} cardBlock = H.div { className: "card-block" }
cardGroup :: Array R.Element -> R.Element cardGroup :: Array R.Element -> R.Element
cardGroup = H.div {className: "card-group"} cardGroup = H.div { className: "card-group" }
...@@ -43,9 +43,9 @@ thisModule :: String ...@@ -43,9 +43,9 @@ thisModule :: String
thisModule = "Gargantext.Components.GraphExplorer" thisModule = "Gargantext.Components.GraphExplorer"
type LayoutProps = ( type LayoutProps = (
asyncTasksRef :: R.Ref (Maybe GAT.Reductor) tasks :: R.Ref (Maybe GAT.Reductor)
, backend :: R.State (Maybe Backend) , backend :: R.State (Maybe Backend)
, currentRoute :: AppRoute , route :: AppRoute
, frontends :: Frontends , frontends :: Frontends
, graphId :: GET.GraphId , graphId :: GET.GraphId
, handed :: Types.Handed , handed :: Types.Handed
...@@ -93,9 +93,9 @@ explorer props = R.createElement explorerCpt props [] ...@@ -93,9 +93,9 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
where where
cpt props@{ asyncTasksRef cpt props@{ tasks
, backend , backend
, currentRoute , route
, frontends , frontends
, graph , graph
, graphId , graphId
...@@ -117,14 +117,14 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -117,14 +117,14 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (GUR.value graphVersion) graphVersionRef <- R.useRef (GUR.value graphVersion)
treeReload <- GUR.new reloadForest <- GUR.new
treeReloadRef <- GUR.newIInitialized treeReload reloadForest <- GUR.newIInitialized reloadForest
controls <- Controls.useGraphControls { forceAtlasS controls <- Controls.useGraphControls { forceAtlasS
, graph , graph
, graphId , graphId
, hyperdataGraph , hyperdataGraph
, session , session
, treeReload: \_ -> GUR.bump treeReload , reloadForest: \_ -> GUR.bump reloadForest
} }
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
...@@ -161,16 +161,16 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -161,16 +161,16 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
inner handed [ inner handed [
rowControls [ Controls.controls controls ] rowControls [ Controls.controls controls ]
, RH.div { className: "row graph-row" } $ mainLayout handed $ , RH.div { className: "row graph-row" } $ mainLayout handed $
tree { asyncTasksRef tree { tasks
, backend , backend
, currentRoute , route
, frontends , frontends
, handed , handed
, reload: treeReload , reload: reloadForest
, sessions , sessions
, show: fst controls.showTree , show: fst controls.showTree
, showLogin: snd showLogin , showLogin: snd showLogin
, treeReloadRef , reloadForest
} }
/\ /\
RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } [] RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
...@@ -192,7 +192,7 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -192,7 +192,7 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
, session , session
, selectedNodeIds: controls.selectedNodeIds , selectedNodeIds: controls.selectedNodeIds
, showSidePanel : controls.showSidePanel , showSidePanel : controls.showSidePanel
, treeReload , reloadForest
} }
] ]
] ]
...@@ -220,17 +220,17 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -220,17 +220,17 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
tree :: Record TreeProps -> R.Element tree :: Record TreeProps -> R.Element
tree { show: false } = RH.div { id: "tree" } [] tree { show: false } = RH.div { id: "tree" } []
tree { asyncTasksRef, backend, frontends, handed, currentRoute, reload, sessions, showLogin, treeReloadRef } = tree { tasks, backend, frontends, handed, route, reload, sessions, showLogin, reloadForest } =
RH.div {className: "col-md-2 graph-tree"} [ RH.div {className: "col-md-2 graph-tree"} [
forest { appReload: reload forest { reloadRoot: reload
, asyncTasksRef , tasks
, backend , backend
, currentRoute , route
, frontends , frontends
, handed , handed
, sessions , sessions
, showLogin , showLogin
, treeReloadRef } [] , reloadForest } []
] ]
mSidebar :: Maybe GET.MetaData mSidebar :: Maybe GET.MetaData
...@@ -241,17 +241,16 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -241,17 +241,16 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
Sidebar.sidebar (Record.merge props { metaData }) Sidebar.sidebar (Record.merge props { metaData })
type TreeProps = type TreeProps =
( ( tasks :: R.Ref (Maybe GAT.Reductor)
asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, backend :: R.State (Maybe Backend) , backend :: R.State (Maybe Backend)
, currentRoute :: AppRoute , route :: AppRoute
, frontends :: Frontends , frontends :: Frontends
, handed :: Types.Handed , handed :: Types.Handed
, reload :: GUR.ReloadS , reload :: GUR.ReloadS
, sessions :: Sessions , sessions :: Sessions
, show :: Boolean , show :: Boolean
, showLogin :: R.Setter Boolean , showLogin :: R.Setter Boolean
, treeReloadRef :: GUR.ReloadWithInitializeRef , reloadForest :: GUR.ReloadWithInitializeRef
) )
type MSidebarProps = type MSidebarProps =
...@@ -263,7 +262,7 @@ type MSidebarProps = ...@@ -263,7 +262,7 @@ type MSidebarProps =
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session , session :: Session
, treeReload :: GUR.ReloadS , reloadForest :: GUR.ReloadS
) )
type GraphProps = ( type GraphProps = (
......
...@@ -62,7 +62,7 @@ type CameraButtonProps = ( ...@@ -62,7 +62,7 @@ type CameraButtonProps = (
, hyperdataGraph :: GET.HyperdataGraph , hyperdataGraph :: GET.HyperdataGraph
, session :: Session , session :: Session
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, treeReload :: Unit -> Effect Unit , reloadForest :: Unit -> Effect Unit
) )
...@@ -71,7 +71,7 @@ cameraButton { id ...@@ -71,7 +71,7 @@ cameraButton { id
, hyperdataGraph: GET.HyperdataGraph { graph: GET.GraphData hyperdataGraph } , hyperdataGraph: GET.HyperdataGraph { graph: GET.GraphData hyperdataGraph }
, session , session
, sigmaRef , sigmaRef
, treeReload } = simpleButton { , reloadForest } = simpleButton {
onClick: \_ -> do onClick: \_ -> do
let sigma = R.readRef sigmaRef let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do
...@@ -103,7 +103,7 @@ cameraButton { id ...@@ -103,7 +103,7 @@ cameraButton { id
launchAff_ $ do launchAff_ $ do
clonedGraphId <- cloneGraph { id, hyperdataGraph, session } clonedGraphId <- cloneGraph { id, hyperdataGraph, session }
ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
liftEffect $ treeReload unit liftEffect $ reloadForest unit
pure ret pure ret
, text: "Screenshot" , text: "Screenshot"
} }
...@@ -54,7 +54,7 @@ type Controls = ...@@ -54,7 +54,7 @@ type Controls =
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, showTree :: R.State Boolean , showTree :: R.State Boolean
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, treeReload :: Unit -> Effect Unit , reloadForest :: Unit -> Effect Unit
) )
type LocalControls = type LocalControls =
...@@ -168,7 +168,7 @@ controlsCpt = R.hooksComponentWithModule thisModule "controls" cpt ...@@ -168,7 +168,7 @@ controlsCpt = R.hooksComponentWithModule thisModule "controls" cpt
, hyperdataGraph: props.hyperdataGraph , hyperdataGraph: props.hyperdataGraph
, session: props.session , session: props.session
, sigmaRef: props.sigmaRef , sigmaRef: props.sigmaRef
, treeReload: props.treeReload } ] , reloadForest: props.reloadForest } ]
] ]
] ]
-- RH.ul {} [ -- change type button (?) -- RH.ul {} [ -- change type button (?)
...@@ -196,7 +196,7 @@ controlsCpt = R.hooksComponentWithModule thisModule "controls" cpt ...@@ -196,7 +196,7 @@ controlsCpt = R.hooksComponentWithModule thisModule "controls" cpt
-- , hyperdataGraph: props.hyperdataGraph -- , hyperdataGraph: props.hyperdataGraph
-- , session: props.session -- , session: props.session
-- , sigmaRef: props.sigmaRef -- , sigmaRef: props.sigmaRef
-- , treeReload: props.treeReload } ] -- , reloadForest: props.reloadForest } ]
-- ] -- ]
-- ] -- ]
...@@ -205,14 +205,14 @@ useGraphControls :: { forceAtlasS :: SigmaxT.ForceAtlasState ...@@ -205,14 +205,14 @@ useGraphControls :: { forceAtlasS :: SigmaxT.ForceAtlasState
, graphId :: GET.GraphId , graphId :: GET.GraphId
, hyperdataGraph :: GET.HyperdataGraph , hyperdataGraph :: GET.HyperdataGraph
, session :: Session , session :: Session
, treeReload :: Unit -> Effect Unit } , reloadForest :: Unit -> Effect Unit }
-> R.Hooks (Record Controls) -> R.Hooks (Record Controls)
useGraphControls { forceAtlasS useGraphControls { forceAtlasS
, graph , graph
, graphId , graphId
, hyperdataGraph , hyperdataGraph
, session , session
, treeReload } = do , reloadForest } = do
edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 } edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- R.useState' $ Range.Closed { edgeWeight <- R.useState' $ Range.Closed {
min: 0.0 min: 0.0
...@@ -250,7 +250,7 @@ useGraphControls { forceAtlasS ...@@ -250,7 +250,7 @@ useGraphControls { forceAtlasS
, showSidePanel , showSidePanel
, showTree , showTree
, sigmaRef , sigmaRef
, treeReload , reloadForest
} }
getShowControls :: Record Controls -> Boolean getShowControls :: Record Controls -> Boolean
......
...@@ -49,7 +49,7 @@ type Props = ...@@ -49,7 +49,7 @@ type Props =
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session , session :: Session
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, treeReload :: GUR.ReloadS , reloadForest :: GUR.ReloadS
) )
sidebar :: Record Props -> R.Element sidebar :: Record Props -> R.Element
...@@ -185,7 +185,7 @@ onClickRemove rType props' nodesMap' e = do ...@@ -185,7 +185,7 @@ onClickRemove rType props' nodesMap' e = do
, nodes , nodes
, session: props'.session , session: props'.session
, termList: rType , termList: rType
, treeReload: props'.treeReload } , reloadForest: props'.reloadForest }
snd props'.removedNodeIds $ const $ fst props'.selectedNodeIds snd props'.removedNodeIds $ const $ fst props'.selectedNodeIds
snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds
...@@ -215,18 +215,18 @@ type DeleteNodes = ...@@ -215,18 +215,18 @@ type DeleteNodes =
, nodes :: Array (Record SigmaxT.Node) , nodes :: Array (Record SigmaxT.Node)
, session :: Session , session :: Session
, termList :: TermList , termList :: TermList
, treeReload :: GUR.ReloadS , reloadForest :: GUR.ReloadS
) )
deleteNodes :: Record DeleteNodes -> Effect Unit deleteNodes :: Record DeleteNodes -> Effect Unit
deleteNodes { graphId, metaData, nodes, session, termList, treeReload } = do deleteNodes { graphId, metaData, nodes, session, termList, reloadForest } = do
launchAff_ do launchAff_ do
patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches) patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches let mPatch = last patches
case mPatch of case mPatch of
Nothing -> pure unit Nothing -> pure unit
Just (NTC.Versioned patch) -> do Just (NTC.Versioned patch) -> do
liftEffect $ GUR.bump treeReload liftEffect $ GUR.bump reloadForest
-- Why is this called delete node? -- Why is this called delete node?
deleteNode :: TermList deleteNode :: TermList
......
This diff is collapsed.
module Gargantext.Components.Login.Form where
import Prelude (Unit, bind, discard, notEq, pure, show, ($), (&&), (*>), (<>))
import Data.Either (Either(..))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Formula as F
import Reactix as R
import Reactix.SyntheticEvent as E
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Components.Forms (clearfix, formGroup)
import Gargantext.Ends (Backend)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Sessions, postAuthRequest)
import Gargantext.Utils (csrfMiddlewareToken)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Login.Form"
type Form =
{ error :: String
, username :: String
, password :: String
, agreed :: Boolean
}
emptyForm :: Form
emptyForm = { error: "", username: "", password: "", agreed: false }
type Cursors =
{ error :: T.Cursor String
, username :: T.Cursor String
, password :: T.Cursor String
, agreed :: T.Cursor Boolean }
formCursors :: T.Cell Form -> R.Hooks Cursors
formCursors cell = T.useFieldCursors cell {}
type Props s v =
( backend :: Backend
, sessions :: s
, visible :: v
)
form :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
=> Record (Props s v) -> R.Element
form props = R.createElement formCpt props []
formCpt :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
=> R.Component (Props s v)
formCpt = here.component "form" cpt where
cpt props@{ backend, sessions, visible } _ = do
cell <- T.useCell emptyForm
cursors <- T.useFieldCursors cell {}
pure $ R2.row
[ H.form { className: "col-md-12" }
[ formLoginLink backend
, requestAccessLink
, csrfTokenInput
, formGroup
[ H.p {} [ F.viewText { text: cursors.error } ]
, usernameInput cursors.username ]
, formGroup
[ passwordInput cursors.password
, clearfix ]
, termsCheckbox cursors.agreed
, submitButton { backend, sessions, visible, cell }
]]
-- might be wrong, all we care about is preventDefault
type ChangeEvent = R.SyntheticEvent DE.MouseEvent
formLoginLink :: Backend -> R.Element
formLoginLink backend =
H.h4 { className: "text-center" } {-className: "text-muted"-}
[ H.text $ "Login to garg://" <> show backend ]
type SubmitButtonProps s v = ( cell :: T.Cell Form | Props s v )
submitButton
:: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> R2.Leaf (SubmitButtonProps s v)
submitButton props = R.createElement submitButtonCpt props []
submitButtonCpt
:: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> R.Component (SubmitButtonProps s v)
submitButtonCpt = here.component "submitButton" cpt where
cpt { backend, sessions, visible, cell } _ = do
{ agreed, username, password } <- T.useLive T.unequal cell
pure $
if agreed && (username `notEq` "") && (password `notEq` "")
then H.div { className: "text-center" }
[ loginSubmit $ submitForm { backend, sessions, visible } cell ]
else H.div {} []
-- Attempts to submit the form
submitForm :: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> Record (Props s v) -> T.Cell Form -> ChangeEvent -> Effect Unit
submitForm { backend, sessions, visible } cell e = do
E.preventDefault e
state <- T.read cell
launchAff_ $ do
res <- postAuthRequest backend (req state)
case res of
Left message -> liftEffect $ T.write (state { error = message }) cell
Right sess ->
liftEffect $
Sessions.change (Sessions.Login sess) sessions
*> T.write false visible
*> T.write (state { error = "" }) cell
where
req { username, password } = AuthRequest { username, password }
csrfTokenInput :: R.Element -- TODO hard-coded CSRF token
csrfTokenInput = H.input { type: "hidden", name, value } where
name = "csrfmiddlewaretoken"
value = csrfMiddlewareToken
termsCheckbox :: forall cell. T.ReadWrite cell Boolean => cell -> R.Element
termsCheckbox checked =
H.div { className: "form-group form-check text-center" }
[ F.bindCheckbox { checked, className: "form-check-input" }
, H.label { className: "form-check-label" }
[ H.text "I hereby accept the "
, H.a { target: "_blank", href: termsUrl }
[ H.text "terms of use" ] ]]
where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
requestAccessLink :: R.Element
requestAccessLink =
H.div { className: "text-center" }
[ H.a { href, target: "_blank" } [ H.text "request access" ] ]
where href = "https://iscpif.fr/apply-for-a-services-account/"
usernameInput :: forall cell. T.ReadWrite cell String => cell -> R.Element
usernameInput value =
F.bindInput
{ value
, type: "text", className: "form-control"
, id: "id_username", placeholder: "username"
, name: "username", maxLength: "254"
}
passwordInput :: forall cell. T.ReadWrite cell String => cell -> R.Element
passwordInput value =
F.bindInput
{ value
, type: "password", className: "form-control"
, name: "password", placeholder: "password"
, id: "id_password"
}
loginSubmit :: (ChangeEvent -> Effect Unit) -> R.Element
loginSubmit click =
H.button { id, className, type: "submit", on: { click } }
[ H.text "Login" ] where
id = "login-button"
className = "btn btn-primary btn-rounded"
module Gargantext.Components.Login.Modal (Props, modal) where
import Prelude (bind, (<*), (>>=), (<$>))
import Data.Semigroup ((<>))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Reactix as R2
type Props v = ( visible :: v )
here :: R2.Here
here = R2.here "Gargantext.Components.Login.Modal"
modal :: forall v. T.ReadWrite v Boolean
=> Record (Props v) -> R.Element -> R.Element
modal props child = R.createElement modalCpt props [ child ]
modalCpt :: forall v. T.ReadWrite v Boolean => R.Component (Props v)
modalCpt = here.component "modal" cpt where
cpt { visible } children = do
v <- T.useLive T.unequal visible
R.createPortal
[ H.div
{ id: "loginModal", className: modalClass v, key: 0
, role: "dialog", data: { show: true }, style: { display: "block"} }
[ H.div { className: "modal-dialog modal-lg", role: "document"}
[ H.div { className: "modal-content" }
[ H.div { className: "modal-header" }
[ H.div { className: "col-md-10 col-md-push-1" }
[ H.h2 { className: "text-primary center m-a-2" }
-- H.i {className: "material-icons md-36"}
-- [ H.text "control_point" ]
[ H.span {className: "icon-text"} [ H.text "GarganText" ]]]
, H.button -- TODO , font-size : "50px"
{ type: "button", className: "close"
, data: { dismiss: "modal" }}
[ H.a { on: { click }, className: "btn fa fa-times" } [] ]]
, H.div { className: "modal-body" } children ]]]]
<$> R2.getPortalHost
where
click _ = here.log "click!" <* T.write false visible
modalClass s = "modal myModal" <> if s then "" else " fade"
...@@ -2,7 +2,9 @@ module Gargantext.Components.Login.Types where ...@@ -2,7 +2,9 @@ module Gargantext.Components.Login.Types where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (.:!), (:=), (~>)) import Data.Argonaut
( class DecodeJson, class EncodeJson
, decodeJson, jsonEmptyObject, (.:), (.:!), (:=), (~>) )
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Lens (Iso', iso) import Data.Lens (Iso', iso)
...@@ -24,8 +26,7 @@ newtype AuthResponse = AuthResponse ...@@ -24,8 +26,7 @@ newtype AuthResponse = AuthResponse
, inval :: Maybe AuthInvalid , inval :: Maybe AuthInvalid
} }
newtype AuthInvalid = AuthInvalid newtype AuthInvalid = AuthInvalid { message :: String }
{ message :: String }
newtype AuthData = AuthData newtype AuthData = AuthData
{ token :: Token { token :: Token
...@@ -60,7 +61,7 @@ instance decodeAuthData :: DecodeJson AuthData where ...@@ -60,7 +61,7 @@ instance decodeAuthData :: DecodeJson AuthData where
obj <- decodeJson json obj <- decodeJson json
token <- obj .: "token" token <- obj .: "token"
tree_id <- obj .: "tree_id" tree_id <- obj .: "tree_id"
pure $ AuthData {token, tree_id} pure $ AuthData { token, tree_id }
instance encodeAuthRequest :: EncodeJson AuthRequest where instance encodeAuthRequest :: EncodeJson AuthRequest where
encodeJson (AuthRequest {username, password}) = encodeJson (AuthRequest {username, password}) =
......
This diff is collapsed.
...@@ -78,8 +78,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -78,8 +78,7 @@ module Gargantext.Components.NgramsTable.Core
) )
where where
import Prelude import Gargantext.Prelude
import Control.Monad.State (class MonadState, execState) import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (.:?), (:=), (:=?), (~>), (~>?)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (.:?), (:=), (:=?), (~>), (~>?))
import Data.Argonaut.Decode.Error (JsonDecodeError(..)) import Data.Argonaut.Decode.Error (JsonDecodeError(..))
...@@ -94,7 +93,7 @@ import Data.Generic.Rep (class Generic) ...@@ -94,7 +93,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare) import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?), (^.)) import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
import Data.Lens.At (class At, at) import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just) import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded, traverseOf_) import Data.Lens.Fold (folded, traverseOf_)
...@@ -131,19 +130,20 @@ import Reactix as R ...@@ -131,19 +130,20 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T import Gargantext.Components.Table.Types as T
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put) import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..)) import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reload as GUR import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
thisModule :: String
thisModule = "Gargantext.Components.NgramsTable.Core" here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core"
type Endo a = a -> a type Endo a = a -> a
...@@ -809,7 +809,7 @@ applyPatchMap applyPatchValue (PatchMap pm) m = mergeMap f pm m ...@@ -809,7 +809,7 @@ applyPatchMap applyPatchValue (PatchMap pm) m = mergeMap f pm m
applyPatchMap applyPatchValue (PatchMap pm) m = applyPatchMap applyPatchValue (PatchMap pm) m =
foldl go m (Map.toUnfoldable pm :: List (Tuple k p)) foldl go m (Map.toUnfoldable pm :: List (Tuple k p))
where where
go m (Tuple k pv) = Map.alter (applyPatchValue pv) k m go m' (Tuple k pv) = Map.alter (applyPatchValue pv) k m'
type VersionedNgramsPatches = Versioned NgramsPatches type VersionedNgramsPatches = Versioned NgramsPatches
...@@ -1131,7 +1131,7 @@ syncResetButtons :: Record SyncResetButtonsProps -> R.Element ...@@ -1131,7 +1131,7 @@ syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p [] syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" cpt syncResetButtonsCpt = here.component "syncResetButtons" cpt
where where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ setSynchronizing) <- R.useState' false synchronizing@(s /\ setSynchronizing) <- R.useState' false
...@@ -1179,18 +1179,17 @@ chartsAfterSync :: forall props discard. ...@@ -1179,18 +1179,17 @@ chartsAfterSync :: forall props discard.
} }
-> R.Ref (Maybe GAT.Reductor) -> R.Ref (Maybe GAT.Reductor)
-> Int -> Int
-> GUR.ReloadWithInitializeRef -> T.Cursor (T2.InitReload T.Cursor)
-> discard -> discard
-> Aff Unit -> Aff Unit
chartsAfterSync path' asyncTasksRef nodeId treeReloadRef _ = do chartsAfterSync path' tasks nodeId reloadForest _ = do
task <- postNgramsChartsAsync path' task <- postNgramsChartsAsync path'
liftEffect $ do liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
case R.readRef asyncTasksRef of case R.readRef tasks of
Nothing -> log "[chartsAfterSync] asyncTasksRef is Nothing" Nothing -> log "[chartsAfterSync] tasks is Nothing"
Just asyncTasks -> do Just tasks' ->
snd asyncTasks $ GAT.Insert nodeId task snd tasks' (GAT.Insert nodeId task) *> T2.reload reloadForest
GUR.bumpI treeReloadRef
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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