[UPGRADE] main functions for upgrade (WIP)

bin/gargantext-upgrade/Main.hs

@@ -26,6 +26,9 @@ import Gargantext.Prelude
 import System.Environment (getArgs)
 
 
+
+
+
 main :: IO ()
 main = do
   [iniPath] <- getArgs

src/Gargantext/Database/Action/Flow.hs

@@ -41,6 +41,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
   , allDataOrigins
 
   , do_api
+  , upgrade
   )
     where
 
@@ -92,13 +93,18 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Query.Table.NodeNodeNgrams2
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
-import Gargantext.Database.Schema.Node (NodePoly(..))
+import Gargantext.Database.Schema.Node (NodePoly(..), node_id)
 import Gargantext.Database.Types
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 
+------------------------------------------------------------------------
+-- Impots for upgrade function
+import Gargantext.Database.Query.Tree.Root (getRootId)
+import Gargantext.Database.Query.Tree (findNodesId)
+import qualified Data.List as List
 ------------------------------------------------------------------------
 -- TODO use internal with API name (could be old data)
 data DataOrigin = InternalOrigin { _do_api :: API.ExternalAPIs }
@@ -432,3 +438,38 @@ instance HasText a => HasText (Node a)
     hasText (Node _ _ _ _ _ _ _ h) = hasText h
 
 
+
+
+-- | Upgrade function
+-- Suppose all documents are English (this is the case actually)
+upgrade :: FlowCmdM env err m => m ()
+upgrade = do
+  rootId    <- getRootId (UserName userMaster)
+  corpusIds <- findNodesId rootId [NodeCorpus]
+  docs      <- List.concat <$> mapM getDocumentsWithParentId [NodeId 5]
+
+  printDebug "Nb of docs" (List.length docs)
+
+  let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
+
+  mapNgramsDocs' :: HashMap ExtractedNgrams (Map NgramsType (Map NodeId Int))
+                <- mapNodeIdNgrams
+                <$> documentIdWithNgrams
+                    (extractNgramsT $ withLang (Multi EN) documentsWithId)
+                    documentsWithId
+
+  terms2id <- insertExtractedNgrams $ HashMap.keys mapNgramsDocs'
+
+  pure ()
+
+
+
+
+
+
+
+
+
+
+
+

src/Gargantext/Database/Prelude.hs

@@ -25,7 +25,7 @@ import Data.Either.Extra (Either(Left, Right))
 import Data.Ini (readIniFile, lookupValue)
 import Data.Pool (Pool, withResource)
 import Data.Profunctor.Product.Default (Default)
-import Data.Text (unpack, pack)
+import Data.Text (unpack, pack, Text)
 import Data.Word (Word16)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
@@ -136,6 +136,18 @@ runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
       hPutStrLn stderr q'
       throw (SomeException e)
 
+-- | TODO catch error
+runPGSQuery_ :: ( CmdM env err m
+               , PGS.FromRow r
+               )
+               => PGS.Query -> m [r]
+runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
+  where
+    printError (SomeException e) = do
+      printDebug "[G.D.P.runPGSQuery_]" ("TODO: format query error query" :: Text)
+      throw (SomeException e)
+
+
 
 execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
 import Data.Text (Text)
 import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Query.Table.Ngrams
@@ -179,4 +179,28 @@ querySelectLems = [sql|
   SELECT t1,t2 from lems
   |]
 
+-- | Insert Table
+createTable_NgramsPostag :: Cmd err [(Form, Lem)]
+createTable_NgramsPostag = runPGSQuery_ queryCreateTable
+  where
+    queryCreateTable :: PGS.Query
+    queryCreateTable = [sql|
+
+    CREATE TABLE public.ngrams_postag (
+        id SERIAL,
+        lang_id INTEGER,
+        algo_id INTEGER,
+        postag CHARACTER varying(5),
+        ngrams_id INTEGER NOT NULL,
+        lemm_id   INTEGER NOT NULL,
+        score     INTEGER DEFAULT 1 ::integer NOT NULL,
+        FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE,
+        FOREIGN KEY (lemm_id)   REFERENCES public.ngrams(id) ON DELETE CASCADE
+    );
+    -- ALTER TABLE public.ngrams_postag OWNER TO gargantua;
+
+    CREATE UNIQUE INDEX ON public.ngrams_postag (lang_id,algo_id,postag,ngrams_id,lemm_id);
+
+      |]
+