Merge remote-tracking branch 'origin/250-dev-fix-corpus-hyperdata-update' into dev-merge

bin/gargantext-import/Main.hs

@@ -15,9 +15,7 @@ Import a corpus binary.
 
 module Main where
 
-import Control.Exception (finally)
 import Data.Either
-import Data.Maybe (Maybe(..))
 import Data.Text (Text)
 import System.Environment (getArgs)
 import qualified Data.Text as Text
@@ -25,7 +23,6 @@ import Text.Read (readMaybe)
 
 import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
 import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
-import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Node () -- instances
 import Gargantext.API.Prelude (GargError)
 import Gargantext.Core (Lang(..))
@@ -33,9 +30,7 @@ import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Query (Limit)
 import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
-import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
 import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
 import Gargantext.Utils.Jobs (MonadJobStatus, JobHandle)

bin/gargantext-server/Main.hs

@@ -21,14 +21,9 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
 module Main where
 
 
-import Data.Maybe (fromMaybe)
 import Data.Text (unpack)
 import Data.Version (showVersion)
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import GHC.IO.Exception (IOException)
 import Gargantext.API (startGargantext, Mode(..)) -- , startGargantextMock)
-import Gargantext.API.Admin.EnvTypes (DevEnv)
-import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.Prelude
 import Options.Generic
 import System.Exit (exitSuccess)

bin/gargantext-upgrade/Main.hs

@@ -16,22 +16,8 @@ Import a corpus binary.
 
 module Main where
 
-import Data.Either (Either(..))
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import GHC.IO.Exception (IOException)
-import Gargantext.API.Admin.EnvTypes (DevEnv)
-import Gargantext.API.Dev (withDevEnv, runCmdDev)
-import Gargantext.API.Ngrams.Tools (migrateFromDirToDb)
+import Gargantext.API.Dev (withDevEnv)
 import Gargantext.API.Node () -- instances only
-import Gargantext.API.Prelude (GargError)
-import Gargantext.Core (HasDBid(toDBid))
-import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
-import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
-import Gargantext.Database.Admin.Trigger.Init
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
-import Gargantext.Database.Admin.Types.Node (NodeType(NodeDocument, NodeContact))
-import Gargantext.Database.Prelude (Cmd'', Cmd, execPGSQuery)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
 import Prelude (getLine)

src/Gargantext/API/Node.hs

@@ -192,9 +192,7 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
 ------------------------------------------------------------------------
 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 nodeAPI :: forall proxy a.
-       ( JSONB a
-       , FromJSON a
-       , ToJSON a
+       ( HyperdataC a
        ) => proxy a
          -> UserId
          -> NodeId
@@ -348,7 +346,7 @@ treeFlatAPI = tree_flat
 rename :: NodeId -> RenameNode -> Cmd err [Int]
 rename nId (RenameNode name') = U.update (U.Rename nId name')
 
-putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
+putNode :: forall err a. (HasNodeError err, HyperdataC a)
         => NodeId
         -> a
         -> Cmd err Int

src/Gargantext/API/Node/Corpus/Update.hs

@@ -3,18 +3,18 @@ module Gargantext.API.Node.Corpus.Update
   ( addLanguageToCorpus )
   where
 
+import Control.Lens
+import Control.Monad
+import Data.Proxy
 import Gargantext.Core
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Prelude
-import Gargantext.Utils.Jobs
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node
-import Data.Proxy
-import Control.Lens
-import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Control.Monad
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import Gargantext.Utils.Jobs
 
 -- | Updates the 'HyperdataCorpus' with the input 'Lang'.
 addLanguageToCorpus :: (FlowCmdM env err m, MonadJobStatus m)
@@ -24,4 +24,4 @@ addLanguageToCorpus :: (FlowCmdM env err m, MonadJobStatus m)
 addLanguageToCorpus cId lang = do
   hyperNode <- getNodeWith cId (Proxy @HyperdataCorpus)
   let hyperNode' = hyperNode & over node_hyperdata (\corpus -> corpus { _hc_lang = Just lang })
-  void $ updateHyperdata cId hyperNode'
+  void $ updateHyperdata cId $ hyperNode' ^. node_hyperdata

src/Gargantext/Database/Admin/Types/Hyperdata.hs

@@ -41,7 +41,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Folder
 import Gargantext.Database.Admin.Types.Hyperdata.Frame
 import Gargantext.Database.Admin.Types.Hyperdata.List
 import Gargantext.Database.Admin.Types.Hyperdata.Model
-import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata, HyperdataC)
 import Gargantext.Database.Admin.Types.Hyperdata.Texts
 import Gargantext.Database.Admin.Types.Hyperdata.Phylo
 import Gargantext.Database.Admin.Types.Hyperdata.User

