Merge branch '234-dev-ngrams-score' of...

Merge branch '234-dev-ngrams-score' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge

src/Gargantext/Components/DocsTable.purs

@@ -31,6 +31,8 @@ import Gargantext.Components.Category.Types (Star(..))
 import Gargantext.Components.DocsTable.DocumentFormCreation (documentFormCreation)
 import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
 import Gargantext.Components.Nodes.Lists.Types as NT
+import Gargantext.Components.Nodes.Texts.Types (SidePanelTriggers)
+import Gargantext.Components.Score as GCS
 import Gargantext.Components.Nodes.Texts.Types as TextsT
 import Gargantext.Components.Table as TT
 import Gargantext.Components.Table.Types as TT
@@ -45,6 +47,7 @@ import Gargantext.Utils (sortWith, (?))
 import Gargantext.Utils.CacheAPI as GUC
 import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as GUT
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Simple.JSON as JSON
@@ -462,13 +465,14 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
           (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
     mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
 
+    reload <- T.useBox GUT.newReload
     localCategories' <- T.useLive T.unequal localCategories
 
     pure $ TT.table
       { colNames
       , container: TT.defaultContainer
       , params
-      , rows: rows localCategories' mCurrentDocId'
+      , rows: rows reload localCategories' mCurrentDocId'
       , syncResetButton : [ H.div {} [] ]
       , totalRecords
       , wrapColElts
@@ -483,9 +487,9 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
           | otherwise = Routes.Document sid listId
         colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
         wrapColElts = const identity
-        rows localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
+        rows reload localCategories' mCurrentDocId' = row reload <$> A.toUnfoldable documents
           where
-            row dv@(DocumentsView r@{ _id, category }) =
+            row reload dv@(DocumentsView r@{ _id, category }) =
               { row:
                 TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
                             H.div { className: "" }
@@ -506,11 +510,17 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
                 -- TODO show date: Year-Month-Day only
                 , H.div { className: tClassName } [ R2.showText r.date ]
                 , H.div { className: tClassName }
-                        [ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"}
+                        [ H.a { href: url frontends $ corpusDocument r._id, target: "_blank" }
                               [ H.text r.title ]
                         ]
                 , H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ]
-                , H.div {} [ H.text $ maybe "-" show r.ngramCount ]
+                -- , H.div {} [ H.text $ maybe "-" show r.score ]
+                , H.div { className: tClassName } [ GCS.scoreEl { docId: r._id
+                                                                , key: show nodeId <> "-" <> show r._id
+                                                                , nodeId
+                                                                , score: r.score
+                                                                , session
+                                                                , tableReload: reload } [] ]
                 ]
               , delete: true }
               where

src/Gargantext/Components/Score.purs

+module Gargantext.Components.Score where
+
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
+import Data.Int (fromString)
+import Data.Either (Either)
+import Data.Maybe (Maybe(..), maybe)
+import DOM.Simple.Console (log2)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Simple.JSON as JSON
+
+import Gargantext.Prelude
+
+import Gargantext.Config.REST (RESTError)
+import Gargantext.Routes (SessionRoute(NodeAPI))
+import Gargantext.Sessions (Session, sessionId, get, delete, put)
+import Gargantext.Types as GT
+import Gargantext.Utils.Array as GUA
+import Gargantext.Utils.Reactix as R2
+import Gargantext.Utils.Toestand as GUT
+
+type Score = Int
+type DocID = Int
+
+thisModule :: String
+thisModule = "Gargantext.Components.Score"
+
+type Props = (
+    docId       ::DocID
+  , key :: String
+  , nodeId      :: GT.NodeID
+  , score       :: Maybe Score
+  , session     :: Session
+  , tableReload :: GUT.ReloadS
+  )
+
+type Choice = Maybe Score
+
+scoreEl :: R2.Component Props
+scoreEl = R.createElement scoreElCpt
+
+scoreElCpt :: R.Component Props
+scoreElCpt = R.hooksComponentWithModule thisModule "scoreEl" cpt
+  where
+    cpt { docId, nodeId, score, session, tableReload } _ = do
+      pure $ R2.select { className: "form-control"
+                       , defaultValue: showChoice score
+                       , on: { change: onChange session nodeId docId tableReload }
+                       } (map option choices)
+
+    onChange session nodeId docId reloadS e = do
+      -- TODO change score via api
+      let query = ScoreQuery { nodeIds: [ docId ]
+                             , score: readChoice $ R.unsafeEventValue e }
+      launchAff_ $ do
+        _ <- putScore session nodeId query
+        liftEffect $ GUT.reload reloadS
+
+    option :: Choice -> R.Element
+    option c = H.option { value: showChoice c } [ H.text $ showChoice c ]
+
+    choices = [ Nothing ] <> (Just <$> GUA.range 5 100 5)
+
+    showChoice :: Choice -> String
+    showChoice Nothing = "-"
+    showChoice (Just c) = show c
+
+    readChoice = fromString
+
+
+newtype ScoreQuery =
+  ScoreQuery { nodeIds :: Array DocID
+             , score   :: Choice
+             }
+
+instance JSON.WriteForeign ScoreQuery where
+  writeImpl (ScoreQuery post) = JSON.writeImpl { nts_nodesId: post.nodeIds
+                                               , nts_score: post.score }
+
+putScore :: Session -> GT.NodeID -> ScoreQuery -> Aff (Either RESTError (Array Int))
+putScore session nodeId = put session $ scoreRoute nodeId
+  where
+    scoreRoute :: GT.NodeID -> SessionRoute
+    scoreRoute nodeId = NodeAPI GT.Node (Just nodeId) "score"

src/Gargantext/Utils/Array.purs

-module Gargantext.Utils.Array (max, min, push) where
+module Gargantext.Utils.Array (
+    max
+  , min
+  , push
+  , range) where
 
 import Data.Array as A
 import Data.Foldable (foldr)
+import Data.Int as DI
 import Data.Maybe (Maybe(..))
 import Data.Ord as Ord
 import Effect (Effect)
 import Effect.Uncurried (EffectFn2, runEffectFn2)
+import Math as Math
 
 import Gargantext.Prelude
 
@@ -26,3 +32,9 @@ min xs = foldr reducer (A.head xs) xs
   where
     reducer _ Nothing = Nothing
     reducer v (Just acc) = Just $ Ord.min acc v
+
+-- | Create an array containing a range of integers, with given step
+range :: Int -> Int -> Int -> Array Int
+range start end step = map (\i -> start + i*step) $ A.range 0 end'
+  where
+    end' = DI.round $ Math.floor $ (DI.toNumber $ end - start) / (DI.toNumber step)

test/Gargantext/Utils/Spec.purs

@@ -12,6 +12,7 @@ import Gargantext.Prelude
 
 import Gargantext.Utils as GU
 import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson)
+import Gargantext.Utils.Array as GUA
 import Gargantext.Utils.Crypto as Crypto
 import Gargantext.Utils.Math as GUM
 
@@ -133,6 +134,11 @@ spec =
       let hash2 = Crypto.hash ["b","a"]
       hash1 `shouldEqual` hash2
 
-
-
-
+------------------------------------------------------------------------
+-- | Gargantext.Utils.Array tests
+    it "G.U.Array.range works correctly (include endpoint)" do
+      GUA.range 0 10 2 `shouldEqual` [0, 2, 4, 6, 8, 10]
+      GUA.range 0 10 5 `shouldEqual` [0, 5, 10]
+    it "G.U.Array.range works correctly (no endpoint)" do
+      GUA.range 0 11 2 `shouldEqual` [0, 2, 4, 6, 8, 10]
+      GUA.range 0 11 5 `shouldEqual` [0, 5, 10]