[ngrams] fixes to highlighting of ngrams

parent 58cfd7b2
...@@ -20,6 +20,7 @@ import DOM.Simple.Event as DE ...@@ -20,6 +20,7 @@ import DOM.Simple.Event as DE
import Data.Array as A import Data.Array as A
import Data.List (List(..), (:)) import Data.List (List(..), (:))
import Data.Map (Map) import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.String.Common (joinWith) import Data.String.Common (joinWith)
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
...@@ -37,19 +38,22 @@ import Reactix as R ...@@ -37,19 +38,22 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Record as Record import Record as Record
import Record.Extra as RX
import Toestand as T import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Field" here = R2.here "Gargantext.Components.Annotation.Field"
-- @NOTE #386: add parameter "type" ("Authors", "Terms") -- @NOTE #386: add parameter "type" ("Authors", "Terms")
type Props = type CommonProps =
( ngrams :: NgramsTable ( setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String , text :: Maybe String
, mode :: ModeType , mode :: ModeType
, cache :: Record Cache , cache :: Record Cache
) )
type AnnotatedFieldProps =
( ngrams :: T.Box NgramsTable
| CommonProps )
type MouseEvent = E.SyntheticEvent DE.MouseEvent type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- UNUSED -- UNUSED
...@@ -57,24 +61,33 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent ...@@ -57,24 +61,33 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit } -- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Leaf Props annotatedField :: R2.Leaf AnnotatedFieldProps
annotatedField = R2.leaf annotatedFieldCpt annotatedField = R2.leaf annotatedFieldCpt
annotatedFieldCpt :: R.Component Props annotatedFieldCpt :: R.Component AnnotatedFieldProps
annotatedFieldCpt = here.component "annotatedField" cpt where annotatedFieldCpt = here.component "annotatedField" cpt where
cpt props _ = do cpt props _ = do
ngrams' <- T.useLive T.unequal props.ngrams
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu)) menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
redrawMenu <- T.useBox false redrawMenu <- T.useBox false
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu, reload } props) let commonProps = RX.pick props :: Record CommonProps
-- R.useEffect' $ do
-- let NgramsTable { ngrams_repo_elements: nre } = ngrams'
-- here.log2 "[annotatedField] ngrams' keys" $ A.fromFoldable $ Map.keys nre
pure $ annotatedFieldInner (Record.merge { menuRef, ngrams: ngrams', redrawMenu, reload } commonProps)
----------------------------------------------------------------- -----------------------------------------------------------------
type InnerProps = type InnerProps =
( menuRef :: R.Ref (Maybe (Record AnnotationMenu)) ( ngrams :: NgramsTable
, menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, reload :: T2.ReloadS , reload :: T2.ReloadS
| Props | CommonProps
) )
annotatedFieldInner :: R2.Leaf InnerProps annotatedFieldInner :: R2.Leaf InnerProps
......
...@@ -5,6 +5,7 @@ module Gargantext.Components.Document.Layout ...@@ -5,6 +5,7 @@ module Gargantext.Components.Document.Layout
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Lens ((^.))
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Ord (greaterThan) import Data.Ord (greaterThan)
...@@ -32,6 +33,7 @@ import Gargantext.Sessions (Session) ...@@ -32,6 +33,7 @@ import Gargantext.Sessions (Session)
import Gargantext.Utils ((?)) import Gargantext.Utils ((?))
import Gargantext.Utils as U import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record import Record as Record
...@@ -44,6 +46,7 @@ import Toestand as T ...@@ -44,6 +46,7 @@ import Toestand as T
type Props = type Props =
( loaded :: LoadedData ( loaded :: LoadedData
, path :: DocPath , path :: DocPath
, reload :: T2.ReloadS
, session :: Session , session :: Session
| Options | Options
) )
...@@ -66,14 +69,17 @@ layoutCpt :: R.Component Props ...@@ -66,14 +69,17 @@ layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where layoutCpt = here.component "layout" cpt where
cpt props@{ path: path@{ listIds cpt props@{ path: path@{ listIds
, nodeId } , nodeId }
, reload
, session } _ = do , session } _ = do
reload' <- T.useLive T.unequal reload
case A.head listIds of case A.head listIds of
Nothing -> pure $ H.div {} [ H.text "No list supplied!" ] Nothing -> pure $ H.div {} [ H.text "No list supplied!" ]
Just listId -> Just listId ->
useLoader { errorHandler useLoader { errorHandler
, loader: \p -> getContextNgrams session p.contextId p.listId , loader: \p -> getContextNgrams session p.contextId p.listId
, path: { contextId: nodeId, listId } , path: { contextId: nodeId, listId, reload: reload' }
, render: \contextNgrams -> layoutWithContextNgrams $ Record.merge props { contextNgrams } } , render: \contextNgrams ->
layoutWithContextNgrams $ Record.merge props { contextNgrams } }
where where
errorHandler = logRESTError here "[layout]" errorHandler = logRESTError here "[layout]"
...@@ -88,17 +94,16 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -88,17 +94,16 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
-- Component -- Component
cpt { contextNgrams cpt { contextNgrams
, path , path
, reload
, loaded: , loaded:
loaded@{ ngramsTable: Versioned loaded@{ ngramsTable: Versioned { data: initTable }
{ data: initTable } , document: NodePoly { hyperdata: Document doc }
, document: NodePoly
{ hyperdata: Document doc
}
} }
, sideControlsSlot , sideControlsSlot
} _ = do } _ = do
-- | States -- | States
-- | -- |
reload' <- T.useLive T.unequal reload
state'@{ ngramsLocalPatch } /\ state <- state'@{ ngramsLocalPatch } /\ state <-
R2.useBox' $ initialState { loaded } R2.useBox' $ initialState { loaded }
...@@ -111,34 +116,45 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -111,34 +116,45 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
onPending' <- R2.useLive' onPending onPending' <- R2.useLive' onPending
result' <- R2.useLive' result result' <- R2.useLive' result
ngrams <- T.useBox initTable
ngrams' <- T.useLive T.unequal ngrams
-- | Computed -- | Computed
-- | -- |
let let
withAutoUpdate = false withAutoUpdate = false
ngrams = applyNgramsPatches state' initTable -- ngrams = applyNgramsPatches state' initTable
cache = computeCache ngrams $ Set.fromFoldable contextNgrams
annotate text = AnnotatedField.annotatedField cache = computeCache ngrams' $ Set.fromFoldable contextNgrams
{ ngrams
, setTermList
, text
, mode: mode'
, cache
}
setTermListOrAddA ngram Nothing = setTermListOrAddA ngram Nothing =
addNewNgramA ngram addNewNgramA ngram
setTermListOrAddA ngram (Just oldList) = setTermListOrAddA ngram (Just oldList) =
setTermListA ngram <<< replace oldList setTermListA ngram <<< replace oldList
setTermList ngram mOldList = setTermList ngram mOldList termList = do
dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList let root = findNgramRoot ngrams' ngram
-- here.log2 "[setTermList] ngram" ngram
-- here.log2 "[setTermList] root" root
let patch = setTermListOrAddA root mOldList termList
-- here.log2 "[setTermList] patch" patch
dispatch patch
T.write_ (applyNgramsPatches state' initTable) ngrams
-- here.log2 "[setTermList] calling reload" reload'
T2.reload reload
hasAbstract = maybe false (not String.null) doc.abstract hasAbstract = maybe false (not String.null) doc.abstract
annotate text = AnnotatedField.annotatedField
{ ngrams
, setTermList
, text
, mode: mode'
, cache
}
-- | Hooks -- | Hooks
-- | -- |
...@@ -153,6 +169,14 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where ...@@ -153,6 +169,14 @@ layoutWithContextNgramsCpt = here.component "layoutWithContextNgrams" cpt where
let let
onModeChange = read >>> fromMaybe AFT.EditionMode >>> flip T.write_ mode onModeChange = read >>> fromMaybe AFT.EditionMode >>> flip T.write_ mode
-- R.useEffect' $ do
-- here.log2 "[layoutWithContextNgrams] cache" cache
-- here.log2 "[layoutWithContextNgrams] ngramsLocalPatch" ngramsLocalPatch
-- let NgramsTable { ngrams_repo_elements: nre } = initTable
-- here.log2 "[layoutWithContextNgrams] ngrams_repo_elements" $ A.fromFoldable $ Map.keys nre
-- let NgramsTable { ngrams_repo_elements: nre' } = ngrams'
-- here.log2 "[layoutWithContextNgrams] ngrams (after apply patches)" $ A.fromFoldable $ Map.keys nre'
-- | Render -- | Render
-- | -- |
pure $ pure $
......
...@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect) ...@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
...@@ -33,7 +35,6 @@ type Props = ...@@ -33,7 +35,6 @@ type Props =
docFocus :: R2.Leaf ( key :: String | Props ) docFocus :: R2.Leaf ( key :: String | Props )
docFocus = R2.leaf docFocusCpt docFocus = R2.leaf docFocusCpt
docFocusCpt :: R.Component ( key :: String | Props ) docFocusCpt :: R.Component ( key :: String | Props )
docFocusCpt = here.component "main" cpt where docFocusCpt = here.component "main" cpt where
cpt { graphSideDoc: GraphSideDoc { docId, listId, corpusId } cpt { graphSideDoc: GraphSideDoc { docId, listId, corpusId }
...@@ -43,6 +44,8 @@ docFocusCpt = here.component "main" cpt where ...@@ -43,6 +44,8 @@ docFocusCpt = here.component "main" cpt where
-- | States -- | States
-- | -- |
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
-- | Computed -- | Computed
-- | -- |
...@@ -89,6 +92,7 @@ docFocusCpt = here.component "main" cpt where ...@@ -89,6 +92,7 @@ docFocusCpt = here.component "main" cpt where
layout layout
{ loaded { loaded
, path , path
, reload
, session , session
, sideControlsSlot: Just $ , sideControlsSlot: Just $
H.div H.div
......
...@@ -34,6 +34,15 @@ instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where ...@@ -34,6 +34,15 @@ instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
, name: inst.name , name: inst.name
, date: inst.date , date: inst.date
, hyperdata: inst.hyperdata } , hyperdata: inst.hyperdata }
instance JSON.WriteForeign a => JSON.WriteForeign (NodePoly a) where
writeImpl (NodePoly np) = do
JSON.writeImpl { user_id : np.userId
, parent_id : np.parentId
, id : np.id
, typename : np.typename
, name : np.name
, date : np.date
, hyperdata : np.hyperdata}
newtype HyperdataList = HyperdataList { preferences :: Maybe String } newtype HyperdataList = HyperdataList { preferences :: Maybe String }
derive instance Generic HyperdataList _ derive instance Generic HyperdataList _
......
...@@ -16,7 +16,9 @@ import Gargantext.Hooks.Loader (useLoaderEffect) ...@@ -16,7 +16,9 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
import Gargantext.Hooks.Session (useSession) import Gargantext.Hooks.Session (useSession)
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), ListId, NodeID, TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Toestand as T
type Props = type Props =
( listId :: ListId ( listId :: ListId
...@@ -40,6 +42,8 @@ nodeCpt = here.component "node" cpt where ...@@ -40,6 +42,8 @@ nodeCpt = here.component "node" cpt where
session <- useSession session <- useSession
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
-- | Computed -- | Computed
-- | -- |
...@@ -85,6 +89,7 @@ nodeCpt = here.component "node" cpt where ...@@ -85,6 +89,7 @@ nodeCpt = here.component "node" cpt where
layout layout
{ loaded { loaded
, path , path
, reload
, session , session
} }
} }
...@@ -41,6 +41,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -41,6 +41,7 @@ import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T import Toestand as T
here :: R2.Here here :: R2.Here
...@@ -548,7 +549,15 @@ sideTextCpt = here.component "sideText" cpt where ...@@ -548,7 +549,15 @@ sideTextCpt = here.component "sideText" cpt where
} _ = do } _ = do
-- | States -- | States
-- | -- |
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) -- state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
-- state <- T.useBox (Nothing :: Maybe LoadedData)
-- state' <- T.useLive T.unequal state
-- R.useEffect' $ do
-- here.log2 "[sideText] state'" state'
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
-- | Computed -- | Computed
-- | -- |
...@@ -568,34 +577,58 @@ sideTextCpt = here.component "sideText" cpt where ...@@ -568,34 +577,58 @@ sideTextCpt = here.component "sideText" cpt where
-- | Hooks -- | Hooks
-- | -- |
useLoaderEffect -- useLoaderEffect
{ errorHandler: logRESTError here "[sidePanelText]" -- { errorHandler: logRESTError here "[sidePanelText]"
, loader: loadData -- , loader: loadData
, path -- , path
, state -- , state
} -- }
-- | Render
-- |
pure $
H.div
{ className: "graph-doc-focus" }
[
B.cloak
{ isDisplayed: isJust state'
, idlingPhaseDuration: Just 150
, cloakSlot:
B.preloader
{}
, defaultSlot: useLoader { errorHandler: logRESTError here "[sidePanelText]"
R2.fromMaybe state' \loaded -> , loader: \{ path, reload'} -> loadData path
layout , path: { path, reload' }
{ loaded , render: \loaded -> loadedSideText { loaded
, path , path
, session , reload
, session }
} }
}
] -- -- | Render
-- -- |
-- pure $
-- H.div
-- { className: "graph-doc-focus" }
-- [
-- B.cloak
-- { isDisplayed: isJust state'
-- , idlingPhaseDuration: Just 150
-- , cloakSlot:
-- B.preloader
-- {}
-- , defaultSlot:
-- R2.fromMaybe state' \loaded ->
-- layout
-- { loaded
-- , path
-- , session
-- , key: JSON.writeJSON loaded
-- }
-- }
-- ]
type LoadedSideTextProps =
( loaded :: LoadedData
, path :: DocPath
, reload :: T2.ReloadS
, session :: Session )
loadedSideText :: R2.Leaf LoadedSideTextProps
loadedSideText = R2.leaf loadedSideTextCpt
loadedSideTextCpt :: R.Component LoadedSideTextProps
loadedSideTextCpt = here.component "loadedSideText" cpt where
cpt { loaded, path, reload, session } _ = do
pure $ H.div { className: "graph-doc-focus" }
[ layout { loaded, path, reload, session } ]
...@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect) ...@@ -18,8 +18,10 @@ import Gargantext.Hooks.Loader (useLoaderEffect)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
...@@ -33,7 +35,6 @@ type Props = ...@@ -33,7 +35,6 @@ type Props =
docFocus :: R2.Leaf ( key :: String | Props ) docFocus :: R2.Leaf ( key :: String | Props )
docFocus = R2.leaf docFocusCpt docFocus = R2.leaf docFocusCpt
docFocusCpt :: R.Component ( key :: String | Props ) docFocusCpt :: R.Component ( key :: String | Props )
docFocusCpt = here.component "main" cpt where docFocusCpt = here.component "main" cpt where
cpt { frameDoc: FrameDoc { docId, listId, corpusId } cpt { frameDoc: FrameDoc { docId, listId, corpusId }
...@@ -44,6 +45,9 @@ docFocusCpt = here.component "main" cpt where ...@@ -44,6 +45,9 @@ docFocusCpt = here.component "main" cpt where
-- | -- |
state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData) state' /\ state <- R2.useBox' (Nothing :: Maybe LoadedData)
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
-- | Computed -- | Computed
-- | -- |
let let
...@@ -89,6 +93,7 @@ docFocusCpt = here.component "main" cpt where ...@@ -89,6 +93,7 @@ docFocusCpt = here.component "main" cpt where
layout layout
{ loaded { loaded
, path , path
, reload
, session , session
, sideControlsSlot: Just $ , sideControlsSlot: Just $
H.div H.div
......
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