Skip to content

P
purescript-gargantext
Commit 6cf771f9 authored by James Laver's avatar James Laver
Browse files
Options

Refactor table components to use reactix

parent 6213f074
Hide whitespace changes
Inline Side-by-side
Showing with 584 additions and 743 deletions
src/Gargantext/Components/DocsTable.purs
View file @ 6cf771f9
...@@ -18,12 +18,13 @@ import Data.Tuple.Nested ((/\)) ...@@ -18,12 +18,13 @@ import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1) import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, TabPostQuery(..), toUrl, endConfigStateful, toLink) import Gargantext.Config (Ends, NodeType(..), OrderBy(..), BackendRoute(..), TabType, TabPostQuery(..), url)
import Gargantext.Config.REST (get, put, post, deleteWithBody, delete) import Gargantext.Config.REST (get, put, post, deleteWithBody, delete)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
...@@ -38,25 +39,25 @@ type NodeID = Int ...@@ -38,25 +39,25 @@ type NodeID = Int
type TotalRecords = Int type TotalRecords = Int
type Props = type Props =
{ nodeId :: Int ( nodeId :: Int
, totalRecords :: Int , totalRecords :: Int
, chart :: R.Element , chart :: R.Element
, tabType :: TabType , tabType :: TabType
, listId :: Int , listId :: Int
, corpusId :: Maybe Int , corpusId :: Maybe Int
, showSearch :: Boolean , showSearch :: Boolean
, ends :: Ends )
-- ^ tabType is not ideal here since it is too much entangled with tabs and -- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. -- ngramtable. Let's see how this evolves. )
}
type PageLoaderProps = type PageLoaderProps =
{ nodeId :: Int ( nodeId :: Int
, totalRecords :: Int , totalRecords :: Int
, tabType :: TabType , tabType :: TabType
, listId :: Int , listId :: Int
, corpusId :: Maybe Int , corpusId :: Maybe Int
, query :: Query , query :: Query
} )
type LocalCategories = Map Int Category type LocalCategories = Map Int Category
type Query = String type Query = String
...@@ -119,18 +120,19 @@ instance decodeResponse :: DecodeJson Response where ...@@ -119,18 +120,19 @@ instance decodeResponse :: DecodeJson Response where
pure $ Response { cid, category: decodeCategory favorite, ngramCount, hyperdata } pure $ Response { cid, category: decodeCategory favorite, ngramCount, hyperdata }
docViewSpec :: Props -> R.Element docView :: Record Props -> R.Element
docViewSpec p = R.createElement el p [] docView p = R.createElement docViewCpt p []
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "DocView" cpt
where where
el = R.hooksComponent "DocView" cpt
cpt p _children = do cpt p _children = do
query <- R.useState' ("" :: Query) query <- R.useState' ("" :: Query)
tableParams <- R.useState' T.initialParams tableParams <- R.useState' T.initialParams
pure $ layoutDocview query tableParams p pure $ layoutDocview query tableParams p
-- | Main layout of the Documents Tab of a Corpus -- | Main layout of the Documents Tab of a Corpus
layoutDocview :: R.State Query -> R.State T.Params -> Props -> R.Element layoutDocview :: R.State Query -> R.State T.Params -> Record Props -> R.Element
layoutDocview query tableParams@(params /\ _) p = R.createElement el p [] layoutDocview query tableParams@(params /\ _) p = R.createElement el p []
where where
el = R.hooksComponent "LayoutDocView" cpt el = R.hooksComponent "LayoutDocView" cpt
...@@ -140,9 +142,13 @@ layoutDocview query tableParams@(params /\ _) p = R.createElement el p [] ...@@ -140,9 +142,13 @@ layoutDocview query tableParams@(params /\ _) p = R.createElement el p []
[ chart [ chart
, if showSearch then searchBar query else H.div {} [] , if showSearch then searchBar query else H.div {} []
, H.div {className: "col-md-12"} , H.div {className: "col-md-12"}
[ pageLoader tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ] [ pageLoader tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ] ] ]
onClickTrashAll nodeId = mkEffectFn1 $ \_ -> do
launchAff $ deleteAllDocuments p.ends nodeId
{-, H.div {className: "col-md-1 col-md-offset-11"} {-, H.div {className: "col-md-1 col-md-offset-11"}
[ pageLoader p.ends tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
, H.div {className: "col-md-1 col-md-offset-11"}
[ H.button { className: "btn" [ H.button { className: "btn"
, style: {backgroundColor: "peru", color : "white", border : "white"} , style: {backgroundColor: "peru", color : "white", border : "white"}
, onClick: onClickTrashAll nodeId , onClick: onClickTrashAll nodeId
...@@ -152,11 +158,6 @@ layoutDocview query tableParams@(params /\ _) p = R.createElement el p [] ...@@ -152,11 +158,6 @@ layoutDocview query tableParams@(params /\ _) p = R.createElement el p []
] ]
] ]
-} -}
]
]
onClickTrashAll nodeId = mkEffectFn1 $ \_ -> do
launchAff $ deleteAllDocuments nodeId
searchBar :: R.State Query -> R.Element searchBar :: R.State Query -> R.Element
searchBar (query /\ setQuery) = R.createElement el {} [] searchBar (query /\ setQuery) = R.createElement el {} []
...@@ -210,12 +211,12 @@ type PageParams = { nodeId :: Int ...@@ -210,12 +211,12 @@ type PageParams = { nodeId :: Int
, query :: Query , query :: Query
, params :: T.Params} , params :: T.Params}
loadPage :: PageParams -> Aff (Array DocumentsView) loadPage :: Ends -> PageParams -> Aff (Array DocumentsView)
loadPage {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do loadPage ends {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit" logs "loading documents page: loadPage with Offset and limit"
-- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId) -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let url = (toUrl endConfigStateful Back Node (Just nodeId)) <> "/table" let url2 = (url ends (NodeAPI Node (Just nodeId))) <> "/table"
res <- post url $ TabPostQuery { res <- post url2 $ TabPostQuery {
offset offset
, limit , limit
, orderBy: convOrderBy orderBy , orderBy: convOrderBy orderBy
...@@ -246,8 +247,8 @@ loadPage {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orde ...@@ -246,8 +247,8 @@ loadPage {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orde
convOrderBy _ = DateAsc -- TODO convOrderBy _ = DateAsc -- TODO
renderPage :: R.State T.Params -> PageLoaderProps -> Array DocumentsView -> R.Element renderPage :: Ends -> R.State T.Params -> Record PageLoaderProps -> Array DocumentsView -> R.Element
renderPage (tableParams /\ setTableParams) p res = R.createElement el p [] renderPage ends (_ /\ setTableParams) p res = R.createElement el p []
where where
el = R.hooksComponent "RenderPage" cpt el = R.hooksComponent "RenderPage" cpt
...@@ -260,61 +261,46 @@ renderPage (tableParams /\ setTableParams) p res = R.createElement el p [] ...@@ -260,61 +261,46 @@ renderPage (tableParams /\ setTableParams) p res = R.createElement el p []
cpt {nodeId, corpusId, listId, totalRecords} _children = do cpt {nodeId, corpusId, listId, totalRecords} _children = do
localCategories <- R.useState' (mempty :: LocalCategories) localCategories <- R.useState' (mempty :: LocalCategories)
pure $ T.table
pure $ R2.buff $ T.tableEltWithInitialState
(T.paramsState tableParams)
{ rows: rows localCategories { rows: rows localCategories
-- , setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, corpusId, params, query}) -- , setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, corpusId, params, query})
, setParams: setTableParams <<< const , setParams: setTableParams <<< const
, container: T.defaultContainer { title: "Documents" } , container: T.defaultContainer { title: "Documents" }
, colNames: , colNames
T.ColumnName <$>
[ "Favorites"
, "Trash"
, "Date"
, "Title"
, "Source"
]
, totalRecords , totalRecords
} }
where where
colNames = T.ColumnName <$> [ "Map", "Stop", "Date", "Title", "Source"]
getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id) getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id)
rows localCategories = (\(DocumentsView r) -> rows localCategories = row <$> res
let cat = getCategory localCategories r where
isDel = Trash == cat in row (DocumentsView r) =
{ row: map R2.scuff $ [ { row:
H.div {} [ H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
[ H.a { className: gi cat , H.input { type: "checkbox", checked, on: {click: click Trash} }
, style: trashStyle cat -- TODO show date: Year-Month-Day only
, on: {click: onClick localCategories Favorite r._id cat} , H.div { style } [ R2.showText r.date ]
} [] , H.div { style } [ H.text r.source ]
] ]
, H.input { type: "checkbox" , delete: true }
, defaultChecked: isDel where
, on: {click: onClick localCategories Trash r._id cat} cat = getCategory localCategories r
} click cat2 = onClick localCategories cat2 r._id cat
-- TODO show date: Year-Month-Day only checked = Trash == cat
, H.div { style: trashStyle cat } [ H.text (show r.date) ] style = trashStyle cat
, H.a { href: toLink $ (corpusDocument corpusId) listId r._id className = gi cat
, style: trashStyle cat
, target: "_blank"
} [ H.text r.title ]
, H.div { style: trashStyle cat} [ H.text r.source ]
]
, delete: true
}) <$> res
onClick (_ /\ setLocalCategories) catType nid cat = \_-> do onClick (_ /\ setLocalCategories) catType nid cat = \_-> do
let newCat = if (catType == Favorite) then (favCategory cat) else (trashCategory cat) let newCat = if (catType == Favorite) then (favCategory cat) else (trashCategory cat)
setLocalCategories $ insert nid newCat setLocalCategories $ insert nid newCat
void $ launchAff $ putCategories nodeId $ CategoryQuery {nodeIds: [nid], category: newCat} void $ launchAff $ putCategories ends nodeId $ CategoryQuery {nodeIds: [nid], category: newCat}
pageLoader :: R.State T.Params -> PageLoaderProps -> R.Element pageLoader :: Ends -> R.State T.Params -> Record PageLoaderProps -> R.Element
pageLoader tableParams@(pageParams /\ _) p = R.createElement el p [] pageLoader ends tableParams@(pageParams /\ _) p = R.createElement el p []
where where
el = R.hooksComponent "PageLoader" cpt el = R.hooksComponent "PageLoader" cpt
cpt p@{nodeId, listId, corpusId, tabType, query} _children = do cpt p@{nodeId, listId, corpusId, tabType, query} _children = do
useLoader {nodeId, listId, corpusId, tabType, query, params: pageParams} loadPage $ \{loaded} -> useLoader {nodeId, listId, corpusId, tabType, query, params: pageParams} (loadPage ends) $
renderPage tableParams p loaded \loaded -> renderPage ends tableParams p loaded
--------------------------------------------------------- ---------------------------------------------------------
sampleData' :: DocumentsView sampleData' :: DocumentsView
...@@ -358,7 +344,6 @@ searchResults :: SearchQuery -> Aff Int ...@@ -358,7 +344,6 @@ searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit searchResults squery = post "http://localhost:8008/count" unit
-- TODO -- TODO
newtype CategoryQuery = CategoryQuery { newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int nodeIds :: Array Int
, category :: Category , category :: Category
...@@ -376,11 +361,11 @@ categoryUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/catego ...@@ -376,11 +361,11 @@ categoryUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/catego
putCategories :: Int -> CategoryQuery -> Aff (Array Int) putCategories :: Int -> CategoryQuery -> Aff (Array Int)
putCategories nodeId = put $ categoryUrl nodeId putCategories nodeId = put $ categoryUrl nodeId
documentsUrl :: Int -> String documentsUrl :: Ends -> Int -> String
documentsUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/documents" documentsUrl ends nodeId = url ends (NodeAPI Node (Just nodeId)) <> "/documents"
deleteAllDocuments :: Int -> Aff (Array Int) deleteAllDocuments :: Ends -> Int -> Aff (Array Int)
deleteAllDocuments nodeId = delete $ documentsUrl nodeId deleteAllDocuments ends = delete <<< documentsUrl ends
-- TODO: not optimal but Data.Set lacks some function (Set.alter) -- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a toggleSet :: forall a. Ord a => a -> Set a -> Set a
......
src/Gargantext/Components/FacetsTable.purs
View file @ 6cf771f9
-- TODO: this module should replace DocsTable -- TODO: this module should replace DocsTable
-- However the fix for favorites in commit 91cb6bd9906e128b3129b1db01ef6ef5ae13f7f8 -- However the fix for favorites in commit 91cb6bd9906e128b3129b1db01ef6ef5ae13f7f8
-- has not been ported to this module yet. -- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where module Gargantext.Components.FacetsTable where
...@@ -12,24 +12,25 @@ import Data.Generic.Rep.Show (genericShow) ...@@ -12,24 +12,25 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import React as React import Reactix as R
import React (ReactClass, ReactElement, Children) import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, toUrl, endConfigStateful) import Gargantext.Config (Ends, NodeType(..), OrderBy(..), NodePath(..), BackendRoute(..), TabType, url)
import Gargantext.Config.REST (put, post, deleteWithBody) import Gargantext.Config.REST (put, post, deleteWithBody)
import Gargantext.Components.Loader as Loader import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Router as Router import Gargantext.Router as Router
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import React.DOM (a, br', button, div, i, input, p, text, span) import Gargantext.Utils.Reactix as R2
import React.DOM.Props (_type, className, href, onClick, style, checked, target)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, hideState)
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NodeID = Int type NodeID = Int
...@@ -40,9 +41,7 @@ type TotalRecords = Int ...@@ -40,9 +41,7 @@ type TotalRecords = Int
-- This searches for documents with "machine learning" or "artificial intelligence" -- This searches for documents with "machine learning" or "artificial intelligence"
type TextQuery = Array (Array String) type TextQuery = Array (Array String)
newtype SearchQuery = SearchQuery newtype SearchQuery = SearchQuery { query :: TextQuery }
{ query :: TextQuery
}
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post) encodeJson (SearchQuery post)
...@@ -58,51 +57,39 @@ instance decodeSearchResults :: DecodeJson SearchResults where ...@@ -58,51 +57,39 @@ instance decodeSearchResults :: DecodeJson SearchResults where
pure $ SearchResults {results} pure $ SearchResults {results}
type Props = type Props =
{ nodeId :: Int ( nodeId :: Int
, listId :: Int , listId :: Int
, query :: TextQuery , query :: TextQuery
, totalRecords :: Int , totalRecords :: Int
, chart :: ReactElement , chart :: R.Element
, container :: T.TableContainerProps -> Array ReactElement , container :: Record T.TableContainerProps -> R.Element
} , ends :: Ends
)
type State =
{ documentIdsToDelete :: Set Int
, documentIdsDeleted :: Set Int
}
initialState :: State -- | Tracks the ids of documents to delete and that have been deleted
initialState = type Deletions = { pending :: Set Int, deleted :: Set Int }
{ documentIdsToDelete: mempty
, documentIdsDeleted: mempty
}
data Action initialDeletions :: Deletions
= MarkCategory Category (Array Int) initialDeletions = { pending: mempty, deleted: mempty }
| ToggleDocumentToDelete Int
| TrashDocuments
newtype Pair = Pair newtype Pair = Pair { id :: Int, label :: String }
{ id :: Int
, label :: String
}
derive instance genericPair :: Generic Pair _ derive instance genericPair :: Generic Pair _
instance showPair :: Show Pair where instance showPair :: Show Pair where
show = genericShow show = genericShow
newtype DocumentsView newtype DocumentsView =
= DocumentsView DocumentsView
{ id :: Int { id :: Int
, date :: String , date :: String
, title :: String , title :: String
, source :: String , source :: String
, score :: Int , score :: Int
, pairs :: Array Pair , pairs :: Array Pair
, delete :: Boolean , delete :: Boolean
, category :: Category , category :: Category
} }
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance genericDocumentsView :: Generic DocumentsView _
...@@ -120,7 +107,6 @@ newtype Response = Response ...@@ -120,7 +107,6 @@ newtype Response = Response
-- , pairs :: Array Pair -- , pairs :: Array Pair
} }
newtype Hyperdata = Hyperdata newtype Hyperdata = Hyperdata
{ title :: String { title :: String
, source :: String , source :: String
...@@ -133,7 +119,6 @@ newtype Hyperdata = Hyperdata ...@@ -133,7 +119,6 @@ newtype Hyperdata = Hyperdata
-- source <- obj .: "source" -- source <- obj .: "source"
-- pure $ Hyperdata { title,source } -- pure $ Hyperdata { title,source }
instance decodePair :: DecodeJson Pair where instance decodePair :: DecodeJson Pair where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
...@@ -172,252 +157,180 @@ instance decodeResponse :: DecodeJson Response where ...@@ -172,252 +157,180 @@ instance decodeResponse :: DecodeJson Response where
let ngramCount = 1 let ngramCount = 1
pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount} pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount}
-- | Filter
-- TODO: unused
filterSpec :: forall state props action. Spec state props action
filterSpec = simpleSpec defaultPerformAction render
where
render d p s c = [] {-[div [ className "col-md-2", style {textAlign : "center", marginLeft : "0px", paddingLeft : "0px"}] [ text " Filter "
, input [className "form-control", placeholder "Filter here"]
]]
-}
docViewSpec :: Spec {} Props Void
docViewSpec = hideState (const initialState) layoutDocviewGraph
-- | Main layout of the Documents Tab of a Corpus -- | Main layout of the Documents Tab of a Corpus
layoutDocview :: Spec State Props Action docView :: Record Props -> R.Element
layoutDocview = simpleSpec performAction render docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
docViewCpt = R.hooksComponent "G.C.FacetsTable.DocView" cpt
where where
performAction :: PerformAction State Props Action cpt {ends, nodeId, listId, query, totalRecords, chart, container} _ = do
performAction (MarkCategory category nids) {nodeId} _ = deletions <- R.useState' initialDeletions
void $ lift $ putCategories nodeId $ CategoryQuery {nodeIds: nids, category: favCategory category} path <- R.useState' $ initialPagePath {nodeId, listId, query, ends}
--TODO add array of delete rows here pure $ H.div { className: "container1" }
performAction (ToggleDocumentToDelete nid) _ _ = [ H.div { className: "row" }
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
performAction TrashDocuments {nodeId} {documentIdsToDelete} = do
void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
modifyState_ \{documentIdsToDelete, documentIdsDeleted} ->
{ documentIdsToDelete: mempty
, documentIdsDeleted: documentIdsDeleted <> documentIdsToDelete
}
render :: Render State Props Action
render dispatch {nodeId, listId, query, totalRecords, chart, container} deletionState _ =
[ {- br'
, div [ style {textAlign : "center"}] [ text " Filter "
, input [className "form-control", style {width : "120px", display : "inline-block"}, placeholder "Filter here"]
]
, p [] [text ""]
, br'
-}
div [className "container1"]
[ div [className "row"]
[ chart [ chart
, div [className "col-md-12"] , H.div { className: "col-md-12" }
[ pageLoader [ pageLayout { deletions, totalRecords, container, ends, path } ]
{ path: initialPageParams {nodeId, listId, query} , H.div { className: "col-md-12" }
, totalRecords [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
, deletionState [ H.i { className: "glyphitem glyphicon glyphicon-trash"
, dispatch , style: { marginRight : "9px" }} []
, container , H.text "Delete document!" ] ] ] ]
} where
] buttonStyle =
, div [className "col-md-12"] { backgroundColor: "peru", padding: "9px", color: "white"
[ button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"} , border: "white", float: "right" }
, onClick $ (\_ -> dispatch TrashDocuments) trashClick deletions _ = performDeletions ends nodeId deletions
]
[ i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] [] performDeletions :: Ends -> Int -> R.State Deletions -> Effect Unit
, text "Trash it !" performDeletions ends nodeId (deletions /\ setDeletions) =
] launchAff_ call *> setDeletions del
]
]
]
]
layoutDocviewGraph :: Spec State Props Action
layoutDocviewGraph = simpleSpec performAction render
where where
performAction :: PerformAction State Props Action q = {documents: Set.toUnfoldable deletions.pending}
performAction (MarkCategory category nids) {nodeId} _ = call = deleteDocuments ends nodeId (DeleteDocumentQuery q)
void $ lift $ putCategories nodeId $ CategoryQuery {nodeIds: nids, category: favCategory category} del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}
--TODO add array of delete rows here
performAction (ToggleDocumentToDelete nid) _ _ = -- markCategory :: Ends -> NodeID -> _ -> Array NodeID -> Effect Unit
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete} markCategory ends nodeId category nids =
performAction TrashDocuments {nodeId} {documentIdsToDelete} = do void $ launchAff_ $putCategories ends nodeId (CategoryQuery q)
void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete}) where -- TODO add array of delete rows here
modifyState_ \{documentIdsToDelete, documentIdsDeleted} -> q = {nodeIds: nids, category: favCategory category}
{ documentIdsToDelete: mempty
, documentIdsDeleted: documentIdsDeleted <> documentIdsToDelete togglePendingDeletion :: R.State Deletions -> NodeID -> Effect Unit
} togglePendingDeletion (_ /\ setDeletions) nid = setDeletions setter
where setter deletions@{pending} = deletions { pending = toggleSet nid pending }
render :: Render State Props Action
render dispatch {nodeId, listId, query, totalRecords, chart, container} deletionState _ = docViewGraph :: Record Props -> R.Element
[ br' docViewGraph props = R.createElement docViewCpt props []
, p [] [text ""] docViewGraphCpt :: R.Component Props
, br' docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt
, div [className "container-fluid"] where
[ div [className "row"] cpt {ends, nodeId, listId, query, totalRecords, chart, container} _ = do
[ chart deletions <- R.useState' initialDeletions
, div [className "col-md-12"] let buttonStyle = { backgroundColor: "peru", padding : "9px"
[ pageLoader , color : "white", border : "white", float: "right"}
{ path: initialPageParams {nodeId, listId, query} let performClick = \_ -> performDeletions ends nodeId deletions
, totalRecords path <- R.useState' $ initialPagePath { nodeId, listId, query, ends }
, deletionState pure $ R.fragment
, dispatch [ H.br {}
, container , H.p {} [ H.text "" ]
} , H.br {}
, button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"} , H.div { className: "container-fluid" }
, onClick $ (\_ -> dispatch TrashDocuments) [ H.div { className: "row" }
] [ chart
[ i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] [] , H.div { className: "col-md-12" }
, text "Trash it !" [ pageLayout { totalRecords, deletions, container, ends, path }
] , H.button { style: buttonStyle, on: { click: performClick } }
] [ H.i { className: "glyphitem glyphicon glyphicon-trash"
, style: { marginRight : "9px" } } []
] , H.text "Delete document!" ] ] ] ] ]
]
] type PagePath = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params, ends :: Ends}
initialPagePath :: {ends :: Ends, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath
initialPagePath {ends, nodeId, listId, query} = {ends, nodeId, listId, query, params: T.initialParams}
type PageParams = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params}
loadPage :: PagePath -> Aff (Array DocumentsView)
initialPageParams :: {nodeId :: Int, listId :: Int, query :: TextQuery} -> PageParams loadPage {ends, nodeId, listId, query, params: {limit, offset, orderBy}} = do
initialPageParams {nodeId, listId, query} = {nodeId, listId, query, params: T.initialParams}
loadPage :: PageParams -> Aff (Array DocumentsView)
loadPage {nodeId, listId, query, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit" logs "loading documents page: loadPage with Offset and limit"
let url = toUrl endConfigStateful Back (Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy }) (Just nodeId) let url2 = url ends $ Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
SearchResults res <- post url $ SearchQuery {query} SearchResults res <- post url2 $ SearchQuery {query}
pure $ res2corpus <$> res.results pure $ res2corpus <$> res.results
where where
res2corpus :: Response -> DocumentsView res2corpus :: Response -> DocumentsView
res2corpus (Response { id, created: date, ngramCount: score res2corpus (Response { id, created: date, ngramCount: score, category
, hyperdata: Hyperdata {title, source} , hyperdata: Hyperdata {title, source} }) =
, category DocumentsView { id, date, title, source, score, category, pairs: [], delete: false }
}) =
DocumentsView
{ id
, date
, title
, source
, score
, pairs: []
, delete: false
, category
}
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc
convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
convOrderBy (T.ASC (T.ColumnName "Source")) = SourceAsc convOrderBy (T.ASC (T.ColumnName "Source")) = SourceAsc
convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
convOrderBy _ = DateAsc -- TODO convOrderBy _ = DateAsc -- TODO
type PageLoaderProps row = type PageLayoutProps =
{ path :: PageParams ( totalRecords :: Int
, totalRecords :: Int , deletions :: R.State Deletions
, dispatch :: Action -> Effect Unit , container :: Record T.TableContainerProps -> R.Element
, deletionState :: State , ends :: Ends
, container :: T.TableContainerProps -> Array ReactElement , path :: R.State PagePath
| row )
}
type PageProps = ( documents :: Array DocumentsView | PageLayoutProps )
renderPage :: forall props path. -- | Loads and renders a page
Render (Loader.State {nodeId :: Int, listId :: Int, query :: TextQuery | path} (Array DocumentsView)) pageLayout :: Record PageLayoutProps -> R.Element
{ totalRecords :: Int pageLayout props = R.createElement pageLayoutCpt props []
, dispatch :: Action -> Effect Unit
, deletionState :: State pageLayoutCpt :: R.Component PageLayoutProps
, container :: T.TableContainerProps -> Array ReactElement pageLayoutCpt = R.hooksComponent "G.C.FacetsTable.PageLayout" cpt
| props where
} cpt {totalRecords, deletions, container, ends, path} _ = do
(Loader.Action PageParams) useLoader (fst path) loadPage $ \documents ->
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner page {totalRecords, deletions, container, ends, path, documents}
renderPage loaderDispatch { totalRecords, dispatch, container
, deletionState: {documentIdsToDelete, documentIdsDeleted}} page :: Record PageProps -> R.Element
{currentPath: {nodeId, listId, query}, loaded: Just res} _ = page props = R.createElement pageCpt props []
[ T.tableElt
{ rows pageCpt :: R.Component PageProps
, setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, listId, query, params}) pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
, container
, colNames:
T.ColumnName <$>
[ ""
, "Date"
, "Title"
, "Source"
, "Authors"
, "Delete"
]
, totalRecords
}
]
where where
-- TODO: how to interprete other scores? cpt {totalRecords, container, deletions, documents, ends, path: path@({nodeId, listId, query} /\ setPath)} _ = do
gi Favorite = "glyphicon glyphicon-star-empty" T.table { rows, container, colNames, totalRecords, setParams }
gi _ = "glyphicon glyphicon-star" where
isChecked id = Set.member id documentIdsToDelete setParams params = setPath (_ {params = params})
isDeleted (DocumentsView {id}) = Set.member id documentIdsDeleted colNames = T.ColumnName <$> [ "", "Date", "Title", "Source", "Authors", "Delete" ]
pairUrl (Pair {id,label}) -- TODO: how to interprete other scores?
| id > 1 = [a [href (toUrl endConfigStateful Front NodeContact (Just id)), target "blank"] [text label]] gi Favorite = "glyphicon glyphicon-star-empty"
| otherwise = [text label] gi _ = "glyphicon glyphicon-star"
comma = span [] [text ", "] isChecked id = Set.member id (fst deletions).pending
rows = (\(DocumentsView {id,score,title,source,date,pairs,delete,category}) -> isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
let pairUrl (Pair {id,label})
strikeIfDeleted | id > 1 = H.a { href, target: "blank" } [ H.text label ]
| delete = [style {textDecoration : "line-through"}] where href = url ends $ NodePath NodeContact (Just id)
| otherwise = [] | otherwise = H.text label
in comma = H.span {} [ H.text ", " ]
{ row: rows = row <$> filter (not <<< isDeleted) documents
[ div [] where
[ a [ className $ gi category row (DocumentsView {id,score,title,source,date,pairs,delete,category}) =
, onClick $ const $ dispatch $ MarkCategory category [id] { row:
] [] [ H.div {}
] [ H.a { className, on: {click: markClick} } []
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, div strikeIfDeleted [text date] , maybeStricken [ H.text date ]
, a (strikeIfDeleted <> [ href $ toLink endConfigStateful $ Router.Document listId id , maybeStricken [ H.text source ]
, target "blank"]) -- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
[ text title ] , H.input { type: "checkbox", checked: isChecked id, on: { click: toggleClick } }
, div strikeIfDeleted [text source] ] ]
, div strikeIfDeleted $ intercalate [comma] $ pairUrl <$> pairs , delete: true }
, input [ _type "checkbox" where
, checked (isChecked id) markClick _ = markCategory ends nodeId category [id]
, onClick $ const $ dispatch $ ToggleDocumentToDelete id] toggleClick _ = togglePendingDeletion deletions id
] className = gi category
, delete: true maybeStricken
}) <$> filter (not <<< isDeleted) res | delete = H.div { style: { textDecoration: "line-through" } }
| otherwise = H.div {}
pageLoaderClass :: ReactClass (PageLoaderProps (children :: Children))
pageLoaderClass = Loader.createLoaderClass' "PageLoader" loadPage renderPage
pageLoader :: PageLoaderProps () -> ReactElement
pageLoader props = React.createElement pageLoaderClass props []
---------------------------------------------------------
newtype DeleteDocumentQuery = DeleteDocumentQuery ---------------------------------------------------------
{
documents :: Array Int
}
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery post) encodeJson (DeleteDocumentQuery post) =
= "documents" := post.documents "documents" := post.documents ~> jsonEmptyObject
~> jsonEmptyObject
putFavorites :: Int -> FavoriteQuery -> Aff (Array Int) putFavorites :: Ends -> Int -> FavoriteQuery -> Aff (Array Int)
putFavorites nodeId = put (toUrl endConfigStateful Back Node (Just nodeId) <> "/favorites") putFavorites ends nodeId = put to
where to = url endst (NodeAPI Node (Just nodeId)) <> "/favorites"
deleteFavorites :: Int -> FavoriteQuery -> Aff (Array Int) deleteFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
deleteFavorites nodeId = deleteWithBody (toUrl endConfigStateful Back Node (Just nodeId) <> "/favorites") deleteFavorites nodeId = deleteWithBody to
where to = url ends (NodeAPI Node (Just nodeId)) <> "/favorites"
deleteDocuments :: Int -> DeleteDocumentQuery -> Aff (Array Int) deleteDocuments :: Ends -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments nodeId = deleteWithBody (toUrl endConfigStateful Back Node (Just nodeId) <> "/documents") deleteDocuments ends nodeId = deleteWithBody to
where to = url ends (NodeAPI Node (Just nodeId)) <> "/documents"
src/Gargantext/Components/NgramsTable.purs
View file @ 6cf771f9
module Gargantext.Components.NgramsTable module Gargantext.Components.NgramsTable where
( Action
, MainNgramsTableProps
, initialState
, mainNgramsTableSpec
, ngramsTableClass
, ngramsTableSpec
, termStyle
)
where
import Data.Array as A import Data.Array as A
import Data.Lens (to, view, (%~), (.~), (^.), (^..)) import Data.Lens (to, view, (%~), (.~), (^.), (^..))
...@@ -24,7 +15,10 @@ import Data.Monoid.Additive (Additive(..)) ...@@ -24,7 +15,10 @@ import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, h2, i, input, li, option, p, select, span, table, tbody, text, thead, ul) import React.DOM (a, button, div, h2, i, input, li, option, p, select, span, table, tbody, text, thead, ul)
import React.DOM.Props (_id, _type, checked, className, name, onChange, onClick, onInput, placeholder, style, value) import React.DOM.Props (_id, _type, checked, className, name, onChange, onClick, onInput, placeholder, style, value)
...@@ -32,11 +26,11 @@ import React.DOM.Props as DOM ...@@ -32,11 +26,11 @@ import React.DOM.Props as DOM
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, createClass) import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, createClass)
import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes) import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Config (OrderBy(..), TabType, CTabNgramType(..)) import Gargantext.Config (Ends, OrderBy(..), TabType, CTabNgramType(..))
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Loader as Loader import Gargantext.Hooks.Loader (useLoader, useLoader2)
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -52,9 +46,8 @@ type State = ...@@ -52,9 +46,8 @@ type State =
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren") _ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
initialState :: forall props. { loaded :: VersionedNgramsTable | props } initialState :: VersionedNgramsTable -> State
-> State initialState (Versioned {version}) =
initialState {loaded: Versioned {version}} =
{ ngramsTablePatch: mempty { ngramsTablePatch: mempty
, ngramsVersion: version , ngramsVersion: version
, ngramsParent: Nothing , ngramsParent: Nothing
...@@ -78,86 +71,66 @@ data Action ...@@ -78,86 +71,66 @@ data Action
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
type LoaderAction = Loader.Action PageParams
type LoaderDispatch = LoaderAction -> Effect Unit
tableContainer :: { pageParams :: PageParams tableContainer :: { pageParams :: PageParams
, dispatch :: Dispatch , dispatch :: Dispatch
, loaderDispatch :: LoaderDispatch , setPath :: R2.Setter PageParams
, ngramsParent :: Maybe NgramsTerm , ngramsParent :: Maybe NgramsTerm
, ngramsChildren :: Map NgramsTerm Boolean , ngramsChildren :: Map NgramsTerm Boolean
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
} }
-> T.TableContainerProps -> Array ReactElement -> Record T.TableContainerProps -> R.Element
tableContainer { pageParams tableContainer { pageParams
, dispatch , dispatch
, loaderDispatch , setPath
, ngramsParent , ngramsParent
, ngramsChildren , ngramsChildren
, ngramsTable: ngramsTableCache , ngramsTable: ngramsTableCache
} props = } props =
[ div [className "container-fluid"] H.div {className: "container-fluid"}
[ div [className "jumbotron1"] [ H.div {className: "jumbotron1"}
[ div [className "row"] [ H.div {className: "row"}
[ div [className "panel panel-default"] [ H.div {className: "panel panel-default"}
[ div [className "panel-heading"] [ H.div {className: "panel-heading"}
[ h2 [className "panel-title", style {textAlign : "center"}] [ H.h2 {className: "panel-title", style: {textAlign : "center"}}
[ span [className "glyphicon glyphicon-hand-down"] [] [ H.span {className: "glyphicon glyphicon-hand-down"} []
, text "Extracted Terms" , H.text "Extracted Terms"
]
, div [className "row"]
[
{-div [className "savediv pull-left col-md-2", style { marginTop :"35px"}]
[ button [_id "ImportListOrSaveAll", className "btn btn-warning", style {fontSize : "120%"}]
[ text "Import a Termlist" ]
]
,-}
div [className "col-md-3", style {marginTop : "6px"}]
[ input [ className "form-control "
, name "search", placeholder "Search"
, _type "value"
, value pageParams.searchQuery
, onInput \e -> setSearchQuery (R2.unsafeEventValue e)
]
, div [] (
if A.null props.tableBody && pageParams.searchQuery /= "" then [
button [ className "btn btn-primary"
, onClick $ const $ dispatch $ AddNewNgram pageParams.searchQuery
] [text $ "Add " <> pageParams.searchQuery]
] else []
)
]
, div [className "col-md-2", style {marginTop : "6px"}]
[ li [className " list-group-item"]
[ select [ _id "picklistmenu"
, className "form-control custom-select"
, value (maybe "" show pageParams.termListFilter)
, onChange (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)
] $ map optps1 termLists
]
]
, div [className "col-md-2", style {marginTop : "6px"}]
[ li [className "list-group-item"]
[ select [ _id "picktermtype"
, className "form-control custom-select"
, value (maybe "" show pageParams.termSizeFilter)
, onChange (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)
] $ map optps1 termSizes
]
]
, div [className "col-md-4", style {marginTop : "6px", marginBottom : "1px"}]
[ li [className " list-group-item"] [ props.pageSizeDescription
, props.pageSizeControl
, text " items / "
, props.paginationLinks
]
--, li [className " list-group-item"] [ props.pageSizeControl ]
]
]
] ]
, div [] (maybe [] (\ngrams -> , H.div {className: "row"}
[ H.div {className: "col-md-3", style: {marginTop: "6px"}}
[ H.input { className: "form-control"
, name: "search"
, placeholder: "Search"
, type: "value"
, value: pageParams.searchQuery
, on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}}
, H.div {} (
if A.null props.tableBody && pageParams.searchQuery /= "" then [
H.button { className: "btn btn-primary"
, on: {click: const $ dispatch $ AddNewNgram pageParams.searchQuery}}
[ H.text ("Add " <> pageParams.searchQuery) ]
] 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 pageParams.termListFilter)
, on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}}
(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 pageParams.termSizeFilter)
, on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}}
(map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: " list-group-item"}
[ props.pageSizeDescription
, props.pageSizeControl
, H.text " items / "
, props.paginationLinks]]]]
, H.div {}
(maybe [] (\ngrams ->
let let
ngramsTable = ngramsTable =
ngramsTableCache # at ngrams ngramsTableCache # at ngrams
...@@ -170,24 +143,17 @@ tableContainer { pageParams ...@@ -170,24 +143,17 @@ tableContainer { pageParams
ngramsClick _ = Nothing ngramsClick _ = Nothing
ngramsEdit _ = Nothing ngramsEdit _ = Nothing
in in
[ p[] [text $ "Editing " <> ngrams] [ H.p {} [H.text $ "Editing " <> ngrams]
, renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit } , R2.buff $ renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, button [className "btn btn-primary", onClick $ const $ dispatch $ AddTermChildren] [text "Save"] , H.button {className: "btn btn-primary", on: {click: (const $ dispatch $ AddTermChildren)}} [H.text "Save"]
, button [className "btn btn-secondary", onClick $ const $ dispatch $ SetParentResetChildren Nothing] [text "Cancel"] , H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
]) ngramsParent) ]) ngramsParent)
, div [ _id "terms_table", className "panel-body" ] , H.div {id: "terms_table", className: "panel-body"}
[ table [ className "table able" ] [ H.table {className: "table able"}
[ thead [ className "tableHeader"] [props.tableHead] [ H.thead {className: "tableHeader"} [props.tableHead]
, tbody [] props.tableBody , H.tbody {} props.tableBody]]]]]]
]
]
]
]
]
]
]
where where
setPageParams f = loaderDispatch $ Loader.SetPath $ f pageParams setPageParams f = setPath (const $ f pageParams)
setSearchQuery x = setPageParams $ _ { searchQuery = x } setSearchQuery x = setPageParams $ _ { searchQuery = x }
setTermListFilter x = setPageParams $ _ { termListFilter = x } setTermListFilter x = setPageParams $ _ { termListFilter = x }
setTermSizeFilter x = setPageParams $ _ { termSizeFilter = x } setTermSizeFilter x = setPageParams $ _ { termSizeFilter = x }
...@@ -196,21 +162,50 @@ toggleMap :: forall a. a -> Maybe a -> Maybe a ...@@ -196,21 +162,50 @@ toggleMap :: forall a. a -> Maybe a -> Maybe a
toggleMap _ (Just _) = Nothing toggleMap _ (Just _) = Nothing
toggleMap b Nothing = Just b toggleMap b Nothing = Just b
ngramsTableSpec :: CTabNgramType -> Spec State LoadedNgramsTableProps Action data Action'
ngramsTableSpec ntype = simpleSpec performAction render = SetParentResetChildren' (Maybe NgramsTerm)
| ToggleChild' (Maybe NgramsTerm) NgramsTerm
| Refresh'
performNgramsAction :: State -> Action' -> State
performNgramsAction st (SetParentResetChildren' term) = st
performNgramsAction st (ToggleChild' b c) = st
performNgramsAction st Refresh' = st
useNgramsReducer :: State -> R.Hooks (R.Reducer State Action')
useNgramsReducer init = R.useReducer performNgramsAction identity init
type Props =
( ends :: Ends
, tabNgramType :: CTabNgramType
, path :: R.State PageParams
, versioned :: VersionedNgramsTable )
ngramsTable :: Record Props -> R.Element
ngramsTable props = R.createElement ngramsTableCpt props []
ngramsTableCpt :: R.Component Props
ngramsTableCpt = R.hooksComponent "G.C.NgramsTable.ngramsTable" cpt
where
cpt {versioned} _ = do
state <- useNgramsReducer (initialState versioned)
pure $ R.fragment []
ngramsTableSpec :: Ends -> CTabNgramType -> R2.Setter PageParams -> Spec State (Record LoadedNgramsTableProps) Action
ngramsTableSpec ends ntype setPath = simpleSpec performAction render
where where
setParentResetChildren :: Maybe NgramsTerm -> State -> State setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty } setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: PerformAction State LoadedNgramsTableProps Action performAction :: PerformAction State (Record LoadedNgramsTableProps) Action
performAction (SetParentResetChildren p) _ _ = performAction (SetParentResetChildren p) _ _ =
modifyState_ $ setParentResetChildren p modifyState_ $ setParentResetChildren p
performAction (ToggleChild b c) _ _ = performAction (ToggleChild b c) _ _ =
modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b
performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do performAction Refresh {path: {nodeId, listIds, tabType}} {ngramsVersion} = do
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: mempty})
performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} = performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pe = NgramsPatch { patch_list: pl, patch_children: mempty } pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = singletonNgramsTablePatch ntype n pe pt = singletonNgramsTablePatch ntype n pe
...@@ -223,94 +218,87 @@ ngramsTableSpec ntype = simpleSpec performAction render ...@@ -223,94 +218,87 @@ ngramsTableSpec ntype = simpleSpec performAction render
, ngramsVersion , ngramsVersion
} = do } = do
modifyState_ $ setParentResetChildren Nothing modifyState_ $ setParentResetChildren Nothing
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch ends {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pc = patchSetFromMap ngramsChildren pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc } pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch ntype parent pe pt = singletonNgramsTablePatch ntype parent pe
performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} = performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} =
commitPatch {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch ends {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram ntype ngram CandidateTerm pt = addNewNgram ntype ngram CandidateTerm
render :: Render State LoadedNgramsTableProps Action render :: Render State (Record LoadedNgramsTableProps) Action
render dispatch { path: pageParams render dispatch { path: pageParams
, loaded: Versioned { data: initTable } , loaded: Versioned { data: initTable } }
, dispatch: loaderDispatch }
{ ngramsTablePatch, ngramsParent, ngramsChildren } { ngramsTablePatch, ngramsParent, ngramsChildren }
_reactChildren = _reactChildren =
[ autoUpdateElt { duration: 3000 [ autoUpdateElt { duration: 3000, effect: dispatch Refresh }
, effect: dispatch Refresh , R2.scuff $ T.table { rows, setParams, container, colNames, totalRecords}
}
, T.tableElt
{ rows
, setParams
, container: tableContainer {pageParams, loaderDispatch, dispatch, ngramsParent, ngramsChildren, ngramsTable}
, colNames:
T.ColumnName <$>
[ "Map"
, "Stop"
, "Terms"
, "Score (Occurrences)" -- see convOrderBy
]
, totalRecords: 47361 -- TODO
}
] ]
where where
setParams params = totalRecords = 47361 -- TODO
loaderDispatch $ Loader.SetPath $ pageParams {params = params} colNames = T.ColumnName <$> ["Map", "Stop", "Terms", "Score (Occurrences)"] -- see convOrderBy
ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable container = tableContainer {pageParams, setPath, dispatch, ngramsParent, ngramsChildren, ngramsTable}
orderWith = setParams params = setPath $ const (pageParams {params = params})
case convOrderBy <$> pageParams.params.orderBy of ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences orderWith =
Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences case convOrderBy <$> pageParams.params.orderBy of
_ -> identity -- the server ordering is enough here Just ScoreAsc -> A.sortWith \x -> (snd x) ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> A.sortWith \x -> Down $ (snd x) ^. _NgramsElement <<< _occurrences
rows = convertRow <$> orderWith (addOcc <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable))) _ -> identity -- the server ordering is enough here
addOcc (Tuple ne ngramsElement) =
let Additive occurrences = sumOccurrences ngramsTable ngramsElement in rows = convertRow <$> orderWith (addOcc <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable)))
Tuple ne (ngramsElement # _NgramsElement <<< _occurrences .~ occurrences) addOcc (Tuple ne ngramsElement) =
let Additive occurrences = sumOccurrences ngramsTable ngramsElement in
ngramsParentRoot :: Maybe String Tuple ne (ngramsElement # _NgramsElement <<< _occurrences .~ occurrences)
ngramsParentRoot =
(\np -> ngramsTable ^. at np <<< _Just <<< _NgramsElement <<< _root) =<< ngramsParent ngramsParentRoot :: Maybe String
ngramsParentRoot =
displayRow (NgramsElement {ngrams, root}) = (\np -> ngramsTable ^. at np <<< _Just <<< _NgramsElement <<< _root) =<< ngramsParent
root == Nothing
-- ^ Display only nodes without parents displayRow (NgramsElement {ngrams, root}) =
&& ngramsChildren ^. at ngrams /= Just true root == Nothing
-- ^ and which are not scheduled to be added already -- ^ Display only nodes without parents
&& Just ngrams /= ngramsParent && ngramsChildren ^. at ngrams /= Just true
-- ^ and which are not our new parent -- ^ and which are not scheduled to be added already
&& Just ngrams /= ngramsParentRoot && Just ngrams /= ngramsParent
-- ^ and which are not the root of our new parent -- ^ and which are not our new parent
|| -- Unless they are scheduled to be removed. && Just ngrams /= ngramsParentRoot
ngramsChildren ^. at ngrams == Just false -- ^ and which are not the root of our new parent
convertRow (Tuple ngrams ngramsElement) = || -- Unless they are scheduled to be removed.
{ row: renderNgramsItem { ngramsTable, ngrams, ngramsParent, ngramsElement, dispatch} ngramsChildren ^. at ngrams == Just false
, delete: false convertRow (Tuple ngrams ngramsElement) =
} { row: R2.buff <$> renderNgramsItem { ngramsTable, ngrams, ngramsParent, ngramsElement, dispatch}
, delete: false
ngramsTableClass :: CTabNgramType -> Loader.InnerClass PageParams VersionedNgramsTable }
ngramsTableClass ct = createClass "NgramsTable" (ngramsTableSpec ct) initialState
-- ngramsTableClass :: Ends -> CTabNgramType -> R2.Setter PageParams -> Loader.InnerClass PageParams (Versioned NgramsTable)
-- ngramsTableClass ends ct setPath = createClass "NgramsTable" (ngramsTableSpec ends ct setPath) initialState
-- ngramsTable' :: Ends -> CTabNgramType -> R2.Setter PageParams -> Record LoadedNgramsTableProps -> R.Element
-- ngramsTable' ends ct setPath props = R2.createElement' (ngramsTableClass ends ct setPath) props []
type MainNgramsTableProps = type MainNgramsTableProps =
{ nodeId :: Int ( nodeId :: Int
-- ^ This node can be a corpus or contact. -- ^ This node can be a corpus or contact.
, defaultListId :: Int , defaultListId :: Int
, tabType :: TabType , tabType :: TabType
} , ends :: Ends
, tabNgramType :: CTabNgramType
)
mainNgramsTableSpec :: CTabNgramType -> Spec {} MainNgramsTableProps Void mainNgramsTable :: Record MainNgramsTableProps -> R.Element
mainNgramsTableSpec nt = simpleSpec defaultPerformAction render mainNgramsTable props = R.createElement mainNgramsTableCpt props []
where
render :: Render {} MainNgramsTableProps Void
render _ {nodeId, defaultListId, tabType} _ _ =
[ ngramsLoader
{ path: initialPageParams nodeId [defaultListId] tabType
, component: (ngramsTableClass nt)
} ]
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
where
cpt {nodeId, defaultListId, tabType, ends, tabNgramType} _ = do
path <- R.useState' $ initialPageParams ends nodeId [defaultListId] tabType
useLoader2 path (loadNgramsTable ends) $
\versioned -> ngramsTable {ends, tabNgramType, path, versioned}
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int} type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit) type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
...@@ -415,7 +403,6 @@ nextTermList GraphTerm = StopTerm ...@@ -415,7 +403,6 @@ nextTermList GraphTerm = StopTerm
nextTermList StopTerm = CandidateTerm nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm nextTermList CandidateTerm = GraphTerm
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> ReactElement optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = option [value val] [text desc] optps1 { desc, mval } = H.option {value} [H.text desc]
where where value = maybe "" show mval
val = maybe "" show mval
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 6cf771f9
...@@ -86,7 +86,7 @@ import Partial.Unsafe (unsafePartial) ...@@ -86,7 +86,7 @@ import Partial.Unsafe (unsafePartial)
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Types (TermList(..), TermSize) import Gargantext.Types (TermList(..), TermSize)
import Gargantext.Config (toUrl, endConfigStateful, End(..), Path(..), TabType, OrderBy(..), CTabNgramType(..)) import Gargantext.Config (Ends, BackendRoute(..), TabType, OrderBy(..), CTabNgramType(..), url)
import Gargantext.Config.REST (get, put, post) import Gargantext.Config.REST (get, put, post)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -106,10 +106,11 @@ type PageParams = ...@@ -106,10 +106,11 @@ type PageParams =
, searchQuery :: String , searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all , termListFilter :: Maybe TermList -- Nothing means all
, termSizeFilter :: Maybe TermSize -- Nothing means all , termSizeFilter :: Maybe TermSize -- Nothing means all
, ends :: Ends
) )
initialPageParams :: Int -> Array Int -> TabType -> PageParams initialPageParams :: Ends -> Int -> Array Int -> TabType -> PageParams
initialPageParams nodeId listIds tabType = initialPageParams ends nodeId listIds tabType =
{ nodeId { nodeId
, listIds , listIds
, params: T.initialParams , params: T.initialParams
...@@ -117,6 +118,7 @@ initialPageParams nodeId listIds tabType = ...@@ -117,6 +118,7 @@ initialPageParams nodeId listIds tabType =
, termSizeFilter: Nothing , termSizeFilter: Nothing
, termListFilter: Just GraphTerm , termListFilter: Just GraphTerm
, searchQuery: "" , searchQuery: ""
, ends
} }
type NgramsTerm = String type NgramsTerm = String
...@@ -561,47 +563,48 @@ type CoreState s = ...@@ -561,47 +563,48 @@ type CoreState s =
| s | s
} }
postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit postNewNgrams :: forall s. Ends -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams newNgrams mayList {nodeId, listIds, tabType} = postNewNgrams ends newNgrams mayList {nodeId, listIds, tabType} =
when (not (A.null newNgrams)) $ do when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post (toUrl endConfigStateful Back (PutNgrams tabType (head listIds) mayList) $ Just nodeId) newNgrams (_ :: Array Unit) <- post (url ends put) newNgrams
pure unit pure unit
where put = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. NewElems -> CoreParams s -> Aff Unit postNewElems :: forall s. Ends -> NewElems -> CoreParams s -> Aff Unit
postNewElems newElems params = void $ traverseWithIndex postNewElem newElems postNewElems ends newElems params = void $ traverseWithIndex postNewElem newElems
where where
postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params postNewElem ngrams list = postNewNgrams ends [ngrams] (Just list) params
addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ntype ngrams list = { ngramsPatches: mempty addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ntype ngrams) list } , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: Ends -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches {nodeId, listIds, tabType} = putNgramsPatches ends {nodeId, listIds, tabType} = put $ url ends putNgrams
put (toUrl endConfigStateful Back (PutNgrams tabType (head listIds) Nothing) $ Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
commitPatch :: forall s. {nodeId :: Int, listIds :: Array Int, tabType :: TabType} commitPatch :: forall s. Ends -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
-> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit -> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
commitPatch props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do commitPatch ends props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
let pt = Versioned { version, data: ngramsPatches } let pt = Versioned { version, data: ngramsPatches }
lift $ postNewElems ngramsNewElems props lift $ postNewElems ends ngramsNewElems props
Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches props pt Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches ends props pt
modifyState_ $ \s -> modifyState_ $ \s ->
s { ngramsVersion = newVersion s { ngramsVersion = newVersion
, ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch , ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch
} }
-- TODO: check that pt.version == s.ngramsTablePatch.version -- TODO: check that pt.version == s.ngramsTablePatch.version
loadNgramsTable :: PageParams -> Aff VersionedNgramsTable loadNgramsTable :: Ends -> PageParams -> Aff VersionedNgramsTable
loadNgramsTable { nodeId, listIds, termListFilter, termSizeFilter loadNgramsTable ends
, searchQuery, tabType, params: {offset, limit, orderBy}} = { nodeId, listIds, termListFilter, termSizeFilter
get $ toUrl endConfigStateful Back , searchQuery, tabType, params: {offset, limit, orderBy}}
(GetNgrams { tabType, offset, limit, listIds = get $ url ends query
, orderBy: convOrderBy <$> orderBy where query = GetNgrams { tabType, offset, limit, listIds
, termListFilter, termSizeFilter , orderBy: convOrderBy <$> orderBy
, searchQuery , termListFilter, termSizeFilter
}) , searchQuery } (Just nodeId)
(Just nodeId)
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc
...@@ -609,10 +612,10 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc ...@@ -609,10 +612,10 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc convOrderBy (T.DESC _) = TermDesc
ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable ngramsLoaderClass :: Ends -> Loader.LoaderClass PageParams VersionedNgramsTable
ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable ngramsLoaderClass ends = Loader.createLoaderClass "NgramsTableLoader" (loadNgramsTable ends)
ngramsLoader :: Loader.Props' PageParams VersionedNgramsTable -> ReactElement ngramsLoader :: Ends -> Loader.Props' PageParams VersionedNgramsTable -> ReactElement
ngramsLoader props = React.createElement ngramsLoaderClass props [] ngramsLoader ends props = React.createElement (ngramsLoaderClass ends) props []
type LoadedNgramsTableProps = Loader.InnerProps PageParams VersionedNgramsTable () type LoadedNgramsTableProps = ( path :: PageParams, loaded :: VersionedNgramsTable )
src/Gargantext/Components/Search/Types.purs
View file @ 6cf771f9
...@@ -167,8 +167,8 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where ...@@ -167,8 +167,8 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> "ntc_category" := encodeJson post.category ~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject ~> jsonEmptyObject
categoryUrl :: Int -> String categoryUrl :: Ends -> Int -> String
categoryUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/category" categoryUrl ends nodeId = url ends (NodeAPI Node (Just nodeId)) <> "/category"
putCategories :: Int -> CategoryQuery -> Aff (Array Int) putCategories :: Ends -> Int -> CategoryQuery -> Aff (Array Int)
putCategories nodeId = put $ categoryUrl nodeId putCategories = put <<< categoryUrl
src/Gargantext/Components/Table.purs
View file @ 6cf771f9
...@@ -7,25 +7,25 @@ import Data.Maybe (Maybe(..), maybe) ...@@ -7,25 +7,25 @@ import Data.Maybe (Maybe(..), maybe)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import React (ReactElement, ReactClass, Children, createElement)
import React.DOM (a, b, b', p, i, h3, hr, div, option, select, span, table, tbody, td, text, th, thead, tr)
import React.DOM.Props (className, href, onChange, onClick, scope, selected, value, defaultValue, style)
import Thermite (PerformAction, Render, Spec, modifyState_, simpleSpec, StateCoTransformer, createClass)
type TableContainerProps = type TableContainerProps =
{ pageSizeControl :: ReactElement ( pageSizeControl :: R.Element
, pageSizeDescription :: ReactElement , pageSizeDescription :: R.Element
, paginationLinks :: ReactElement , paginationLinks :: R.Element
, tableHead :: ReactElement , tableHead :: R.Element
, tableBody :: Array ReactElement , tableBody :: Array R.Element
} )
type Rows = Array { row :: Array ReactElement type Row = { row :: Array R.Element, delete :: Boolean }
, delete :: Boolean type Rows = Array Row
}
type OrderBy = Maybe (OrderByDirection ColumnName) type OrderBy = Maybe (OrderByDirection ColumnName)
...@@ -52,250 +52,203 @@ instance showOrderByDirection :: Show a => Show (OrderByDirection a) where ...@@ -52,250 +52,203 @@ instance showOrderByDirection :: Show a => Show (OrderByDirection a) where
derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a) derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a)
type Props' = type Props =
( colNames :: Array ColumnName ( colNames :: Array ColumnName
, totalRecords :: Int , totalRecords :: Int
, setParams :: Params -> Effect Unit , setParams :: Params -> Effect Unit
, rows :: Rows , rows :: Rows
, container :: TableContainerProps -> Array ReactElement , container :: Record TableContainerProps -> R.Element
) )
type Props = Record Props'
type State = type State =
{ currentPage :: Int { page :: Int
, pageSize :: PageSizes , pageSize :: PageSizes
, orderBy :: OrderBy , orderBy :: OrderBy
} }
initialState :: State stateParams :: State -> Params
initialState = stateParams {pageSize, page, orderBy} = {offset, limit, orderBy}
{ currentPage : 1 where
, pageSize : PS10 limit = pageSizes2Int pageSize
, orderBy : Nothing offset = limit * (page - 1)
}
type TableHeaderLayoutProps =
( title :: String
, desc :: String
, query :: String
, date :: String
, user :: String
)
initialParams :: Params initialParams :: Params
initialParams = stateParams initialState initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing}
-- TODO: Not sure this is the right place for this
data Action
= ChangePageSize PageSizes tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element
| ChangePage Int tableHeaderLayout props = R.createElement tableHeaderLayoutCpt props []
| ChangeOrderBy OrderBy
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
type ChangePageAction = Int -> Effect Unit tableHeaderLayoutCpt = R.staticComponent "TableHeaderLayout" cpt
where
-- | Action cpt {title, desc, query, date, user} _ =
-- ChangePageSize R.fragment
changePageSize :: PageSizes -> State -> State [ H.div {className: "row"}
changePageSize ps td = [ H.div {className: "col-md-3"} [ H.h3 {} [H.text title] ]
td { pageSize = ps , H.div {className: "col-md-9"}
, currentPage = 1 [ H.hr {style: {height: "2px", backgroundColor: "black"}} ]
} ]
, H.div {className: "row"}
-- TODO: Not sure this is the right place for this function. [ H.div {className: "jumbotron1", style: {padding: "12px 0px 20px 12px"}}
renderTableHeaderLayout :: { title :: String [ H.div {className: "col-md-8 content"}
, desc :: String [ H.p {}
, query :: String [ H.i {className: "glyphicon glyphicon-globe"} []
, date :: String , H.text $ " " <> desc
, user :: String ]
} -> Array ReactElement , H.p {}
renderTableHeaderLayout {title, desc, query, date, user} = [ H.i {className: "glyphicon glyphicon-zoom-in"} []
[ div [className "row"] , H.text $ " " <> query
[ div [className "col-md-3"] [ h3 [] [text title] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "glyphicon glyphicon-globe"] []
, text $ " " <> desc
]
, p [] [ i [className "glyphicon glyphicon-zoom-in"] []
, text $ " " <> query
]
] ]
, div [ className "col-md-4 content"] ]
[ p [] [ i [className "glyphicon glyphicon-calendar"] [] , H.div {className: "col-md-4 content"}
, text $ " " <> date [ H.p {}
] [ H.i {className: "glyphicon glyphicon-calendar"} []
, p [] [ i [className "glyphicon glyphicon-user"] [] , H.text $ " " <> date
, text $ " " <> user
]
] ]
, H.p {}
[ H.i {className: "glyphicon glyphicon-user"} []
, H.text $ " " <> user
]
]
]
] ]
] ]
]
table :: Record Props -> R.Element
table props = R.createElement tableCpt props []
tableSpec :: Spec State Props Action tableCpt :: R.Component Props
tableSpec = simpleSpec performAction render tableCpt = R.hooksComponent "Table" cpt
where where
modifyStateAndReload :: (State -> State) -> Props -> State -> StateCoTransformer State Unit cpt {container, colNames, totalRecords, rows, setParams} _ = do
modifyStateAndReload f {setParams} state = do (pageSize /\ setPageSize) <- R.useState' PS10
--logs "modifyStateAndReload" -- TODO rename (page /\ setPage) <- R.useState' 1
modifyState_ f (orderBy /\ setOrderBy) <- R.useState' Nothing
liftEffect $ setParams $ stateParams $ f state let state = {pageSize, orderBy, page}
let ps = pageSizes2Int pageSize
performAction :: PerformAction State Props Action let totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
performAction (ChangePageSize ps) = R.useEffect1' state $ setParams (stateParams state)
modifyStateAndReload $ changePageSize ps pure $ container
performAction (ChangePage p) = { pageSizeControl: sizeDD pageSize setPageSize
modifyStateAndReload $ _ { currentPage = p } , pageSizeDescription: textDescription page pageSize totalRecords
performAction (ChangeOrderBy mc) = , paginationLinks: pagination setPage totalPages page
modifyStateAndReload $ _ { orderBy = mc } , tableHead: H.tr {} (colHeader setOrderBy orderBy <$> colNames)
, tableBody: map (H.tr {} <<< map (\c -> H.td {} [c]) <<< _.row) rows
renderColHeader :: (OrderBy -> Effect Unit) }
-> OrderBy colHeader :: (R2.Setter OrderBy) -> OrderBy -> ColumnName -> R.Element
-> ColumnName -> ReactElement colHeader setOrderBy currentOrderBy c = H.th {scope: "col"} [ H.b {} cs ]
renderColHeader changeOrderBy currentOrderBy c =
th [scope "col"] [ b' cs ]
where where
lnk mc = effectLink (changeOrderBy mc) lnk mc = effectLink (setOrderBy (const mc))
cs :: Array ReactElement cs :: Array R.Element
cs = cs =
case currentOrderBy of case currentOrderBy of
Just (ASC d) | c == d -> [lnk (Just (DESC c)) "DESC ", lnk Nothing (columnName c)] Just (ASC d) | c == d -> [lnk (Just (DESC c)) "DESC ", lnk Nothing (columnName c)]
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "ASC ", lnk Nothing (columnName c)] Just (DESC d) | c == d -> [lnk (Just (ASC c)) "ASC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)] _ -> [lnk (Just (ASC c)) (columnName c)]
render :: Render State Props Action defaultContainer :: {title :: String} -> Record TableContainerProps -> R.Element
render dispatch {container, colNames, totalRecords, rows} defaultContainer {title} props = R.fragment
{pageSize, currentPage, orderBy} _ = [ H.div {className: "row"}
container [ H.div {className: "col-md-4"} [ props.pageSizeDescription ]
{ pageSizeControl: sizeDD pageSize dispatch , H.div {className: "col-md-4"} [ props.paginationLinks ]
, pageSizeDescription: textDescription currentPage pageSize totalRecords , H.div {className: "col-md-4"} [ props.pageSizeControl ]
, paginationLinks: pagination (dispatch <<< ChangePage) totalPages currentPage
, tableHead:
tr [] (renderColHeader (dispatch <<< ChangeOrderBy) orderBy <$> colNames)
, tableBody:
map (tr [] <<< map (\c -> td [] [c]) <<< _.row) rows
}
where
ps = pageSizes2Int pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
defaultContainer :: {title :: String} -> TableContainerProps -> Array ReactElement
defaultContainer {title} props =
[ div [className "row"]
[ div [className "col-md-4"] [props.pageSizeDescription]
, div [className "col-md-4"] [props.paginationLinks]
, div [className "col-md-4"] [props.pageSizeControl]
] ]
, table [ className "table"] , H.table {className: "table"}
[ thead [className "thead-dark"] [ props.tableHead ] [ H.thead {className: "thead-dark"} [ props.tableHead ]
, tbody [] props.tableBody , H.tbody {} props.tableBody
] ]
] ]
-- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs -- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs
graphContainer :: {title :: String} -> TableContainerProps -> Array ReactElement graphContainer :: {title :: String} -> Record TableContainerProps -> R.Element
graphContainer {title} props = graphContainer {title} props =
[ -- TODO title in tabs name (above) -- TODO title in tabs name (above)
table [ className "table"] H.table {className: "table"}
[ thead [className "thead-dark"] [ props.tableHead ] [ H.thead {className: "thead-dark"} [ props.tableHead ]
, tbody [] props.tableBody , H.tbody {} props.tableBody
] ]
-- TODO better rendering of the paginationLinks -- TODO better rendering of the paginationLinks
-- , props.pageSizeControl -- , props.pageSizeControl
-- , props.pageSizeDescription -- , props.pageSizeDescription
-- , props.paginationLinks -- , props.paginationLinks
]
sizeDD :: PageSizes -> R2.Setter PageSizes -> R.Element
sizeDD ps setPageSize = H.span {} [ R2.select { className, on: {change} } sizes ]
stateParams :: State -> Params
stateParams {pageSize, currentPage, orderBy} = {offset, limit, orderBy}
where where
limit = pageSizes2Int pageSize className = "form-control"
offset = limit * (currentPage - 1) change e = setPageSize $ const (string2PageSize $ R2.unsafeEventValue e)
sizes = map (optps ps) pageSizes
paramsState :: Params -> State textDescription :: Int -> PageSizes -> Int -> R.Element
paramsState {offset, limit, orderBy} = {pageSize, currentPage, orderBy} textDescription currPage pageSize totalRecords =
H.div {className: "row1"} [ H.div {className: ""} [ H.text msg ] ] -- TODO or col-md-6 ?
where where
pageSize = string2PageSize $ show limit start = (currPage - 1) * pageSizes2Int pageSize + 1
currentPage = (offset / limit) + 1 end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
tableClass :: ReactClass {children :: Children | Props'} msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
tableClass = createClass "Table" tableSpec (const initialState)
effectLink :: Effect Unit -> String -> R.Element
tableElt :: Props -> ReactElement effectLink eff msg = H.a {on: {click: const eff}} [H.text msg]
tableElt props = createElement tableClass props []
pagination :: (R2.Setter Int) -> Int -> Int -> R.Element
tableEltWithInitialState :: State -> Props -> ReactElement pagination changePage tp cp =
tableEltWithInitialState state props = createElement tc props [] H.span {} $
where [ H.text " ", prev, first, ldots]
tc = createClass "Table" tableSpec (const state)
sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ select [ className "form-control"
, defaultValue $ show ps
, onChange $ \e -> d (ChangePageSize $ string2PageSize $ R2.unsafeEventValue e)
] $ map (optps ps) aryPS
]
textDescription :: Int -> PageSizes -> Int -> ReactElement
textDescription currPage pageSize totalRecords
= div [className "row1"]
[ div [className ""] -- TODO or col-md-6 ?
[ text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords ]
]
where
start = (currPage - 1) * pageSizes2Int pageSize + 1
end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
effectLink :: Effect Unit -> String -> ReactElement
effectLink eff msg = a [onClick $ const eff] [text msg]
pagination :: ChangePageAction -> Int -> Int -> ReactElement
pagination changePage tp cp
= span [] $
[ text " ", prev, first, ldots]
<> <>
lnums lnums
<> <>
[b' [text $ " " <> show cp <> " "]] [H.b {} [H.text $ " " <> show cp <> " "]]
<> <>
rnums rnums
<> <>
[ rdots, last, next ] [ rdots, last, next ]
where where
prev = if cp == 1 then prev = if cp == 1 then
text " Prev. " H.text " Prev. "
else else
changePageLink (cp - 1) "Prev." changePageLink (cp - 1) "Prev."
next = if cp == tp then next = if cp == tp then
text " Next " H.text " Next "
else else
changePageLink (cp + 1) "Next" changePageLink (cp + 1) "Next"
first = if cp == 1 then first = if cp == 1 then
text "" H.text ""
else else
changePageLink' 1 changePageLink' 1
last = if cp == tp then last = if cp == tp then
text "" H.text ""
else else
changePageLink' tp changePageLink' tp
ldots = if cp >= 5 then ldots = if cp >= 5 then
text " ... " H.text " ... "
else else
text "" H.text ""
rdots = if cp + 3 < tp then rdots = if cp + 3 < tp then
text " ... " H.text " ... "
else else
text "" H.text ""
lnums = map changePageLink' $ filter (1 < _) [cp - 2, cp - 1] lnums = map changePageLink' $ filter (1 < _) [cp - 2, cp - 1]
rnums = map changePageLink' $ filter (tp > _) [cp + 1, cp + 2] rnums = map changePageLink' $ filter (tp > _) [cp + 1, cp + 2]
changePageLink :: Int -> String -> ReactElement changePageLink :: Int -> String -> R.Element
changePageLink i s = span [] changePageLink i s =
[ text " " H.span {}
, effectLink (changePage i) s [ H.text " "
, text " " , effectLink (changePage (const i)) s
, H.text " "
] ]
changePageLink' :: Int -> ReactElement changePageLink' :: Int -> R.Element
changePageLink' i = changePageLink i (show i) changePageLink' i = changePageLink i (show i)
data PageSizes = PS10 | PS20 | PS50 | PS100 | PS200 data PageSizes = PS10 | PS20 | PS50 | PS100 | PS200
...@@ -316,8 +269,8 @@ pageSizes2Int PS50 = 50 ...@@ -316,8 +269,8 @@ pageSizes2Int PS50 = 50
pageSizes2Int PS100 = 100 pageSizes2Int PS100 = 100
pageSizes2Int PS200 = 200 pageSizes2Int PS200 = 200
aryPS :: Array PageSizes pageSizes :: Array PageSizes
aryPS = [PS10, PS20, PS50, PS100, PS200] pageSizes = [PS10, PS20, PS50, PS100, PS200]
string2PageSize :: String -> PageSizes string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10 string2PageSize "10" = PS10
...@@ -327,5 +280,5 @@ string2PageSize "100" = PS100 ...@@ -327,5 +280,5 @@ string2PageSize "100" = PS100
string2PageSize "200" = PS200 string2PageSize "200" = PS200
string2PageSize _ = PS10 string2PageSize _ = PS10
optps :: PageSizes -> PageSizes -> ReactElement optps :: PageSizes -> PageSizes -> R.Element
optps cv val = option [ value $ show val ] [text $ show val] optps cv val = H.option {selected: (cv == val), value: show val} [R2.showText val]
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