Commit 01a30b1e authored by Alexandre Delanoë's avatar Alexandre Delanoë

[NgramsTab] fix norm according type of Ngrams.

parent 8e724e56
...@@ -26,6 +26,7 @@ import Reactix as R ...@@ -26,6 +26,7 @@ import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Gargantext.Config (CTabNgramType(..))
import Gargantext.Types ( TermList ) import Gargantext.Types ( TermList )
import Gargantext.Components.Annotation.Utils ( termBootstrapClass ) import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams, findNgramTermList ) import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams, findNgramTermList )
...@@ -80,7 +81,7 @@ maybeShowMenu setMenu setTermList ngrams event = do ...@@ -80,7 +81,7 @@ maybeShowMenu setMenu setTermList ngrams event = do
sel' -> do sel' -> do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
list = findNgramTermList ngrams sel' list = findNgramTermList CTabTerms ngrams sel'
setList t = do setList t = do
setTermList sel' list t setTermList sel' list t
setMenu (const Nothing) setMenu (const Nothing)
...@@ -97,7 +98,7 @@ maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e ...@@ -97,7 +98,7 @@ maybeAddMenu setMenu e (Just props) = annotationMenu setMenu props <> e
maybeAddMenu _ e _ = e maybeAddMenu _ e _ = e
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList)) compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams ngrams) compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
......
...@@ -34,7 +34,7 @@ import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_ ...@@ -34,7 +34,7 @@ import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes) import Gargantext.Types (TermList(..), readTermList, readTermSize, termLists, termSizes)
import Gargantext.Config (OrderBy(..), TabType) import Gargantext.Config (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
...@@ -197,8 +197,8 @@ toggleMap :: forall a. a -> Maybe a -> Maybe a ...@@ -197,8 +197,8 @@ 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 :: Spec State LoadedNgramsTableProps Action ngramsTableSpec :: CTabNgramType -> Spec State LoadedNgramsTableProps Action
ngramsTableSpec = simpleSpec performAction render ngramsTableSpec ntype = 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 }
...@@ -214,7 +214,7 @@ ngramsTableSpec = simpleSpec performAction render ...@@ -214,7 +214,7 @@ ngramsTableSpec = simpleSpec performAction render
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch {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 n pe pt = singletonNgramsTablePatch ntype n pe
performAction AddTermChildren _ {ngramsParent: Nothing} = performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless -- impossible but harmless
pure unit pure unit
...@@ -228,11 +228,11 @@ ngramsTableSpec = simpleSpec performAction render ...@@ -228,11 +228,11 @@ ngramsTableSpec = simpleSpec performAction render
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 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 {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram ngram CandidateTerm pt = addNewNgram ntype ngram CandidateTerm
render :: Render State LoadedNgramsTableProps Action render :: Render State LoadedNgramsTableProps Action
render dispatch { path: pageParams render dispatch { path: pageParams
...@@ -292,8 +292,8 @@ ngramsTableSpec = simpleSpec performAction render ...@@ -292,8 +292,8 @@ ngramsTableSpec = simpleSpec performAction render
, delete: false , delete: false
} }
ngramsTableClass :: Loader.InnerClass PageParams VersionedNgramsTable ngramsTableClass :: CTabNgramType -> Loader.InnerClass PageParams VersionedNgramsTable
ngramsTableClass = createClass "NgramsTable" ngramsTableSpec initialState ngramsTableClass ct = createClass "NgramsTable" (ngramsTableSpec ct) initialState
type MainNgramsTableProps = type MainNgramsTableProps =
{ nodeId :: Int { nodeId :: Int
...@@ -302,14 +302,14 @@ type MainNgramsTableProps = ...@@ -302,14 +302,14 @@ type MainNgramsTableProps =
, tabType :: TabType , tabType :: TabType
} }
mainNgramsTableSpec :: Spec {} MainNgramsTableProps Void mainNgramsTableSpec :: CTabNgramType -> Spec {} MainNgramsTableProps Void
mainNgramsTableSpec = simpleSpec defaultPerformAction render mainNgramsTableSpec nt = simpleSpec defaultPerformAction render
where where
render :: Render {} MainNgramsTableProps Void render :: Render {} MainNgramsTableProps Void
render _ {nodeId, defaultListId, tabType} _ _ = render _ {nodeId, defaultListId, tabType} _ _ =
[ ngramsLoader [ ngramsLoader
{ path: initialPageParams nodeId [defaultListId] tabType { path: initialPageParams nodeId [defaultListId] tabType
, component: ngramsTableClass , component: (ngramsTableClass nt)
} ] } ]
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int} type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
......
...@@ -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, End(..), Path(..), TabType, OrderBy(..)) import Gargantext.Config (toUrl, End(..), Path(..), TabType, OrderBy(..), CTabNgramType(..))
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
...@@ -224,8 +224,8 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global < ...@@ -224,8 +224,8 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
-- TODO: while this function works well with word boundaries, -- TODO: while this function works well with word boundaries,
-- it inserts too many spaces. -- it inserts too many spaces.
highlightNgrams :: NgramsTable -> String -> Array (Tuple String (Maybe TermList)) highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array (Tuple String (Maybe TermList))
highlightNgrams (NgramsTable table) input0 = highlightNgrams ntype (NgramsTable table) input0 =
-- trace {pats, input0, input, ixs} \_ -> -- trace {pats, input0, input, ixs} \_ ->
let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in
A.reverse (A.fromFoldable (consNonEmpty (undb (init sN.s)) sN.l)) A.reverse (A.fromFoldable (consNonEmpty (undb (init sN.s)) sN.l))
...@@ -238,7 +238,7 @@ highlightNgrams (NgramsTable table) input0 = ...@@ -238,7 +238,7 @@ highlightNgrams (NgramsTable table) input0 =
init x = S.take (S.length x - 1) x init x = S.take (S.length x - 1) x
input = spR input0 input = spR input0
pats = A.fromFoldable (Map.keys table) pats = A.fromFoldable (Map.keys table)
ixs = indicesOfAny (sp <$> pats) (normNgram input) ixs = indicesOfAny (sp <$> pats) (normNgram ntype input)
consOnJustTail s xs@(Tuple _ (Just _) : _) = consOnJustTail s xs@(Tuple _ (Just _) : _) =
Tuple s Nothing : xs Tuple s Nothing : xs
...@@ -486,14 +486,18 @@ type NgramsTablePatch = ...@@ -486,14 +486,18 @@ type NgramsTablePatch =
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches} fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches}
normNgram :: String -> NgramsTerm normNgram :: CTabNgramType -> String -> NgramsTerm
normNgram = S.toLower <<< R.replace wordBoundaryReg " " normNgram CTabAuthors = identity
normNgram CTabSources = identity
normNgram CTabInstitutes = identity
normNgram CTabTerms = S.toLower <<< R.replace wordBoundaryReg " "
findNgramTermList :: NgramsTable -> String -> Maybe TermList
findNgramTermList (NgramsTable m) s = m ^? at (normNgram s) <<< _Just <<< _NgramsElement <<< _list
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch findNgramTermList :: CTabNgramType -> NgramsTable -> String -> Maybe TermList
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap (normNgram n) p findNgramTermList ntype (NgramsTable m) s = m ^? at (normNgram ntype s) <<< _Just <<< _NgramsElement <<< _list
singletonNgramsTablePatch :: CTabNgramType -> NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch m n p = fromNgramsPatches $ singletonPatchMap (normNgram m n) p
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm } type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
...@@ -566,9 +570,9 @@ postNewElems newElems params = void $ traverseWithIndex postNewElem newElems ...@@ -566,9 +570,9 @@ postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
where where
postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch addNewNgram :: CTabNgramType -> NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ngrams list = { ngramsPatches: mempty addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ngrams) list } , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches {nodeId, listIds, tabType} = putNgramsPatches {nodeId, listIds, tabType} =
......
...@@ -28,8 +28,8 @@ endConfig = endConfig' V10 ...@@ -28,8 +28,8 @@ endConfig = endConfig' V10
endConfig' :: ApiVersion -> EndConfig endConfig' :: ApiVersion -> EndConfig
endConfig' v = { front : frontRelative endConfig' v = { front : frontRelative
--, back : backLocal v , back : backLocal v
, back: backDev v --, back: backDev v
, static : staticRelative , static : staticRelative
} }
-- , back : backDemo v } -- , back : backDemo v }
......
...@@ -9,7 +9,7 @@ import Data.List (fromFoldable) ...@@ -9,7 +9,7 @@ import Data.List (fromFoldable)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Config (TabType(..), TabSubType(..), PTabNgramType(..)) import Gargantext.Config (TabType(..), TabSubType(..), PTabNgramType(..), CTabNgramType(..))
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
...@@ -32,6 +32,14 @@ modeTabType Patents = PTabPatents ...@@ -32,6 +32,14 @@ modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication modeTabType Communication = PTabCommunication
-- TODO fix this type
modeTabType' :: Mode -> CTabNgramType
modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type PropsRow = type PropsRow =
( nodeId :: Int ( nodeId :: Int
, contactData :: ContactData , contactData :: ContactData
...@@ -72,6 +80,6 @@ ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action ...@@ -72,6 +80,6 @@ ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} = ngramsViewSpec {mode} =
cmapProps (\{contactData: {defaultListId}, nodeId} -> cmapProps (\{contactData: {defaultListId}, nodeId} ->
{defaultListId, nodeId, tabType}) {defaultListId, nodeId, tabType})
(noState NT.mainNgramsTableSpec) (noState (NT.mainNgramsTableSpec (modeTabType' mode)))
where where
tabType = TabPairing $ TabNgramType $ modeTabType mode tabType = TabPairing $ TabNgramType $ modeTabType mode
...@@ -12,7 +12,7 @@ import Reactix as R ...@@ -12,7 +12,7 @@ import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass) import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..)) import Gargantext.Config (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..), CTabNgramType(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Loader2 (useLoader) import Gargantext.Components.Loader2 (useLoader)
...@@ -284,11 +284,11 @@ docViewSpec = simpleSpec performAction render ...@@ -284,11 +284,11 @@ docViewSpec = simpleSpec performAction render
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch {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 n pe pt = singletonNgramsTablePatch CTabTerms n pe
performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} = performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt}) commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
where where
pt = addNewNgram ngram termList pt = addNewNgram CTabTerms ngram termList
render :: Render State Props Action render :: Render State Props Action
render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } } render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }
......
...@@ -91,7 +91,7 @@ ngramsViewSpec {mode} = ...@@ -91,7 +91,7 @@ ngramsViewSpec {mode} =
noState $ chart mode <> noState $ chart mode <>
cmapProps (\{corpusData: {defaultListId}, corpusId: nodeId} -> cmapProps (\{corpusData: {defaultListId}, corpusId: nodeId} ->
{defaultListId, nodeId, tabType}) {defaultListId, nodeId, tabType})
NT.mainNgramsTableSpec (NT.mainNgramsTableSpec (modeTabType mode))
where where
tabType = TabCorpus $ TabNgramType $ modeTabType mode tabType = TabCorpus $ TabNgramType $ modeTabType mode
......
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