Commit 72dc4241 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-ngrams-refactoring' of...

Merge branch 'dev-ngrams-refactoring' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-ngrams-refactoring
parents 986d0faf 78a2d87c
......@@ -7,7 +7,6 @@ import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
......
......@@ -390,9 +390,13 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
cpt { layout: {frontends, session, nodeId, corpusId, listId, totalRecords}, documents, params } _ = do
localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table
{ rows: rows localCategories
{ colNames
, container: T.defaultContainer { title: "Documents" }
, params, colNames, totalRecords, wrapColElts }
, params
, rows: rows localCategories
, totalRecords
, wrapColElts
}
where
sid = sessionId session
gi Favorite = "glyphicon glyphicon-star"
......@@ -409,7 +413,7 @@ pageCpt = R.memo' $ R.hooksComponent "G.C.DocsTable.pageCpt" cpt where
where
row (DocumentsView r) =
{ row:
[ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
T.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
caroussel session nodeId setLocalCategories r cat
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
......
......@@ -335,7 +335,8 @@ pageCpt = R.hooksComponent "G.C.FacetsTable.Page" cpt
rows = row <$> filter (not <<< isDeleted) documents
row dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row:
[ H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
T.makeRow [
H.div {} [ H.a { className: gi category, on: {click: markClick} } [] ]
-- TODO show date: Year-Month-Day only
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id} [ H.text title ] ]
......
......@@ -32,10 +32,10 @@ import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), otherwise, when)
import React (ReactClass, ReactElement, Children)
import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props (_type, checked, className, onChange, onClick, style, readOnly)
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, otherwise, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<), (==), (||))
import React (ReactClass, Children)
import React.DOM (a, span, text)
import React.DOM.Props (onClick, style)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -91,6 +91,7 @@ data Action
| ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll
| ResetPatches
setTermListA :: NgramsTerm -> Replace TermList -> Action
setTermListA n patch_list =
......@@ -117,27 +118,34 @@ addNewNgramA ngram = CommitPatch $ addNewNgram ngram CandidateTerm
type Dispatch = Action -> Effect Unit
tableContainer :: { path :: R.State PageParams
, dispatch :: Dispatch
, ngramsParent :: Maybe NgramsTerm
type TableContainerProps =
( dispatch :: Dispatch
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsParent :: Maybe NgramsTerm
, ngramsSelectAll :: Boolean
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
, path :: R.State PageParams
, tabNgramType :: CTabNgramType
, ngramsSelectAll :: Boolean
}
-> Record T.TableContainerProps -> R.Element
tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, dispatch
, ngramsParent
)
tableContainer :: Record TableContainerProps -> Record T.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component T.TableContainerProps
tableContainerCpt { dispatch
, ngramsChildren
, ngramsParent
, ngramsSelectAll
, ngramsSelection
, ngramsTable: ngramsTableCache
, path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, tabNgramType
, ngramsSelectAll
} props =
H.div {className: "container-fluid"}
[ H.div {className: "jumbotron1"}
} = R.hooksComponent "G.C.NT.tableContainer" cpt
where
cpt props _ = do
pure $ H.div {className: "container-fluid"} [
H.div {className: "jumbotron1"}
[ R2.row
[ H.div {className: "panel panel-default"}
[ H.div {className: "panel-heading"}
......@@ -151,7 +159,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, name: "search"
, placeholder: "Search"
, type: "value"
, value: searchQuery
, defaultValue: searchQuery
, on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} (
if A.null props.tableBody && searchQuery /= "" then [
......@@ -162,19 +170,21 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
}
}
[ H.text ("Add " <> searchQuery) ]
] else [])]
] else []
)
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: " list-group-item"}
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, value: (maybe "" show termListFilter)
, defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, value: (maybe "" show termSizeFilter)
, defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
......@@ -183,7 +193,8 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, props.pageSizeControl
, H.text " items / "
, props.paginationLinks]]
]]
]
]
, H.div {}
(maybe [] (\ngrams ->
let
......@@ -199,7 +210,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
ngramsEdit _ = Nothing
in
[ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, R2.buff $ renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
, H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
]) ngramsParent)
......@@ -214,7 +225,6 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
]
]
]
where
-- WHY setPath f = origSetPageParams (const $ f path)
setSearchQuery x = setPath $ _ { searchQuery = x }
setTermListFilter x = setPath $ _ { termListFilter = x }
......@@ -271,9 +281,10 @@ loadedNgramsTableCpt = R.hooksComponent "G.C.NgramsTable.loadedNgramsTable" cpt
performNgramsAction Synchronize' = pure -- TODO
type LoadedNgramsTableProps =
( tabNgramType :: CTabNgramType
, path :: R.State PageParams
( path :: R.State PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
loadedNgramsTableSpec :: Thermite.Spec State (Record LoadedNgramsTableProps) Action
......@@ -304,7 +315,8 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
syncPatches path state
performAction (CommitPatch pt) _ {ngramsVersion} =
commitPatch (Versioned {version: ngramsVersion, data: pt})
performAction ResetPatches _ {ngramsVersion} =
modifyState_ $ \s -> s { ngramsLocalPatch = { ngramsNewElems: mempty, ngramsPatches: mempty } }
performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless
pure unit
......@@ -323,12 +335,14 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
render :: Thermite.Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: path@({searchQuery, scoreType, params, termListFilter} /\ setPath)
, versioned: Versioned { data: initTable }
, tabNgramType }
, tabNgramType
, withAutoUpdate }
state@{ ngramsParent, ngramsChildren, ngramsLocalPatch
, ngramsSelection, ngramsSelectAll }
_reactChildren =
[ autoUpdateElt { duration: 5000, effect: dispatch Synchronize }
, R2.scuff $ T.table { colNames
R2.scuff <$> (
autoUpdate <> resetSaveButtons <> [
T.table { colNames
, container
, params: params /\ setParams -- TODO-LENS
, rows: filteredRows
......@@ -336,30 +350,52 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
, wrapColElts
}
]
)
where
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then [ R2.buff $ autoUpdateElt { duration: 5000, effect: dispatch Synchronize } ] else []
resetButton :: R.Element
resetButton = H.button { className: "btn btn-primary"
, on: { click: \_ -> dispatch ResetPatches } } [ H.text "Reset" ]
saveButton :: R.Element
saveButton = H.button { className: "btn btn-primary"
, on: { click: \_ -> dispatch Synchronize }} [ H.text "Save" ]
resetSaveButtons :: Array R.Element
resetSaveButtons = if ngramsLocalPatch == mempty then [] else
[ H.div {} [ resetButton, saveButton ] ]
totalRecords = A.length rows
filteredRows = T.filterRows { params } rows
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
selected =
input
[ _type "checkbox"
, className "checkbox"
, checked ngramsSelectAll
, onChange $ const $ dispatch $ ToggleSelectAll
]
H.input { checked: ngramsSelectAll
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelectAll }
, type: "checkbox" }
-- This is used to *decorate* the Select header with the checkbox.
wrapColElts (T.ColumnName "Select") = const [R2.buff selected]
wrapColElts (T.ColumnName "Select") = const [selected]
wrapColElts (T.ColumnName "Score") = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _ = identity
container = tableContainer {path, dispatch, ngramsParent, ngramsChildren, ngramsSelection, ngramsTable, tabNgramType, ngramsSelectAll}
container = tableContainer { dispatch
, ngramsChildren
, ngramsParent
, ngramsSelectAll
, ngramsSelection
, ngramsTable
, path
, tabNgramType
}
setParams f = setPath $ \p@{params: ps} -> p {params = f ps}
ngramsTable = applyNgramsPatches state initTable
orderWith =
case convOrderBy <$> params.orderBy of
Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
Just TermAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _ngrams
Just TermDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _ngrams
_ -> identity -- the server ordering is enough here
rows :: T.Rows
rows = convertRow <$> orderWith (addOcc <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable)))
addOcc (Tuple ne ngramsElement) =
let Additive occurrences = sumOccurrences ngramsTable ngramsElement in
......@@ -392,10 +428,13 @@ loadedNgramsTableSpec = Thermite.simpleSpec performAction render
|| tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ unless they are being processed at the moment.
convertRow (Tuple ngrams ngramsElement) =
{ row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams,
ngramsLocalPatch,
ngramsParent, ngramsElement,
ngramsSelection, dispatch }
{ row: renderNgramsItem { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable }
, delete: false
}
......@@ -413,57 +452,91 @@ type MainNgramsTableProps =
, tabType :: TabType
, session :: Session
, tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean
)
mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTable props = R.createElement mainNgramsTableCpt props []
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
mainNgramsTableCpt = R.hooksComponent "G.C.NT.mainNgramsTable" cpt
where
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned}
cpt {nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate} _ = do
let path = initialPageParams session nodeId [defaultListId] tabType
pure $ loader path loadNgramsTableAll \loaded -> do
case Map.lookup tabType loaded of
Just (versioned :: VersionedNgramsTable) -> paint versioned
Just (versioned :: VersionedNgramsTable) -> mainNgramsTablePaint {path, tabNgramType, versioned, withAutoUpdate}
Nothing -> loadingSpinner {}
type MainNgramsTablePaintProps =
(
path :: PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
mainNgramsTablePaint :: Record MainNgramsTablePaintProps -> R.Element
mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponent "G.C.NT.mainNgramsTablePaint" cpt
where
cpt {path, tabNgramType, versioned, withAutoUpdate} _ = do
pathS <- R.useState' path
pure $ loadedNgramsTable' {
path: pathS
, tabNgramType
, versioned
, withAutoUpdate
}
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
tree :: { ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
type TreeProps =
(
ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick
, ngramsClick :: NgramsClick
} -> NgramsDepth -> ReactElement
tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd =
li [ style {width : "100%"} ]
([ i icon []
, tag [text $ " " <> ngramsTermText nd.ngrams]
] <> maybe [] edit (ngramsEdit nd) <>
[ forest cs
])
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = R.hooksComponent "G.C.NT.tree" cpt
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
pure $
H.li { style: {width : "100%"} }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ])
where
tag =
case ngramsClick nd of
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ text " "
, i [ className "glyphicon glyphicon-pencil"
, onClick $ const effect ] [] ]
edit effect = [ H.text " "
, H.i { className: "glyphicon glyphicon-pencil"
, on: { click: const effect } } []
]
leaf = List.null cs
icon = gray <> [className $ "glyphicon glyphicon-chevron-" <> if open then "down" else "right"]
className = "glyphicon glyphicon-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
gray = if leaf then [style {color: "#adb5bd"}] else []
cs = ngramsTable ^.. ix nd.ngrams <<< _NgramsElement <<< _children <<< folded
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsElement <<< _children <<< folded
forest =
let depth = nd.depth + 1 in
ul [] <<< map (\ngrams -> tree params {depth, ngrams}) <<< List.toUnfoldable
let depth = ngramsDepth.depth + 1 in
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< List.toUnfoldable
sumOccurrences' :: NgramsTable -> NgramsTerm -> Additive Int
sumOccurrences' ngramsTable label =
......@@ -473,38 +546,67 @@ sumOccurrences :: NgramsTable -> NgramsElement -> Additive Int
sumOccurrences ngramsTable (NgramsElement {occurrences, children}) =
Additive occurrences <> children ^. folded <<< to (sumOccurrences' ngramsTable)
renderNgramsTree :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
type RenderNgramsTree =
( ngrams :: NgramsTerm
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
} -> ReactElement
renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } =
ul [] [
span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick, ngramsEdit} {ngrams, depth: 0}]
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = R.hooksComponent "G.C.NT.renderNgramsTree" cpt
where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ =
pure $ H.ul {} [
H.span { className: "tree" } [
tree { ngramsClick
, ngramsDepth: {ngrams, depth: 0}
, ngramsEdit
, ngramsStyle
, ngramsTable
}
]
]
renderNgramsItem :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, ngramsLocalPatch :: NgramsTablePatch
type RenderNgramsItem =
( dispatch :: Action -> Effect Unit
, ngrams :: NgramsTerm
, ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, dispatch :: Action -> Effect Unit
} -> Array ReactElement
renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
, ngramsSelection, ngramsLocalPatch, dispatch } =
[ selected
, ngramsTable :: NgramsTable
)
renderNgramsItem :: Record RenderNgramsItem -> R.Element
renderNgramsItem p = R.createElement renderNgramsItemCpt p []
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = R.hooksComponent "G.C.NT.renderNgramsItem" cpt
where
cpt { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable } _ =
pure $ T.makeRow [
selected
, checkbox GraphTerm
, checkbox StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
else
a [onClick $ const $ dispatch $ ToggleChild true ngrams]
[ i [className "glyphicon glyphicon-plus"] []
, span ngramsStyle [text $ " " <> ngramsTermText ngrams]
H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [
H.i { className: "glyphicon glyphicon-plus" } []
, (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams])
]
, text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
termList = ngramsElement ^. _NgramsElement <<< _list
......@@ -520,24 +622,20 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent
-- | ngramsTransient = const Nothing
-- | otherwise = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
selected =
input
[ _type "checkbox"
, className "checkbox"
, checked $ Set.member ngrams ngramsSelection
, onChange $ const $ dispatch $ ToggleSelect ngrams
]
H.input { checked: Set.member ngrams ngramsSelection
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelect ngrams }
, type: "checkbox" }
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then CandidateTerm else termList'
in
input
[ _type "checkbox"
, className "checkbox"
, checked chkd
, readOnly ngramsTransient
, onChange $ const $ when (not ngramsTransient) $ dispatch $
setTermListA ngrams (replace termList termList'')
]
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ TODO here we do not look at ngramsNewElems, shall we?
ngramsOpacity
......@@ -562,5 +660,5 @@ nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option {value} [H.text desc]
optps1 { desc, mval } = H.option { value: value } [H.text desc]
where value = maybe "" show mval
......@@ -84,6 +84,7 @@ import Data.Traversable (class Traversable, for, sequence, traverse, traverse_)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Tuple (Tuple(..))
import Effect.Aff (Aff)
import Effect.Exception.Unsafe (unsafeThrow)
import Foreign.Object as FO
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..))
......@@ -336,14 +337,15 @@ replace old new
| old == new = Keep
| otherwise = Replace { old, new }
instance semigroupReplace :: Semigroup (Replace a) where
derive instance eqReplace :: Eq a => Eq (Replace a)
instance semigroupReplace :: Eq a => Semigroup (Replace a) where
append Keep p = p
append p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-- assert _m == _m'
Replace { old, new }
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { new }) (Replace { old }) = replace old new
instance semigroupMonoid :: Monoid (Replace a) where
instance semigroupMonoid :: Eq a => Monoid (Replace a) where
mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a
......@@ -419,6 +421,9 @@ newtype NgramsPatch = NgramsPatch
, patch_list :: Replace TermList
}
derive instance eqNgramsPatch :: Eq NgramsPatch
derive instance eqPatchSetNgramsTerm :: Eq (PatchSet NgramsTerm)
instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
......@@ -455,13 +460,16 @@ applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
instance semigroupPatchMap :: (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap pMap
where
pMap = Map.filter (\v -> v /= mempty) $ Map.unionWith append p q
instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where
instance monoidPatchMap :: (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty
derive instance newtypePatchMap :: Newtype (PatchMap k p) _
derive instance eqPatchMap :: (Eq k, Eq p) => Eq (PatchMap k p)
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap = _Newtype
......
......@@ -114,7 +114,12 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
pure $ T.table { rows, params, container, colNames, totalRecords, wrapColElts }
where
path = fst pagePath
rows = (\c -> {row: contactCells session frontends (fst pagePath).nodeId c, delete: false}) <$> docs
rows = (\c -> {
row: contactCells { annuaireId: (fst pagePath).nodeId
, frontends
, contact: c
, session }
, delete: false }) <$> docs
container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"]
wrapColElts = const identity
......@@ -124,11 +129,26 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
type AnnuaireId = Int
contactCells :: Session -> Frontends -> AnnuaireId -> CT.Contact -> Array R.Element
contactCells session frontends aId = render
type ContactCellsProps =
(
annuaireId :: AnnuaireId
, contact :: CT.Contact
, frontends :: Frontends
, session :: Session
)
contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
where
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Nothing} )}) =
[ H.text ""
cpt { annuaireId
, contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) })
, frontends
, session } _ =
pure $ T.makeRow [
H.text ""
, H.span {} [ H.text "name" ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text "No ContactWhere"
......@@ -136,17 +156,25 @@ contactCells session frontends aId = render
, H.div {className: "nooverflow"}
[ H.text "No ContactWhereRole" ]
]
render (CT.Contact { id, hyperdata : (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who: who, ou:ou}) } )}) =
--let nodepath = NodePath (sessionId session) NodeContact (Just id)
let nodepath = Routes.ContactPage (sessionId session) aId id
href = url frontends nodepath in
[ H.text ""
, H.a { href} [ H.text $ maybe "name" identity contact.title ]
cpt { annuaireId
, contact: (CT.Contact { id
, hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) })
, frontends
, session } _ =
pure $ T.makeRow [
H.text ""
, H.a { href } [ H.text $ maybe "name" identity contact.title ]
--, H.a { href, target: "blank" } [ H.text $ maybe "name" identity contact.title ]
, H.text $ maybe "No ContactWhere" contactWhereOrg (head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (head $ ou)
, H.div {className: "nooverflow"}
[ H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou) ] ]
, H.div {className: "nooverflow"} [
H.text $ maybe "No ContactWhereRole" contactWhereRole (head $ ou)
]
]
where
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
......
......@@ -4,13 +4,10 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout )
where
import Data.Array (head)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested (Tuple3, (/\))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Class (liftEffect)
......@@ -18,8 +15,8 @@ import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
......
......@@ -84,7 +84,7 @@ type NgramsViewTabsProps =
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView {session,mode, defaultListId, nodeId} =
NT.mainNgramsTable
{ nodeId, defaultListId, tabType, session, tabNgramType }
{ nodeId, defaultListId, tabType, session, tabNgramType, withAutoUpdate: false }
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
......@@ -46,7 +46,7 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
R.fragment
[ chart mode
, NT.mainNgramsTable
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType}
{session, defaultListId, nodeId: corpusId, tabType, tabNgramType, withAutoUpdate: false}
]
where
tabNgramType = modeTabType mode
......
......@@ -20,7 +20,7 @@ type TableContainerProps =
, tableBody :: Array R.Element
)
type Row = { row :: Array R.Element, delete :: Boolean }
type Row = { row :: R.Element, delete :: Boolean }
type Rows = Array Row
type OrderBy = Maybe (OrderByDirection ColumnName)
......@@ -64,6 +64,12 @@ type State =
, orderBy :: OrderBy
}
paramsState :: Params -> State
paramsState {offset, limit, orderBy} = {pageSize, page, orderBy}
where
pageSize = int2PageSizes limit
page = offset / limit + 1
stateParams :: State -> Params
stateParams {pageSize, page, orderBy} = {offset, limit, orderBy}
where
......@@ -128,34 +134,32 @@ tableCpt :: R.Component Props
tableCpt = R.hooksComponent "G.C.Table.table" cpt
where
cpt {container, colNames, wrapColElts, totalRecords, rows, params} _ = do
pageSize@(pageSize' /\ setPageSize) <- R.useState' PS10
(page /\ setPage) <- R.useState' 1
(orderBy /\ setOrderBy) <- R.useState' Nothing
let
state = {pageSize: pageSize', orderBy, page}
ps = pageSizes2Int pageSize'
state = paramsState $ fst params
ps = pageSizes2Int state.pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
colHeader :: ColumnName -> R.Element
colHeader c = H.th {scope: "col"} [ H.b {} cs ]
where
lnk mc = effectLink (setOrderBy (const mc))
lnk mc = effectLink $ snd params $ _ { orderBy = mc }
cs :: Array R.Element
cs =
wrapColElts c $
case orderBy of
case state.orderBy of
Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC ", lnk Nothing (columnName c)]
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)]
R.useEffect2' params state do
when (fst params /= stateParams state) $ (snd params) (const $ stateParams state)
pure $ container
{ pageSizeControl: sizeDD pageSize
, pageSizeDescription: textDescription page pageSize' totalRecords
, paginationLinks: pagination setPage totalPages page
{ pageSizeControl: sizeDD params
, pageSizeDescription: textDescription state.page state.pageSize totalRecords
, paginationLinks: pagination params totalPages
, tableHead: H.tr {} (colHeader <$> colNames)
, tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
, tableBody: map _.row rows
}
makeRow :: Array R.Element -> R.Element
makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els
type FilterRowsParams =
(
......@@ -193,12 +197,13 @@ graphContainer {title} props =
-- , props.pageSizeDescription
-- , props.paginationLinks
sizeDD :: R.State PageSizes -> R.Element
sizeDD (ps /\ setPageSize) =
H.span {} [ R2.select { className, defaultValue: ps, on: {change} } sizes ]
sizeDD :: R.State Params -> R.Element
sizeDD (params /\ setParams) =
H.span {} [ R2.select { className, defaultValue: pageSize, on: {change} } sizes ]
where
{pageSize} = paramsState params
className = "form-control"
change e = setPageSize $ const (string2PageSize $ R2.unsafeEventValue e)
change e = setParams $ \p -> stateParams $ (paramsState p) { pageSize = string2PageSize $ R2.unsafeEventValue e }
sizes = map option pageSizes
option size = H.option {value} [H.text value]
where value = show size
......@@ -212,51 +217,53 @@ textDescription currPage pageSize totalRecords =
end = if end' > totalRecords then totalRecords else end'
msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
pagination :: (R2.Setter Int) -> Int -> Int -> R.Element
pagination changePage tp cp =
pagination :: R.State Params -> Int -> R.Element
pagination (params /\ setParams) tp =
H.span {} $
[ H.text " ", prev, first, ldots]
<>
lnums
<>
[H.b {} [H.text $ " " <> show cp <> " "]]
[H.b {} [H.text $ " " <> show page <> " "]]
<>
rnums
<>
[ rdots, last, next ]
where
prev = if cp == 1 then
{page} = paramsState params
changePage page = setParams $ \p -> stateParams $ (paramsState p) { page = page }
prev = if page == 1 then
H.text " Prev. "
else
changePageLink (cp - 1) "Prev."
next = if cp == tp then
changePageLink (page - 1) "Prev."
next = if page == tp then
H.text " Next "
else
changePageLink (cp + 1) "Next"
first = if cp == 1 then
changePageLink (page + 1) "Next"
first = if page == 1 then
H.text ""
else
changePageLink' 1
last = if cp == tp then
last = if page == tp then
H.text ""
else
changePageLink' tp
ldots = if cp >= 5 then
ldots = if page >= 5 then
H.text " ... "
else
H.text ""
rdots = if cp + 3 < tp then
rdots = if page + 3 < tp then
H.text " ... "
else
H.text ""
lnums = map changePageLink' $ A.filter (1 < _) [cp - 2, cp - 1]
rnums = map changePageLink' $ A.filter (tp > _) [cp + 1, cp + 2]
lnums = map changePageLink' $ A.filter (1 < _) [page - 2, page - 1]
rnums = map changePageLink' $ A.filter (tp > _) [page + 1, page + 2]
changePageLink :: Int -> String -> R.Element
changePageLink i s =
H.span {}
[ H.text " "
, effectLink (changePage (const i)) s
, effectLink (changePage i) s
, H.text " "
]
......@@ -274,6 +281,9 @@ instance showPageSize :: Show PageSizes where
show PS100 = "100"
show PS200 = "200"
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
......
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