src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs

@@ -35,7 +35,7 @@ data HyperdataCorpus =
                   -- 'defaultLanguage' if we don't know which language it is.
                   , _hc_lang           :: Maybe Lang
                   }
-    deriving (Generic)
+    deriving (Generic, Show)
 
 defaultHyperdataCorpus :: HyperdataCorpus
 defaultHyperdataCorpus =

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

+{-# LANGUAGE ConstraintKinds #-}
+
 {-|
 Module      : Gargantext.Database.Admin.Types.Hyperdata.Prelude
 Description :
@@ -29,6 +31,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   , module Test.QuickCheck
   , module Test.QuickCheck.Arbitrary
   , Hyperdata
+  , HyperdataC
   , Chart(..)
   )
   where
@@ -46,7 +49,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-import Gargantext.Database.Prelude (fromField')
+import Gargantext.Database.Prelude (fromField', JSONB)
 import Gargantext.Prelude
 import Opaleye (DefaultFromField, defaultFromField, Nullable, SqlJsonb, fromPGSFromField)
 import Test.QuickCheck (elements)
@@ -56,6 +59,12 @@ import Test.QuickCheck.Arbitrary hiding (vector)
 -- Only Hyperdata types should be member of this type class.
 class Hyperdata a
 
+type HyperdataC a = ( Hyperdata a
+                    , JSONB a
+                    , ToJSON a
+                    , FromJSON a
+                    , FromField a )
+
 
 data Chart =
     CDocsHistogram

src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs

@@ -16,23 +16,24 @@ module Gargantext.Database.Query.Table.Node.UpdateOpaleye
   where
 
 import Opaleye
-import Data.Aeson (encode, ToJSON)
+import Data.Aeson (encode)
 import Gargantext.Core
 import Gargantext.Prelude
 import Gargantext.Database.Schema.Node
+import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, mkCmd, JSONB)
+import Gargantext.Database.Prelude (Cmd, mkCmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 
 import Debug.Trace (trace)
 
-updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64
+updateHyperdata :: HyperdataC a => NodeId -> a -> Cmd err Int64
 updateHyperdata i h = mkCmd $ \c -> putStrLn "before runUpdate_" >>
                                     runUpdate_ c (updateHyperdataQuery i h) >>= \res ->
                                     putStrLn "after runUpdate_" >> return res
 
-updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
+updateHyperdataQuery :: HyperdataC a => NodeId -> a -> Update Int64
 updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $ Update
    { uTable      = nodeTable
    , uUpdateWith = updateEasy (\  (Node { .. })
@@ -46,18 +47,16 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
 
 ----------------------------------------------------------------------------------
 updateNodesWithType :: ( HasNodeError err
-                       , JSONB a
-                       , ToJSON a
                        , HasDBid NodeType
+                       , HyperdataC a
                        ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
 updateNodesWithType nt p f = do
   ns <- getNodesWithType nt p
   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
 
 updateNodeWithType :: ( HasNodeError err
-                      , JSONB a
-                      , ToJSON a
                       , HasDBid NodeType
+                      , HyperdataC a
                       ) => NodeId
                         -> NodeType
                         -> proxy a
@@ -70,8 +69,7 @@ updateNodeWithType nId nt p f = do
 
 -- | In case the Hyperdata Types are not compatible
 updateNodesWithType_ :: ( HasNodeError err
-                        , JSONB a
-                        , ToJSON a
+                        , HyperdataC a
                         , HasDBid NodeType
                         ) => NodeType -> a -> Cmd err [Int64]
 updateNodesWithType_ nt h = do