Commit a3757852 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-doc-annot-issue-213' of...

Merge branch 'dev-doc-annot-issue-213' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 3c761231 fbaa56ac
...@@ -11,7 +11,7 @@ import Data.Lens.At (at) ...@@ -11,7 +11,7 @@ import Data.Lens.At (at)
import Data.Lens.Record (prop) import Data.Lens.Record (prop)
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Ord.Down (Down(..)) import Data.Ord.Down (Down(..))
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set (Set) import Data.Set (Set)
...@@ -33,13 +33,14 @@ import Gargantext.Components.Nodes.Lists.Types as NT ...@@ -33,13 +33,14 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Utils.Seq (sortWith) as Seq import Gargantext.Utils (sortWith)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put) import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabSubType(..), TabType, showTabType') import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabSubType(..), TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
...@@ -76,6 +77,7 @@ type PageLayoutProps = ( ...@@ -76,6 +77,7 @@ type PageLayoutProps = (
cacheState :: R.State NT.CacheState cacheState :: R.State NT.CacheState
, corpusId :: Maybe Int , corpusId :: Maybe Int
, frontends :: Frontends , frontends :: Frontends
, key :: String -- NOTE Necessary to clear the component when cache state changes
, listId :: Int , listId :: Int
, nodeId :: Int , nodeId :: Int
, params :: T.Params , params :: T.Params
...@@ -216,6 +218,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where ...@@ -216,6 +218,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt where
[ pageLayout { cacheState [ pageLayout { cacheState
, corpusId , corpusId
, frontends , frontends
, key: "docView-" <> (show $ fst cacheState)
, listId , listId
, nodeId , nodeId
, params , params
...@@ -324,7 +327,7 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where ...@@ -324,7 +327,7 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
--Tuple 0 (take limit $ drop offset sampleData) --Tuple 0 (take limit $ drop offset sampleData)
Tuple 0 sampleData Tuple 0 sampleData
else else
Tuple (A.length docs) docs Tuple res.count docs
case cacheState of case cacheState of
(NT.CacheOn /\ _) -> do (NT.CacheOn /\ _) -> do
let paint (Tuple count docs) = page params (props { totalRecords = count }) docs let paint (Tuple count docs) = page params (props { totalRecords = count }) docs
...@@ -340,13 +343,16 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where ...@@ -340,13 +343,16 @@ pageLayoutCpt = R.hooksComponentWithModule thisModule "pageLayout" cpt where
, renderer: paint , renderer: paint
} }
(NT.CacheOff /\ _) -> do (NT.CacheOff /\ _) -> do
localCategories <- R.useState' (mempty :: LocalCategories)
paramsS <- R.useState' params paramsS <- R.useState' params
let loader p@{ listId, nodeId, tabType } = do let loader p@{ listId, nodeId, tabType } = do
res <- get session $ tableRouteWithPage { listId, nodeId, params: fst paramsS, tabType } res <- get session $ tableRouteWithPage { listId, nodeId, params: fst paramsS, query, tabType }
pure $ handleResponse res pure $ handleResponse res
render (Tuple count documents) = pagePaint { documents render (Tuple count documents) = pagePaintRaw { documents
, layout: props { totalRecords = count } , layout: props { params = fst paramsS
, params: paramsS } , totalRecords = count }
, localCategories
, params: paramsS }
useLoader (path { params = fst paramsS }) loader render useLoader (path { params = fst paramsS }) loader render
type PageProps = ( type PageProps = (
...@@ -375,8 +381,38 @@ pagePaint props = R.createElement pagePaintCpt props [] ...@@ -375,8 +381,38 @@ pagePaint props = R.createElement pagePaintCpt props []
pagePaintCpt :: R.Component PagePaintProps pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt where pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt where
cpt { layout: { corpusId, frontends, listId, nodeId, session, totalRecords }, documents, params } _ = do cpt { documents, layout, params } _ = do
localCategories <- R.useState' (mempty :: LocalCategories) localCategories <- R.useState' (mempty :: LocalCategories)
pure $ pagePaintRaw { documents: A.fromFoldable filteredRows, layout, localCategories, params }
where
orderWith =
case convOrderBy (fst params).orderBy of
Just DateAsc -> sortWith \(DocumentsView { date }) -> date
Just DateDesc -> sortWith \(DocumentsView { date }) -> Down date
Just SourceAsc -> sortWith \(DocumentsView { source }) -> Str.toLower source
Just SourceDesc -> sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
Just TitleAsc -> sortWith \(DocumentsView { title }) -> Str.toLower title
Just TitleDesc -> sortWith \(DocumentsView { title }) -> Down $ Str.toLower title
_ -> identity -- the server ordering is enough here
filteredRows = T.filterRows { params: fst params } $ orderWith $ A.toUnfoldable documents
type PagePaintRawProps = (
documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, localCategories :: R.State LocalCategories
, params :: R.State T.Params
)
pagePaintRaw :: Record PagePaintRawProps -> R.Element
pagePaintRaw props = R.createElement pagePaintRawCpt props []
pagePaintRawCpt :: R.Component PagePaintRawProps
pagePaintRawCpt = R.hooksComponentWithModule thisModule "pagePaintRawCpt" cpt where
cpt { documents
, layout: { corpusId, frontends, listId, nodeId, session, totalRecords }
, localCategories
, params } _ = do
pure $ T.table pure $ T.table
{ colNames { colNames
, container: T.defaultContainer { title: "Documents" } , container: T.defaultContainer { title: "Documents" }
...@@ -397,17 +433,7 @@ pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt where ...@@ -397,17 +433,7 @@ pagePaintCpt = R.hooksComponentWithModule thisModule "pagePaintCpt" cpt where
colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"] colNames = T.ColumnName <$> [ "Tag", "Date", "Title", "Source"]
wrapColElts = const identity wrapColElts = const identity
getCategory (localCategories /\ _) {_id, category} = fromMaybe category (localCategories ^. at _id) getCategory (localCategories /\ _) {_id, category} = fromMaybe category (localCategories ^. at _id)
orderWith = rows localCategories = row <$> A.toUnfoldable documents
case convOrderBy (fst params).orderBy of
Just DateAsc -> Seq.sortWith \(DocumentsView { date }) -> date
Just DateDesc -> Seq.sortWith \(DocumentsView { date }) -> Down date
Just SourceAsc -> Seq.sortWith \(DocumentsView { source }) -> Str.toLower source
Just SourceDesc -> Seq.sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
Just TitleAsc -> Seq.sortWith \(DocumentsView { title }) -> Str.toLower title
Just TitleDesc -> Seq.sortWith \(DocumentsView { title }) -> Down $ Str.toLower title
_ -> identity -- the server ordering is enough here
filteredRows = T.filterRows { params: fst params } $ orderWith $ A.toUnfoldable documents
rows localCategories = row <$> filteredRows
where where
row (DocumentsView r) = row (DocumentsView r) =
{ row: { row:
...@@ -476,8 +502,18 @@ tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?t ...@@ -476,8 +502,18 @@ tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?t
tableRouteWithPage :: { listId :: Int tableRouteWithPage :: { listId :: Int
, nodeId :: Int , nodeId :: Int
, params :: T.Params , params :: T.Params
, query :: Query
, tabType :: TabType } -> SessionRoute , tabType :: TabType } -> SessionRoute
tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, tabType } = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId) <> "&limit=" <> (show limit) <> "&offset=" <> (show offset) <> "&orderBy=" <> (show orderBy) <> "&searchType=" <> (show searchType) tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType } =
NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q]
where
lmt = queryParam "limit" limit
lst = queryParam "list" listId
ofs = queryParam "offset" offset
odb = mQueryParamS "orderBy" T.orderByToForm orderBy
st = queryParam "searchType" searchType
tt = queryParamS "tabType" (showTabType' tabType)
q = queryParamS "query" query
deleteAllDocuments :: Session -> Int -> Aff (Array Int) deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments session = delete session <<< documentsRoute deleteAllDocuments session = delete session <<< documentsRoute
......
...@@ -42,7 +42,7 @@ import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map ...@@ -42,7 +42,7 @@ import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map
import Gargantext.Routes (SessionRoute(..)) as R import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes) import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet) import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Seq as Seq import Gargantext.Utils.Seq as Seq
...@@ -423,10 +423,10 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -423,10 +423,10 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
} }
orderWith = orderWith =
case convOrderBy <$> params.orderBy of case convOrderBy <$> params.orderBy of
Just ScoreAsc -> Seq.sortWith \x -> x ^. _NgramsElement <<< _occurrences Just ScoreAsc -> sortWith \x -> x ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> Seq.sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences Just ScoreDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences
Just TermAsc -> Seq.sortWith \x -> x ^. _NgramsElement <<< _ngrams Just TermAsc -> sortWith \x -> x ^. _NgramsElement <<< _ngrams
Just TermDesc -> Seq.sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams Just TermDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams
_ -> identity -- the server ordering is enough here _ -> identity -- the server ordering is enough here
colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy colNames = T.ColumnName <$> ["Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
......
...@@ -33,7 +33,7 @@ module Gargantext.Components.NgramsTable.Core ...@@ -33,7 +33,7 @@ module Gargantext.Components.NgramsTable.Core
, _PatchMap , _PatchMap
, patchSetFromMap , patchSetFromMap
, applyPatchSet , applyPatchSet
, applyNgramsTablePatch --, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches
, applyNgramsPatches , applyNgramsPatches
, rootsOf , rootsOf
, singletonPatchMap , singletonPatchMap
...@@ -501,7 +501,7 @@ derive instance eqReplace :: Eq a => Eq (Replace a) ...@@ -501,7 +501,7 @@ derive instance eqReplace :: Eq a => Eq (Replace a)
instance semigroupReplace :: Eq a => Semigroup (Replace a) where instance semigroupReplace :: Eq a => Semigroup (Replace a) where
append Keep p = p append Keep p = p
append p Keep = p append p Keep = p
-- append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new" append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { new }) (Replace { old }) = replace old new append (Replace { new }) (Replace { old }) = replace old new
instance semigroupMonoid :: Eq a => Monoid (Replace a) where instance semigroupMonoid :: Eq a => Monoid (Replace a) where
...@@ -597,7 +597,9 @@ invert :: forall a. a -> a ...@@ -597,7 +597,9 @@ invert :: forall a. a -> a
invert _ = unsafeThrow "invert: TODO" invert _ = unsafeThrow "invert: TODO"
instance semigroupNgramsPatch :: Semigroup NgramsPatch where instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsReplace p) (NgramsReplace q) = ngramsReplace q.patch_old p.patch_new append (NgramsReplace p) (NgramsReplace q)
| p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
| otherwise = ngramsReplace q.patch_old p.patch_new
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children { patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list , patch_list: p.patch_list <> q.patch_list
......
...@@ -98,6 +98,7 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt ...@@ -98,6 +98,7 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
, cacheState , cacheState
, date , date
, desc: name , desc: name
, key: "annuaire-" <> (show $ fst cacheState)
, query: "" , query: ""
, title: name , title: name
, user: "" } , user: "" }
......
...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) ...@@ -4,6 +4,7 @@ import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
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(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -18,7 +19,7 @@ import Gargantext.Components.Node (NodePoly(..)) ...@@ -18,7 +19,7 @@ import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Document.Types import Gargantext.Components.Nodes.Corpus.Document.Types
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) ( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
, VersionedNgramsTable, addNewNgram, applyNgramsTablePatch, commitPatch , VersionedNgramsTable, addNewNgram, applyNgramsPatches, commitPatch
, loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches ) , loadNgramsTable, replace, singletonNgramsTablePatch, syncPatches )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
...@@ -59,7 +60,10 @@ docView props = R.createElement docViewCpt props [] ...@@ -59,7 +60,10 @@ docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component DocViewProps docViewCpt :: R.Component DocViewProps
docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where where
cpt props@{ loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }, state } _ = do cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state: state@({ ngramsVersion: version } /\ _)
} _children = do
pure $ H.div {} [ pure $ H.div {} [
autoUpdate { duration: 3000, effect: dispatch Synchronize } autoUpdate { duration: 3000, effect: dispatch Synchronize }
, H.div { className: "container1" } , H.div { className: "container1" }
...@@ -67,7 +71,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -67,7 +71,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
R2.row R2.row
[ [
R2.col 8 R2.col 8
[ H.h4 {} [ annotate state doc.title ] [ H.h4 {} [ annotate doc.title ]
, H.ul { className: "list-group" } , H.ul { className: "list-group" }
[ li' [ H.span {} [ text' doc.source ] [ li' [ H.span {} [ text' doc.source ]
, badge "source" , badge "source"
...@@ -81,7 +85,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -81,7 +85,7 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
] ]
] ]
, badge "abstract" , badge "abstract"
, annotate state doc.abstract , annotate doc.abstract
, H.div { className: "jumbotron" } , H.div { className: "jumbotron" }
[ H.p {} [ H.text "Empty Full Text" ] [ H.p {} [ H.text "Empty Full Text" ]
] ]
...@@ -92,29 +96,24 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt ...@@ -92,29 +96,24 @@ docViewCpt = R.hooksComponentWithModule thisModule "docView" cpt
where where
dispatch :: Action -> Effect Unit dispatch :: Action -> Effect Unit
dispatch (AddNewNgram ngram termList) = do dispatch (AddNewNgram ngram termList) = do
commitPatch (Versioned {version, data: pt}) state commitPatch (Versioned {version, data: addNewNgram ngram termList}) state
where
({ ngramsVersion: version } /\ _) = state
pt = addNewNgram ngram termList
dispatch (SetTermListItem ngram termList) = do dispatch (SetTermListItem ngram termList) = do
commitPatch (Versioned {version, data: pt}) state commitPatch (Versioned {version, data: pt}) state
where where
({ ngramsVersion: version } /\ _) = state
pe = NgramsPatch { patch_list: termList, patch_children: mempty } pe = NgramsPatch { patch_list: termList, patch_children: mempty }
pt = singletonNgramsTablePatch ngram pe pt = singletonNgramsTablePatch ngram pe
dispatch Synchronize = do dispatch Synchronize = do
syncPatches props.path props.state (\_ -> pure unit) syncPatches path state (\_ -> pure unit)
ngrams = applyNgramsPatches (fst state) initTable
annotate state text = AnnotatedField.annotatedField { ngrams: ngramsTable state annotate text = AnnotatedField.annotatedField { ngrams
, setTermList: setTermList state , setTermList
, text } , text }
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ] badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
li' = H.li { className: "list-group-item justify-content-between" } li' = H.li { className: "list-group-item justify-content-between" }
ngramsTable ({ ngramsLocalPatch, ngramsValidPatch } /\ _) = applyNgramsTablePatch (ngramsLocalPatch <> ngramsValidPatch) initTable setTermList ngram Nothing newList = dispatch (AddNewNgram ngram newList)
setTermList state ngram Nothing newList = dispatch (AddNewNgram ngram newList) setTermList ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
setTermList state ngram (Just oldList) newList = dispatch (SetTermListItem ngram (replace oldList newList))
text' x = H.text $ fromMaybe "Nothing" x text' x = H.text $ fromMaybe "Nothing" x
NodePoly {hyperdata : Document doc} = document NodePoly {hyperdata: Document doc} = document
type LayoutProps = ( type LayoutProps = (
corpusId :: Maybe Int corpusId :: Maybe Int
......
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import Data.Tuple (fst)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Reactix as R import Reactix as R
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -50,7 +51,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe ...@@ -50,7 +51,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
cpt { nodeId, session } _ = do cpt { nodeId, session } _ = do
let path = { nodeId, session } let path = { nodeId, session }
cacheState <- R.useState' NT.CacheOff cacheState <- R.useState' NT.CacheOn
useLoader path loadCorpusWithChild $ useLoader path loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } -> \corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
...@@ -63,6 +64,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe ...@@ -63,6 +64,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
, cacheState , cacheState
, date , date
, desc , desc
, key: "listsLayoutWithKey-header-" <> (show $ fst cacheState)
, query , query
, title: "Corpus " <> name , title: "Corpus " <> name
, user: authors } , user: authors }
...@@ -70,6 +72,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe ...@@ -70,6 +72,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
cacheState cacheState
, corpusData , corpusData
, corpusId , corpusId
, key: "listsLayoutWithKey-tabs-" <> (show $ fst cacheState)
, session } , session }
] ]
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -33,10 +33,15 @@ type Props = ( cacheState :: R.State NTypes.CacheState ...@@ -33,10 +33,15 @@ type Props = ( cacheState :: R.State NTypes.CacheState
, session :: Session , session :: Session
) )
tabs :: Record Props -> R.Element type PropsWithKey = (
key :: String
| Props
)
tabs :: Record PropsWithKey -> R.Element
tabs props = R.createElement tabsCpt props [] tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props tabsCpt :: R.Component PropsWithKey
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where where
cpt { cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do cpt { cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
......
...@@ -2,6 +2,7 @@ module Gargantext.Components.Nodes.Lists.Types where ...@@ -2,6 +2,7 @@ module Gargantext.Components.Nodes.Lists.Types where
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -12,3 +13,5 @@ data CacheState = CacheOn | CacheOff ...@@ -12,3 +13,5 @@ data CacheState = CacheOn | CacheOff
derive instance genericCacheState :: Generic CacheState _ derive instance genericCacheState :: Generic CacheState _
instance eqCacheState :: Eq CacheState where instance eqCacheState :: Eq CacheState where
eq = genericEq eq = genericEq
instance showCacheState :: Show CacheState where
show = genericShow
...@@ -4,6 +4,7 @@ import Prelude ...@@ -4,6 +4,7 @@ import Prelude
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(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Reactix as R import Reactix as R
...@@ -69,6 +70,7 @@ textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKe ...@@ -69,6 +70,7 @@ textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKe
, cacheState , cacheState
, date , date
, desc , desc
, key: "textsLayoutWithKey-" <> (show $ fst cacheState)
, query , query
, title , title
, user: authors } , user: authors }
......
...@@ -61,6 +61,10 @@ instance showOrderByDirection :: Show a => Show (OrderByDirection a) where ...@@ -61,6 +61,10 @@ instance showOrderByDirection :: Show a => Show (OrderByDirection a) where
derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a) derive instance eqOrderByDirection :: Eq a => Eq (OrderByDirection a)
orderByToForm :: OrderByDirection ColumnName -> String
orderByToForm (ASC (ColumnName x)) = x <> "Asc"
orderByToForm (DESC (ColumnName x)) = x <> "Desc"
type Props = type Props =
( colNames :: Array ColumnName ( colNames :: Array ColumnName
, container :: Record TableContainerProps -> R.Element , container :: Record TableContainerProps -> R.Element
...@@ -95,6 +99,7 @@ type TableHeaderLayoutProps = ...@@ -95,6 +99,7 @@ type TableHeaderLayoutProps =
, cacheState :: R.State NT.CacheState , cacheState :: R.State NT.CacheState
, date :: String , date :: String
, desc :: String , desc :: String
, key :: String
, query :: String , query :: String
, title :: String , title :: String
, user :: String , user :: String
......
...@@ -2,13 +2,15 @@ module Gargantext.Utils where ...@@ -2,13 +2,15 @@ module Gargantext.Utils where
import DOM.Simple.Window (window) import DOM.Simple.Window (window)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldr)
import Data.Lens (Lens', lens) import Data.Lens (Lens', lens)
import Data.Newtype (class Newtype, unwrap, wrap) import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
import Data.Sequence.Ordered as OSeq
import Data.String as S import Data.String as S
import Data.Unfoldable (class Unfoldable)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import FFI.Simple ((..)) import FFI.Simple ((..))
import FFI.Simple.Functions (delay) import FFI.Simple.Functions (delay)
import Prelude import Prelude
...@@ -84,5 +86,19 @@ mapLeft _ (Right r) = Right r ...@@ -84,5 +86,19 @@ mapLeft _ (Right r) = Right r
location :: Effect String location :: Effect String
location = delay unit $ \_ -> pure $ window .. "location" location = delay unit $ \_ -> pure $ window .. "location"
data On a b = On a b
instance eqOn :: Eq a => Eq (On a b) where
eq (On x _) (On y _) = eq x y
instance ordOn :: Ord a => Ord (On a b) where
compare (On x _) (On y _) = compare x y
-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b f. Functor f =>
Foldable f =>
Unfoldable f =>
Ord b =>
(a -> b) -> f a -> f a
sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
\ No newline at end of file
module Gargantext.Utils.QueryString where
import Data.Array
import Data.Maybe
import Data.String.Common (joinWith)
import Gargantext.Prelude
queryParam :: forall a. Show a => String -> a -> String
queryParam key value = key <> "=" <> show value
queryParamS :: String -> String -> String
queryParamS key value = key <> "=" <> value
mQueryParam :: forall a. Show a => String -> Maybe a -> String
mQueryParam _ Nothing = ""
mQueryParam key (Just v) = queryParam key v
mQueryParamS :: forall a. String -> (a -> String) -> Maybe a -> String
mQueryParamS _ _ Nothing = ""
mQueryParamS key mFunc (Just v) = queryParamS key $ mFunc v
joinQueryStrings :: Array String -> String
joinQueryStrings qs =
case uncons qs of
Nothing -> ""
Just { head, tail } -> "?" <> head <> (joinQS tail)
where
joinQS ys =
case uncons ys of
Nothing -> ""
Just { tail: ys } -> "&" <> (joinWith "&" ys)
module Gargantext.Utils.Seq where module Gargantext.Utils.Seq (mapMaybe) where
import Data.Array as Array import Data.Maybe (Maybe, maybe)
import Data.Maybe import Data.Sequence (Seq, concatMap, empty, singleton)
import Data.Sequence
import Data.Tuple
import Gargantext.Prelude import Gargantext.Prelude ((<<<))
mapMaybe :: forall a b. (a -> Maybe b) -> Seq a -> Seq b mapMaybe :: forall a b. (a -> Maybe b) -> Seq a -> Seq b
mapMaybe f = go empty mapMaybe f = concatMap (maybe empty singleton <<< f)
where
go acc s =
case uncons s of
Nothing -> acc
Just (Tuple x xs) ->
case f x of
Nothing -> go acc xs
Just y -> go (cons y acc) xs
-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b. Ord b => (a -> b) -> Seq a -> Seq a
sortWith f l = Array.toUnfoldable $ Array.sortBy (comparing f) $ Array.fromFoldable l
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