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