[nlp] add dynamic languages, based on server response (graphql)

src/Gargantext/Components/Forest/Tree/Node/Action/Search.purs

@@ -2,6 +2,8 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search where
 
 import Gargantext.Prelude
 
+import Data.Array as A
+import Data.Map as Map
 import Data.Maybe (Maybe)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
@@ -9,13 +11,17 @@ import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
 import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
-import Gargantext.Components.Lang (allLangs)
+import Gargantext.Components.GraphQL.Endpoints (getLanguages)
+import Gargantext.Components.Lang (allLangs, Lang)
+import Gargantext.Config.REST (RESTError(..), AffRESTError)
+import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Sessions (Session)
 import Gargantext.Types (ID)
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
+import Record as Record
 import Toestand as T
 
 here :: R2.Here
@@ -32,16 +38,44 @@ type Props =
 actionSearch :: R2.Component Props
 actionSearch = R.createElement actionSearchCpt
 actionSearchCpt :: R.Component Props
-actionSearchCpt = here.component "actionSearch" cpt
+actionSearchCpt = here.component "actionSearch" cpt where
+  cpt props@({ session }) _ = do
+    useLoader { errorHandler
+              , loader: loadLanguages
+              , path: { session }
+              , render: \langs ->
+                 actionSearchWithLangs (Record.merge props { langs }) [] }
+    where
+      errorHandler err = case err of
+        ReadJSONError err' -> here.warn2 "[listTreeChildren] ReadJSONError" $ show err'
+        _                  -> here.warn2 "[listTreeChildren] RESTError" err
+
+loadLanguages :: { session :: Session } -> AffRESTError (Array Lang)
+loadLanguages { session } = do
+  eLangsMap <- getLanguages session
+  pure $ A.fromFoldable <$> Map.keys <$> eLangsMap
+
+type PropsWithLangs =
+  ( boxes     :: Boxes
+  , dispatch  :: Action -> Aff Unit
+  , id        :: Maybe ID
+  , langs     :: Array Lang
+  , session   :: Session )
+
+-- | Action : Search
+actionSearchWithLangs :: R2.Component PropsWithLangs
+actionSearchWithLangs = R.createElement actionSearchWithLangsCpt
+actionSearchWithLangsCpt :: R.Component PropsWithLangs
+actionSearchWithLangsCpt = here.component "actionSearchWithLangs" cpt
   where
