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

Merge branch 'lists-ngramstable' of...

Merge branch 'lists-ngramstable' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 3ae4e5d5 ab44b6b4
......@@ -3,17 +3,13 @@ module Gargantext.Components.NgramsTable
, mainNgramsTable
) where
import Prelude
( class Show, Unit, bind, const, discard, identity, map, mempty, not
, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<)
, (==), (||), otherwise, when )
import Data.Array as A
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, view, (%~), (.~), (^.), (^..), (^?))
import Data.Lens.Common (_Just)
import Data.Lens.At (at)
import Data.Lens.Index (ix)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.Lens.Record (prop)
import Data.List as List
import Data.Map (Map)
......@@ -27,33 +23,24 @@ import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import React (ReactClass, ReactElement, Children)
import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props ( _type, checked, className, onChange, onClick, style
, readOnly)
import React.DOM.Props as DOM
import Thermite as Thermite
import Thermite (modifyState_)
import Gargantext.Types
( CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList
, readTermSize, termLists, termSizes)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsElement(..), NgramsPatch(..), NgramsTablePatch, _PatchMap
, NgramsTable, NgramsTerm, PageParams, Replace, Versioned(..)
, VersionedNgramsTable, _NgramsElement, _NgramsTable, _children
, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches
, applyPatchSet, commitPatch, syncPatches, convOrderBy, initialPageParams, loadNgramsTable
, patchSetFromMap, replace, singletonNgramsTablePatch
, normNgram, ngramsTermText, fromNgramsPatches, PatchMap(..), rootsOf )
import Gargantext.Components.Loader (loader)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (CoreState, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, PageParams, PatchMap(..), Replace, Versioned(..), VersionedNgramsTable, _NgramsElement, _NgramsTable, _PatchMap, _children, _list, _ngrams, _occurrences, _root, addNewNgram, applyNgramsPatches, applyPatchSet, commitPatch, convOrderBy, fromNgramsPatches, initialPageParams, loadNgramsTableAll, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncPatches)
import Gargantext.Components.Table as T
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, OrderBy(..), TabType, TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (+), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), otherwise, when)
import React (ReactClass, ReactElement, Children)
import React.DOM (a, i, input, li, span, text, ul)
import React.DOM.Props (_type, checked, className, onChange, onClick, style, readOnly)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (modifyState_)
import Thermite as Thermite
import Unsafe.Coerce (unsafeCoerce)
type State =
......@@ -427,7 +414,11 @@ mainNgramsTableCpt = R.hooksComponent "MainNgramsTable" cpt
cpt {nodeId, defaultListId, tabType, session, tabNgramType} _ = do
path /\ setPath <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
let paint versioned = loadedNgramsTable' {tabNgramType, path: path /\ setPath, versioned}
pure $ loader path loadNgramsTable paint
pure $ loader path loadNgramsTableAll \loaded -> do
case Map.lookup tabType loaded of
Just (versioned :: VersionedNgramsTable) -> paint versioned
Nothing -> loadingSpinner {}
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
......
......@@ -21,6 +21,7 @@ module Gargantext.Components.NgramsTable.Core
, highlightNgrams
, initialPageParams
, loadNgramsTable
, loadNgramsTableAll
, convOrderBy
, Replace(..) -- Ideally we should keep the constructors hidden
, replace
......@@ -50,50 +51,48 @@ module Gargantext.Components.NgramsTable.Core
where
import Prelude
import Control.Monad.State (class MonadState, execState)
import Control.Monad.Cont.Trans (lift)
import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (.:!), (:=), (~>))
import Data.Array (head)
import Data.Array as A
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson
, jsonEmptyObject, (:=), (~>), (.:), (.:!) )
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Newtype (class Newtype)
import Data.Lens (Iso', Lens', use, view, (%=), (.~), (?=), (^?))
import Data.Lens.Common (_Just)
import Data.Lens.At (class At, at)
import Data.Lens.Index (class Index, ix)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded, traverseOf_)
import Data.Lens.Record (prop)
import Data.Lens.Index (class Index, ix)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.List ((:), List(Nil))
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, isNothing)
import Data.Traversable (class Traversable, traverse, traverse_, sequence)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Maybe (Maybe(..), isNothing, maybe)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
import Data.String.Regex (Regex, regex, replace) as R
import Data.String.Regex.Flags (global, multiline) as R
import Data.Symbol (SProxy(..))
import Data.Traversable (class Traversable, for, sequence, traverse, traverse_)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Tuple (Tuple(..))
-- import Debug.Trace
import Effect.Aff (Aff)
import Foreign.Object as FO
import Thermite (StateCoTransformer, modifyState_)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put, post)
import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize, ScoreType(..))
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Thermite (StateCoTransformer, modifyState_)
type CoreParams s =
{ nodeId :: Int
......@@ -667,6 +666,24 @@ loadNgramsTable
, termListFilter, termSizeFilter
, searchQuery, scoreType } (Just nodeId)
type NgramsListByTabType = Map TabType VersionedNgramsTable
loadNgramsTableAll :: PageParams -> Aff NgramsListByTabType
loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
let
cTagNgramTypes =
[ CTabTerms
, CTabSources
, CTabAuthors
, CTabInstitutes
]
query tabType = GetNgramsTableAll { tabType, listIds, scoreType } (Just nodeId)
Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do
let tabType = TabCorpus $ TabNgramType cTagNgramType
result :: VersionedNgramsTable <- get session $ query tabType
pure $ Tuple tabType result
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
......
......@@ -136,8 +136,15 @@ sessionPath (R.GetNgrams opts i) =
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
search s = "&search=" <> s
sessionPath (R.GetNgramsTableAll opts i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams?ngramsType="
<> showTabType' opts.tabType
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> limitUrl 100000
sessionPath (R.ListDocument lId dId) =
sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId))
sessionPath (R.ListsRoute lId) = "lists/" <> show lId
sessionPath (R.PutNgrams t listId termList i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams?ngramsType="
......
module Gargantext.Routes where
import Prelude
import Data.Maybe (Maybe)
import Gargantext.Types (ChartOpts, CorpusMetricOpts, Id, Limit, ListId, NgramsGetOpts, NodeType, Offset, OrderBy, SearchOpts, SessionId, TabType, TermList)
import Gargantext.Types (ChartOpts, CorpusMetricOpts, Id, Limit, ListId, NgramsGetOpts, NodeType, Offset, OrderBy, SearchOpts, SessionId, TabType, TermList, NgramsGetTableAllOpts)
data AppRoute
= Home
......@@ -32,9 +33,11 @@ data SessionRoute
= Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id)
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id) String
| ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
......
module Gargantext.Types where
import Prelude
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
......@@ -10,7 +11,6 @@ import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple)
import Effect.Aff (Aff)
import Prim.Row (class Union)
import URI.Query (Query)
......@@ -299,6 +299,12 @@ type NgramsGetOpts =
, searchQuery :: String
}
type NgramsGetTableAllOpts =
{ tabType :: TabType
, listIds :: Array ListId
, scoreType :: ScoreType
}
type SearchOpts =
{ {-id :: Int
, query :: Array String
......@@ -380,6 +386,7 @@ instance decodeJsonApiVersion :: DecodeJson ApiVersion where
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance eqCTabNgramType :: Eq CTabNgramType
derive instance ordCTabNgramType :: Ord CTabNgramType
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
......@@ -390,6 +397,7 @@ instance showCTabNgramType :: Show CTabNgramType where
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance eqPTabNgramType :: Eq PTabNgramType
derive instance ordPTabNgramType :: Ord PTabNgramType
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
......@@ -399,6 +407,7 @@ instance showPTabNgramType :: Show PTabNgramType where
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
instance showTabSubType :: Show a => Show (TabSubType a) where
show TabDocs = "Docs"
......@@ -413,6 +422,7 @@ data TabType
| TabDocument (TabSubType CTabNgramType)
derive instance eqTabType :: Eq TabType
derive instance ordTabType :: Ord TabType
derive instance genericTabType :: Generic TabType _
......@@ -426,6 +436,15 @@ data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
decodeMode :: String -> Either String Mode
decodeMode tag =
case tag of
"Authors" -> Right Authors
"Institutes" -> Right Institutes
"Sources" -> Right Sources
"NgramsTerms" -> Right Terms
_ -> Left $ "Error decoding mode: unknown tag '" <> tag <> "'"
instance showMode :: Show Mode where
show = genericShow
......
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