Rewrite AnnotatedField to use Reactix

src/Gargantext/Components/Annotated/AnnotatedField.purs

@@ -12,9 +12,9 @@
 module Gargantext.Components.Annotated.AnnotatedField where
 
 import Prelude hiding (div)
-import Data.Array (fromFoldable)
+import Data.Array as A
 import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..), maybe, isJust)
 import Data.Lens (Lens', lens)
 import Data.List as List
 import Data.List (List(..))
@@ -23,113 +23,68 @@ import Effect (Effect)
 import Effect.Class.Console (log)
 import Effect.Unsafe (unsafePerformEffect)
 import React (ReactElement, ReactClass, createElement)
-import React.DOM (p, span, text)
-import React.DOM.Props as Props
-import React.DOM.Props (className, onContextMenu, style)
-import Thermite (PerformAction, Render, createReactSpec, simpleSpec, writeState)
 import Gargantext.Types (TermList(..))
 import Gargantext.Components.NgramsTable (NgramsTable(..), highlightNgrams)
-import Gargantext.Utils.React (WithChildren)
 import Gargantext.Utils.Selection (getSelection, toString)
-import React as React
-import React.SyntheticEvent (SyntheticMouseEvent, pageX, pageY)
+import Reactix as R
+import Reactix.DOM.Raw as RDOM
 
 newtype PageOffset = PageOffset { x :: Number, y :: Number }
 
 type Run = Tuple String (Maybe TermList)
 
-type State = { runs :: List Run, contextMenu :: { visible :: Boolean } }
+type Props = ( ngrams :: NgramsTable, text :: Maybe String )
 
-type Props' = ( ngrams :: NgramsTable, text :: Maybe String )
-type Props = { | Props' }
+defaultProps :: Record Props
+defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing }
 
-data Action
-  = ForceRefresh
-  | OnContextMenu PageOffset String
-  | AddTerm String TermList
+annotatedField :: Record Props -> R.Element
+annotatedField = R.createLeaf annotatedFieldComponent
 
-defaultProps :: Props
-defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing }
-defaultState :: State
-defaultState = { runs: Nil, contextMenu: { visible: false } } -- contextMenu: ContextMenu.defaultState }
-
-annotatedField :: Props -> ReactElement
-annotatedField p = createElement annotatedFieldClass p []
-
-annotatedFieldClass :: ReactClass (WithChildren Props')
-annotatedFieldClass =
-  React.component "AnnotatedField"
-    (\this -> do
-       -- log $ "AnnotatedField: constructing"
-       s <- spec this
-       pure { state : s.state
-            , render: s.render
-            , componentDidUpdate: \old _s _snap -> do
-                new <- React.getProps this
-                when (old.ngrams /= new.ngrams || old.text /= new.text) do
-                  -- log "AnnotatedField: forcing refresh"
-                  dispatcher this ForceRefresh
-            })
+annotatedFieldComponent :: R.Component Props
+annotatedFieldComponent = R.pureLeaf "AnnotatedField" cpt
   where
-    performAction :: PerformAction State Props Action
-    performAction ForceRefresh = forceRefresh
-    performAction _ = \_ _ -> pure unit
-    -- performAction (ShowContextMenu i) = showContextMenu i
-    -- performAction (AddTerm t l) = addTerm t l
-    -- performAction = defaultPerformAction
-    render :: Render State Props Action
-    render d _p s _c = [ p [className "annotated-field"] $ children d s.runs ]
-    children d = fromFoldable <<< map (renderRun $ contextMenuHandler d)
-    renderRun menu (Tuple txt lst)
-      | Just list <- lst = span [termStyle list, onContextMenu menu] [text txt]
-      | otherwise = span [] [text txt]
-    {spec, dispatcher} = createReactSpec (simpleSpec performAction render) compile
-
--- performAction handlers
-
-forceRefresh props state =
-  do wrote <- writeState (compile props)
-     log $ msg wrote
-     pure unit
-  where msg = maybe "AnnotatedField: failed to write new state" (const "AnnotatedField: recompiled")
-
--- showContextMenu :: PerformAction State Props String
--- showContextMenu p s = pure unit
-
--- addTerm :: String -> PerformAction State Props TermList
--- addTerm t l p s = pure unit
-
-compile :: Props -> State
-compile props =
-  unsafePerformEffect $
-    do let ret = { runs: runs props.text, contextMenu: { visible: false } }
-       -- log "Compiling..."
-       pure ret
-  where runs (Just txt) = highlight props.ngrams txt
+    cpt props = R.createDOMElement "p" { className: "annotated-field" } $ children props
+    children props = A.fromFoldable (annotateRun <$> compile props)
+
+type RunProps = ( list :: Maybe TermList, text :: String )
+
+annotateRun :: Run -> R.Element
+annotateRun (Tuple text list) = R.createLeaf annotatedRunComponent { text, list }
+
+annotatedRunComponent :: R.Component RunProps
+annotatedRunComponent = R.pureLeaf "AnnotatedRun" cpt
+  where cpt { text, list } = maybe (unstyled text) (styled text) list
+        styled text list = R.createDOMElement "span" { style: termStyle list } [ RDOM.text text ]
+        unstyled text = R.createDOMElement "span" {} [ RDOM.text text ]
+
+compile :: Record Props -> List Run
+compile props = runs props.text
+  where runs (Just text) = highlight props.ngrams text
         runs _ = Nil
 
 highlight :: NgramsTable -> String -> List Run
 highlight n t = List.fromFoldable $ highlightNgrams n t
 
-contextMenuHandler :: (Action -> Effect Unit) -> SyntheticMouseEvent -> Effect Unit
-contextMenuHandler d e =
-  do sel <- getSelection
-     case toString <$> sel of
-       Just s -> submit s
-       Nothing -> pure unit
-  where submit s = offset >>= \o -> d $ OnContextMenu o s
-        offset =
-          do x <- pageX e
-             y <- pageY e
-             pure $ PageOffset { x, y }
-
-termStyle :: TermList -> Props.Props
-termStyle GraphTerm     = style {backgroundColor: "green"}
-termStyle StopTerm      = style {backgroundColor: "red", textDecoration : "line-through"}
-termStyle CandidateTerm = style {backgroundColor: "black"}
-
-_runs :: Lens' State (List Run)
-_runs = lens (\a -> a.runs) (\a r -> a { runs = r })
+-- contextMenuHandler :: (Action -> Effect Unit) -> SyntheticMouseEvent -> Effect Unit
+-- contextMenuHandler d e =
+--   do sel <- getSelection
+--      case toString <$> sel of
+--        Just s -> submit s
+--        Nothing -> pure unit
+--   where submit s = offset >>= \o -> d $ OnContextMenu o s
+--         offset =
+--           do x <- pageX e
+--              y <- pageY e
+--              pure $ PageOffset { x, y }
+
+termStyle :: TermList -> { backgroundColor :: String }
+termStyle GraphTerm     = { backgroundColor: "green" }
+termStyle StopTerm      = { backgroundColor: "red" }
+termStyle CandidateTerm = { backgroundColor: "black" }
+
+-- _runs :: Lens' State (List Run)
+-- _runs = lens (\a -> a.runs) (\a r -> a { runs = r })
 
 -- _contextMenu :: Lens' State ???
 -- _contextMenu = lens (\a -> a.contextMenu) (\a m -> a { contextMenu = m })

src/Gargantext/Pages/Corpus/Document.purs

@@ -24,6 +24,7 @@ import Gargantext.Components.Node (NodePoly(..))
 import Gargantext.Components.NgramsTable (NgramsTable(..), NgramsElement(..))
 import Gargantext.Components.Annotated.AnnotatedField as AnnotatedField
 import Gargantext.Types (TermList(..))
+import Gargantext.Utils.React ( crapify )
 
 nge :: String -> Tuple String NgramsElement
 nge word = Tuple word elem where
@@ -38,7 +39,6 @@ testTable = NgramsTable $ Map.fromFoldable $ nge <$> words
 
 type State =
   { document   :: Maybe (NodePoly Document)
-  , annotatedDocument :: AnnotatedDocument
   , ngramsTable :: NgramsTable
   , inputValue :: String
   }
@@ -46,7 +46,6 @@ type State =
 initialState :: {} -> State
 initialState {} =
   { document: Nothing
-  , annotatedDocument: defaultAnnotatedDocument
   , ngramsTable: testTable
   , inputValue: ""
   }
@@ -136,13 +135,6 @@ data Document
     --, text               :: Maybe String
     }
 