-    cpt { boxes: { errors }, dispatch, id, session } _ = do
+    cpt { boxes: { errors }, dispatch, id, langs, session } _ = do
       search <- T.useBox $ defaultSearch { node_id = id }
       pure $ R.fragment
         [ H.p { className: "action-search m-1" }
           [ H.text $ "Search and create a private "
             <> "corpus with the search query as corpus name." ]
         , searchBar { errors
-                    , langs: allLangs
+                    , langs
                     , onSearch: searchOn dispatch
                     , search
                     , session

src/Gargantext/Components/GraphQL.purs

@@ -13,6 +13,7 @@ import Foreign (unsafeToForeign, ForeignError)
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact)
 import Gargantext.Components.GraphQL.Context as GQLCTX
 import Gargantext.Components.GraphQL.IMT as GQLIMT
+import Gargantext.Components.GraphQL.NLP as GQLNLP
 import Gargantext.Components.GraphQL.Node (Node)
 import Gargantext.Components.GraphQL.Tree (TreeFirstLevel)
 import Gargantext.Components.GraphQL.User (User, UserInfo, UserInfoM)
@@ -76,6 +77,7 @@ type Schema
     , contexts :: { context_id :: Int, node_id :: Int } ==> Array GQLCTX.NodeContext
     , contexts_for_ngrams :: { corpus_id :: Int, ngrams_terms :: Array String } ==> Array GQLCTX.Context
     , imt_schools :: {} ==> Array GQLIMT.School
+    , languages :: {} ==> Array GQLNLP.Language
     , node_parent :: { node_id :: Int, parent_type :: String } ==> Array Node  -- TODO: parent_type :: NodeType
     , nodes :: { node_id :: Int } ==> Array Node
     , user_infos :: { user_id :: Int } ==> Array UserInfo

src/Gargantext/Components/GraphQL/Endpoints.purs

@@ -5,16 +5,20 @@ import Gargantext.Prelude
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
+import Data.Map as Map
+import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Gargantext.Components.GraphQL (getClient, queryGql)
 import Gargantext.Components.GraphQL.Contact (AnnuaireContact, annuaireContactQuery)
 import Gargantext.Components.GraphQL.Context as GQLCTX
 import Gargantext.Components.GraphQL.IMT as GQLIMT
+import Gargantext.Components.GraphQL.NLP as GQLNLP
 import Gargantext.Components.GraphQL.Node (Node, nodeParentQuery, nodesQuery)
 import Gargantext.Components.GraphQL.Team (Team, teamQuery)
 import Gargantext.Components.GraphQL.Tree (TreeFirstLevel, treeFirstLevelQuery)
 import Gargantext.Components.GraphQL.User (UserInfo, userInfoQuery)
+import Gargantext.Components.Lang (Lang)
 import Gargantext.Config.REST (RESTError(..), AffRESTError)
 import Gargantext.Sessions (Session(..))
 import Gargantext.Types (NodeType)
@@ -130,3 +134,12 @@ updateNodeContextCategory session context_id node_id category = do
   pure $ case A.head update_node_context_category of
     Nothing -> Left (CustomError $ "Failed to update node category")
     Just _ -> Right context_id
+
+getLanguages :: Session -> AffRESTError (Map.Map Lang GQLNLP.LanguageProperties)
+getLanguages session = do
+  let query = GQLNLP.nlpQuery
+  { languages } <- queryGql session "get languages" query
+
+  liftEffect $ here.log2 "[getLanguages] languages" languages
+
+  pure $ Right $ Map.fromFoldable $ (\{ key, value } -> Tuple key value) <$> languages

src/Gargantext/Components/GraphQL/IMT.purs

@@ -6,8 +6,6 @@ import Affjax.RequestBody (RequestBody(..))
 import Data.Array as A
 import Data.Lens (Lens', lens)
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
-import GraphQL.Client.Args (NotNull, (=>>))
-import GraphQL.Client.Variable (Var(..))
 import Gargantext.Utils.GraphQL as GGQL
 import Type.Proxy (Proxy(..))
 

src/Gargantext/Components/GraphQL/NLP.purs

+module Gargantext.Components.GraphQL.NLP where
+
+import Gargantext.Prelude
+
+import GraphQL.Client.Args (Args, NotNull, (=>>))
+import GraphQL.Client.Variable (Var(..))
+import Gargantext.Components.Lang (Lang(..), ServerType)
+import Gargantext.Utils.GraphQL as GGQL
+import Type.Proxy (Proxy(..))
+
+type LanguageProperties
+  = { url    :: String
+    , server :: ServerType
+    }
+
+type Language
+  = { key   :: Lang
+    , value :: LanguageProperties }
+
+type NLPQuery =
+  { languages ::
+       { key :: Unit
+       , value :: {
+           url :: Unit
+         , server :: Unit }
+       }
+  }
+
+nlpQuery :: NLPQuery
+nlpQuery = { languages:
+             { key   : unit
+             , value : {
+                 url : unit
+               , server: unit }
+             }
+           }

src/Gargantext/Components/Lang.purs

@@ -9,8 +9,10 @@ import Data.Lens.Lens.Product (_1)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Show.Generic (genericShow)
+import Foreign as F
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Show as GUS
+import Gargantext.Utils.SimpleJSON as GJSON
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Simple.JSON as JSON
@@ -34,6 +36,7 @@ allLangs = [ EN
 
 data Lang = FR | EN | DE | ES | IT | PL | CN | Universal | No_extraction
 derive instance Generic Lang _
+derive instance Ord Lang
 
 instance Show Lang where
   show Universal     = "All"
@@ -45,12 +48,33 @@ langReader = GUS.reader allLangs
 
 derive instance Eq Lang
 
-instance EncodeJson Lang where
-  encodeJson a = encodeJson (show a)
+-- instance EncodeJson Lang where
+--   encodeJson a = encodeJson (show a)
 
+instance JSON.ReadForeign Lang where
+  readImpl f = do
+    f' <- JSON.readImpl f
+    case langReader f' of
+      Nothing -> GJSON.throwJSONError $ F.ForeignError $ "Unknown language: " <> f'
+      Just l  -> pure l
 instance JSON.WriteForeign Lang where
   writeImpl l = JSON.writeImpl $ show l
 
+
+data ServerType = CoreNLP | Spacy | JohnSnow
+derive instance Generic ServerType _
+instance Show ServerType where
+  show = genericShow
+instance JSON.ReadForeign ServerType where
+  readImpl f = do
+    f' <- JSON.readImpl f
+    case f' of
+      "CoreNLP"        -> pure CoreNLP
+      "Spacy"          -> pure Spacy
+      "JohnSnowServer" -> pure JohnSnow
+      _                -> GJSON.throwJSONError $ F.ForeignError $ "Unknown server: " <> f'
+
+
 -- Language used for the landing page
 data LandingLang = LL_EN | LL_FR
 

src/Gargantext/Utils/SimpleJSON.purs

@@ -91,6 +91,8 @@ instance untaggedSumRepArgument ::
   untaggedSumRep f = GR.Argument <$> JSON.readImpl f
 
 
+-- | A helper function to wrap the complexities of throwing an error
+-- | from a custom JSON reader.
 throwJSONError :: forall a. Foreign.ForeignError -> Foreign.F a
 throwJSONError err =
   throwError $ NonEmptyList $ NonEmpty err L.Nil