Commit 4fcaf6ac authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski Committed by Karen Konou

[NgramsTable] edit works now but with bugs

parent 56bc0149
This diff is collapsed.
module Gargantext.Components.NgramsTable.Components where
import Data.Either (Either(..))
import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (List)
import Data.List (null, toUnfoldable) as L
import Data.List as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
......@@ -16,6 +17,8 @@ import Effect.Class (liftEffect)
import FFI.Simple (delay)
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, setTermListA)
import Gargantext.Components.Table as Tbl
import Gargantext.Config.REST (logRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, not, otherwise, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
......@@ -23,7 +26,9 @@ import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Type.Proxy (Proxy(..))
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Components"
......@@ -121,7 +126,7 @@ selectionCheckboxCpt = here.component "selectionCheckbox" cpt
type RenderNgramsTree =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsChildren :: List NgramsTerm
--, ngramsChildren :: List NgramsTerm
, ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick
......@@ -134,12 +139,12 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
where
cpt { getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ =
cpt { getNgramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ =
pure $ H.ul {}
[ H.span { className: "tree" }
[ H.span { className: "righthanded" }
[ tree { getNgramsChildren
, ngramsChildren
--, ngramsChildren
, ngramsClick
, ngramsDepth
, ngramsEdit
......@@ -168,7 +173,6 @@ tag tagProps =
type TreeProps =
( getNgramsChildren :: NgramsTerm -> Aff (Array NgramsTerm)
, ngramsChildren :: List NgramsTerm
, ngramsEdit :: NgramsClick
--, ngramsTable :: NgramsTable
| TagProps
......@@ -177,47 +181,60 @@ type TreeProps =
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt
where
cpt params@{ getNgramsChildren, ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
R.useEffect' $ do
launchAff_ $ do
c <- getNgramsChildren ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] ngrams" ngramsDepth.ngrams
liftEffect $ here.log2 "[tree] children" c
pure $
H.li { style: { width : "100%" } }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest ngramsChildren ]
)
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "fa fa-pencil"
, on: { click: const effect } } []
]
leaf = L.null ngramsChildren
className = "fa fa-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
--cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
let depth = ngramsDepth.depth + 1 in
if depth > 10 then
const $ H.text "ERROR DEPTH > 10"
else
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
treeCpt = here.component "tree" cpt where
cpt props@{ getNgramsChildren, ngramsDepth } _ = do
let loader p = do
res <- getNgramsChildren p
pure $ Right res
let render nc = treeLoaded (Record.merge props { ngramsChildren: L.fromFoldable nc })
useLoader { errorHandler
, loader
, path: ngramsDepth.ngrams
, render }
where
errorHandler = logRESTError here "[tree]"
type TreeLoaded =
( ngramsChildren :: List NgramsTerm
| TreeProps )
treeLoaded :: Record TreeLoaded -> R.Element
treeLoaded p = R.createElement treeLoadedCpt p []
treeLoadedCpt :: R.Component TreeLoaded
treeLoadedCpt = here.component "treeLoaded" cpt where
cpt params@{ ngramsChildren, ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle } _ = do
pure $
H.li { style: { width : "100%" } }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest ngramsChildren ]
)
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "fa fa-pencil"
, on: { click: const effect } } []
]
leaf = L.null ngramsChildren
className = "fa fa-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
--cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
let depth = ngramsDepth.depth + 1 in
if depth > 10 then
const $ H.text "ERROR DEPTH > 10"
else
H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem =
( dispatch :: Action -> Effect Unit
......@@ -254,21 +271,20 @@ renderNgramsItemCpt = here.component "renderNgramsItem" cpt
, checkbox GT.StopTerm
, H.div {}
( if ngramsParent == Nothing
then [renderNgramsTree { getNgramsChildren
, ngramsChildren
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsStyle }]
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
[ H.i { className: "fa fa-plus" } []]
then [ renderNgramsTree { getNgramsChildren
, ngramsClick
, ngramsDepth
, ngramsEdit
, ngramsStyle } ]
else [ H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
[ H.i { className: "fa fa-plus" } [] ]
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
]
)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
ngramsDepth= { ngrams, depth: 0 }
ngramsDepth = { ngrams, depth: 0 }
tag =
case ngramsClick ngramsDepth of
Just effect ->
......
......@@ -151,16 +151,15 @@ pageLayoutCpt = here.component "pageLayout" cpt
errorHandler = logRESTError here "[pageLayout]"
type PageProps =
( session :: Session
, frontends :: Frontends
( frontends :: Frontends
, pagePath :: T.Box PagePath
-- , info :: AnnuaireInfo
, session :: Session
, table :: TableResult CT.NodeContact
)
page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = here.component "page" cpt
where
......
......@@ -100,13 +100,13 @@ ngramsViewCpt = here.component "ngramsView" cpt where
R.fragment
[
ngramsView'
{ mode
, boxes
, session
, params
{ boxes
, corpusData: props.corpusData
, listIds
, mode
, nodeId
, corpusData: props.corpusData
, params
, session
} []
,
NT.mainNgramsTable
......@@ -119,7 +119,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, tabNgramType
, tabType
, treeEdit: { box: treeEditBox
, getNgramsChildren: \_ -> pure []
, getNgramsChildren: NT.getNgramsChildrenAff session nodeId listIds tabType
, onCancelRef
, onNgramsClickRef
, onSaveRef }
......@@ -148,26 +148,28 @@ ngramsViewCpt = here.component "ngramsView" cpt where
-- @XXX re-render issue -> clone component
type NgramsViewProps' =
( mode :: Mode
, boxes :: Boxes
, session :: Session
( boxes :: Boxes
, corpusData :: CorpusData
, listIds :: Array Int
, params :: Params
, mode :: Mode
, nodeId :: Int
, corpusData :: CorpusData
, params :: Params
, session :: Session
)
ngramsView' :: R2.Component NgramsViewProps'
ngramsView' = R.createElement ngramsViewCpt'
ngramsViewCpt' :: R.Memo NgramsViewProps'
ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
cpt { mode
, boxes
, session
--ngramsViewCpt' :: R.Memo NgramsViewProps'
--ngramsViewCpt' = R.memo' $ here.component "ngramsView_clone" cpt where
ngramsViewCpt' :: R.Component NgramsViewProps'
ngramsViewCpt' = here.component "ngramsView_clone" cpt where
cpt { boxes
, corpusData: { defaultListId }
, listIds
, params
, mode
, nodeId
, corpusData: { defaultListId }
, params
, session
} _ = do
let path' = {
......
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