-data AnnotatedDocument
-  = AnnotatedDocument
-    { abstract :: AnnotatedField.State }
-
-defaultAnnotatedDocument :: AnnotatedDocument
-defaultAnnotatedDocument = AnnotatedDocument { abstract: AnnotatedField.defaultState }
-
 defaultNodeDocument :: NodePoly Document
 defaultNodeDocument =
   NodePoly { id : 0
@@ -338,7 +330,7 @@ docview = simpleSpec performAction render
           ]
       ]
         where
-          annotate t = AnnotatedField.annotatedField { ngrams: state.ngramsTable, text: t }
+          annotate t = crapify $ AnnotatedField.annotatedField { ngrams: state.ngramsTable, text: t }
           li' = li [className "list-group-item justify-content-between"]
           text' x = text $ maybe "Nothing" identity x
           badge s = span [className "badge badge-default badge-pill"] [text s]

src/Gargantext/Utils/React.purs

 module Gargantext.Utils.React where
 
 import Prelude
-import Data.Array ((!!))
-import Data.FoldableWithIndex (foldMapWithIndex)
-import Data.Maybe (fromMaybe)
-import React (ReactElement, Children)
+import Data.Array ( (!!) )
+import Data.FoldableWithIndex ( foldMapWithIndex )
+import Data.Maybe ( fromMaybe )
+import React ( ReactElement, Children )
+import Reactix as R
+import Unsafe.Coerce ( unsafeCoerce )
 
 -- TODO: Upgrade thermite and reapply our changes or upstream them and get rid of this
 type WithChildren props = { children :: Children | props }
@@ -12,3 +14,43 @@ type WithChildren props = { children :: Children | props }
 wrap :: (Array ReactElement -> ReactElement) -> ReactElement -> ReactElement
 wrap f e = f [e]
 
+crapify :: R.Element -> ReactElement
+crapify = unsafeCoerce
+
+-- many ::
+--   forall props extra state action.
+--      Spec state { extra :: extra | WithIndex props } action
+--   -> Spec state { props :: (Array props), extra :: extra } action
+-- many items spec = Spec { performAction, render }
+--   where
+--     -- performAction :: PerformAction
+--     render d p s c = foldMapWithIndex childSpec p.props
+--     childSpec props i = cmapProps (\_ -> props { index = i }) spec
+
+-- many
+--   :: forall props state action
+--    . (Int -> Spec state props action)
+--   -> Spec state (List props) (Tuple Int action)
+-- foreach f = Spec  { performAction: performAction
+--     , render: render
+--     }
+--   where
+--     performAction :: PerformAction (List state) props (Tuple Int action)
+--     performAction (Tuple i a) p sts =
+--         for_ (sts !! i) \st ->
+--           case f i of
+--             Spec s -> forever (transform (_ >>= (_ !! i)))
+--                       `transformCoTransformL` s.performAction a p st
+--                       `transformCoTransformR` forever (transform (modifying i))
+--       where
+--         modifying :: Int -> (state -> state) -> List state -> List state
+--         modifying j g sts' = fromMaybe sts' (modifyAt j g sts')
+
+--     render :: Render (List state) props (Tuple Int action)
+--     render k p sts _ = foldWithIndex (\i st els -> case f i of Spec s -> els <> s.render (k <<< Tuple i) p st []) sts []
+
+--     foldWithIndex :: forall a r. (Int -> a -> r -> r) -> List a -> r -> r
+--     foldWithIndex g = go 0
+--       where
+--       go _ Nil         r = r
+--       go i (Cons x xs) r = go (i + 1) xs (g i x r)