[WIP] how to clean data text coming from a Book from Gutemberg
[gargantext.git] / bin / gargantext-upgrade / Main.hs
index 12a9291d9f6dd13455d3d431db32a5eadffaef35..f6196760838a8f4118343a360c16afbcba72d021 100644 (file)
@@ -12,36 +12,277 @@ Import a corpus binary.
  -}
 
 {-# LANGUAGE Strict            #-}
+{-# LANGUAGE QuasiQuotes       #-}
 
 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.Prelude (GargError)
 import Gargantext.API.Node () -- instances only
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye
-import Gargantext.Database.Prelude (Cmd'', )
+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.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Prelude (getLine)
 import System.Environment (getArgs)
-
--- | PosTag
-import Gargantext.Database.Action.Flow (indexAllDocumentsWithPosTag)
-import Gargantext.Database.Query.Table.NgramsPostag (createTable_NgramsPostag)
+import qualified Data.List as List (cycle, concat, take, unlines)
 
 main :: IO ()
 main = do
-  [iniPath] <- getArgs
+
+  let ___ = putStrLn $ List.concat $ List.take 72 $ List.cycle ["_"]
+
+  ___
+  putStrLn "GarganText upgrade to version 0.0.5"
+  ___
+
+  params@[iniPath] <- getArgs
+  _ <- if length params /= 1
+         then panic "Usage: ./gargantext-upgrade gargantext.ini"
+         else pure ()
+
+  putStrLn $ List.unlines
+           [ "Your Database defined in gargantext.ini will be upgraded."
+           , "We stronlgy recommend you to make a backup using pg_dump."
+           , ""
+           , "If you encounter issues, please report your bugs here:"
+           , "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/101"
+           , ""
+           , "Press ENTER if you want to continue, CTRL+C if you want to stop."
+           ]
+  
+  _ok  <- getLine
+
+  cfg       <- readConfig         iniPath
+  let secret = _gc_secretkey cfg
 
   let
-    upgrade :: Cmd'' DevEnv GargError ()
-    upgrade = do
-      _ <- createTable_NgramsPostag
-      _ <- indexAllDocumentsWithPosTag
+    contextsTriggers :: Cmd GargError ()
+    contextsTriggers = do
+      (masterUserId, _masterRootId, masterCorpusId)
+                  <- getOrMk_RootWithCorpus (UserName userMaster)
+                                            (Left corpusMasterName)
+                                            (Nothing :: Maybe HyperdataCorpus)
+      masterListId <- getOrMkList masterCorpusId masterUserId
+      _triggers    <- initLastTriggers masterListId
       pure ()
 
+
   withDevEnv iniPath $ \env -> do
-    _ <- runCmdDev env upgrade
-    putStrLn "Uprade"
-  pure ()
+    -- First upgrade the Database Schema
+    _ <- runCmdDev env sqlSchema
+
+    -- Then upgrade the triggers
+    _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
+    _ <- runCmdDev env (contextsTriggers         :: Cmd GargError ())
+
+   -- Move nodes to contexts table 
+    _ <- runCmdDev env sqlNodes2Contexts
+
+   -- Update the hashes
+    _ <- runCmdDev env sqlUpdateTriggerHash
+
+    ___
+    putStrLn "Uprade done with success !"
+    ___
+    pure ()
+
+
+
+sqlUpdateTriggerHash :: Cmd'' DevEnv IOException Int64
+sqlUpdateTriggerHash = do
+  execPGSQuery query ()
+    where
+      query = [sql|
+      UPDATE nodes    SET typename = typename;
+      UPDATE contexts SET typename = typename;
+     |]
+
+
+sqlNodes2Contexts :: Cmd'' DevEnv IOException Int64
+sqlNodes2Contexts = do
+  execPGSQuery query (toDBid NodeDocument,toDBid NodeContact)
+    where
+      query = [sql|
+        -- WITH docs (id,hash_id,typename,user_id,parent_id,name,date,hyperdata, search)
+        WITH docs AS (SELECT * from nodes  WHERE nodes.typename IN (?,?)),
+
+        inserted (id, hash_id) AS (
+          INSERT INTO contexts (hash_id,typename,user_id,parent_id,name,date,hyperdata, search)
+            SELECT d.hash_id,d.typename,d.user_id,NULL,d.name,d.date,d.hyperdata,search FROM docs AS d
+            RETURNING contexts.id, contexts.hash_id
+         ),
+
+        indexed (node_id, context_id) AS (
+          SELECT docs.id, inserted.id from inserted
+          JOIN docs on docs.hash_id = inserted.hash_id
+        ),
+
+        -- nodes_nodes -> nodes_contexts
+        nodes_contexts_query AS (
+        INSERT INTO nodes_contexts (node_id, context_id,score, category)
+        SELECT nn.node1_id,i.context_id,nn.score,nn.category FROM nodes_nodes nn
+        JOIN indexed i ON i.node_id = nn.node2_id
+        ),
+
+        -- nodes_nodes_ngrams -> contexts_nodes_ngrams
+        contexts_nodes_ngrams_query AS (
+        INSERT INTO context_node_ngrams
+        SELECT i.context_id, nnn.node1_id, nnn.ngrams_id, nnn.ngrams_type, nnn.weight FROM node_node_ngrams nnn
+        JOIN indexed i ON i.node_id = nnn.node2_id
+        ),
+
+        ---- nodes_nodes_ngrams2 -> contexts_nodes_ngrams2
+        context_node_ngrams2_query AS (
+        INSERT INTO context_node_ngrams2
+        SELECT i.context_id, nnn2.nodengrams_id, nnn2.weight FROM node_node_ngrams2 nnn2
+        JOIN indexed i ON i.node_id = nnn2.node_id
+        )
+
+        -- WITH CASCADE it should update others tables
+        DELETE FROM nodes n
+        USING indexed i WHERE i.node_id = n.id
+        ;
+
+        UPDATE contexts SET parent_id = id;
+
+
+  |]
+
+
+
+
+
+sqlSchema :: Cmd'' DevEnv IOException Int64
+sqlSchema = do
+  execPGSQuery query ()
+    where
+      query = [sql|
+        -- TODO typename -> type_id
+        CREATE TABLE public.contexts (
+            id        SERIAL,
+            hash_id   CHARACTER varying(66) DEFAULT ''::character varying NOT NULL,
+            typename  INTEGER NOT NULL,
+            user_id   INTEGER NOT NULL,
+            parent_id INTEGER REFERENCES public.contexts(id) ON DELETE CASCADE ,
+            name      CHARACTER varying(255) DEFAULT ''::character varying NOT NULL,
+            date      TIMESTAMP with time zone DEFAULT now() NOT NULL,
+            hyperdata jsonb DEFAULT '{}'::jsonb NOT NULL,
+            search tsvector,
+            PRIMARY KEY (id),
+            FOREIGN KEY (user_id)  REFERENCES public.auth_user(id) ON DELETE CASCADE
+        );
+        ALTER TABLE public.contexts OWNER TO gargantua;
+
+
+
+        -- To attach contexts to a Corpus
+        CREATE TABLE public.nodes_contexts (
+            node_id    INTEGER NOT NULL REFERENCES public.nodes(id)    ON DELETE CASCADE,
+            context_id INTEGER NOT NULL REFERENCES public.contexts(id) ON DELETE CASCADE,
+            score    REAL    ,
+            category INTEGER ,
+            PRIMARY KEY (node_id, context_id)
+        );
+        ALTER TABLE public.nodes_contexts OWNER TO gargantua;
+
+         ---------------------------------------------------------------
+        CREATE TABLE public.context_node_ngrams (
+            context_id    INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
+            node_id       INTEGER NOT NULL REFERENCES public.nodes    (id) ON DELETE CASCADE,
+            ngrams_id     INTEGER NOT NULL REFERENCES public.ngrams   (id) ON DELETE CASCADE,
+            ngrams_type   INTEGER  ,
+            weight double precision,
+            PRIMARY KEY (context_id, node_id, ngrams_id, ngrams_type)
+          );
+
+
+        ALTER TABLE public.context_node_ngrams OWNER TO gargantua;
+
+        CREATE TABLE public.context_node_ngrams2 (
+            context_id      INTEGER NOT NULL REFERENCES public.contexts  (id)       ON DELETE CASCADE,
+            nodengrams_id   INTEGER NOT NULL REFERENCES public.node_ngrams  (id) ON DELETE CASCADE,
+            weight double   precision,
+            PRIMARY KEY (context_id, nodengrams_id)
+        );
+        ALTER TABLE public.context_node_ngrams2 OWNER TO gargantua;
+
+
+
+        CREATE INDEX        ON public.contexts USING gin (hyperdata);
+        CREATE INDEX        ON public.contexts USING btree (user_id, typename, parent_id);
+        CREATE INDEX        ON public.contexts USING btree (id, typename, date ASC);
+        CREATE INDEX        ON public.contexts USING btree (id, typename, date DESC);
+        CREATE INDEX        ON public.contexts USING btree (typename, id);
+        CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
+
+
+        -- To make the links between Corpus Node and its contexts
+        CREATE UNIQUE INDEX ON public.nodes_contexts  USING btree (node_id, context_id);
+        CREATE INDEX        ON public.nodes_contexts  USING btree (node_id, context_id, category);
+
+
+        ------------------------------------------------------------------------
+        CREATE UNIQUE INDEX ON public.context_node_ngrams USING btree (context_id, node_id, ngrams_id, ngrams_type);
+        CREATE        INDEX ON public.context_node_ngrams USING btree (context_id,  node_id);
+        CREATE        INDEX ON public.context_node_ngrams USING btree (ngrams_id, node_id);
+        CREATE        INDEX ON public.context_node_ngrams USING btree (ngrams_type);
+
+        CREATE INDEX ON public.context_node_ngrams2 USING btree (context_id);
+        CREATE INDEX ON public.context_node_ngrams2 USING btree (nodengrams_id);
+        CREATE INDEX ON public.context_node_ngrams2 USING btree (context_id, nodengrams_id);
+
+        DROP TABLE if EXISTS public.node_nodengrams_nodengrams;
+
+        DROP TRIGGER if EXISTS trigger_count_delete2    ON nodes_nodes;
+        DROP TRIGGER if EXISTS trigger_count_update_add ON nodes_nodes;
+        DROP TRIGGER if EXISTS trigger_delete_count     ON nodes_nodes;
+        DROP TRIGGER if EXISTS trigger_insert_count     ON nodes_nodes;
+
+
+        -- Indexes needed to speed up the deletes
+        -- Trigger for constraint node_ngrams_node_id_fkey
+        CREATE INDEX IF NOT EXISTS node_ngrams_node_id_idx       ON public.node_ngrams USING btree (node_id);
+
+        -- Trigger for constraint node_node_ngrams2_node_id_fkey
+        CREATE INDEX IF NOT EXISTS node_node_ngrams2_node_id_idx ON public.node_node_ngrams2 USING btree (node_id);
+
+        -- Trigger for constraint node_node_ngrams_node1_id_fkey
+        CREATE INDEX IF NOT EXISTS node_node_ngrams_node1_id_idx  ON public.node_node_ngrams USING btree (node1_id);
+
+        -- Trigger for constraint node_node_ngrams_node2_id_fkey
+        CREATE INDEX IF NOT EXISTS node_node_ngrams_node2_id_idx  ON public.node_node_ngrams USING btree (node2_id);
+
+        -- Trigger for constraint nodes_nodes_node1_id_fkey
+        CREATE INDEX IF NOT EXISTS nodes_nodes_node1_id_idx ON public.nodes_nodes USING btree (node1_id);
+        -- Trigger for constraint nodes_nodes_node2_id_fkey
+        CREATE INDEX IF NOT EXISTS nodes_nodes_node2_id_idx ON public.nodes_nodes USING btree (node2_id);
+
+        -- Trigger for constraint nodes_parent_id_fkey
+        CREATE INDEX IF NOT EXISTS nodes_parent_id_idx ON public.nodes USING btree (parent_id);
+
+        -- Trigger for constraint rights_node_id_fkey
+        CREATE INDEX IF NOT EXISTS rights_node_id_idx ON public.rights USING btree (node_id);
+
+        -- Trigger for constraint nodes_contexts_node_id_fkey
+        CREATE INDEX IF NOT EXISTS nodes_contexts_node_id_idx ON public.nodes_contexts USING btree (node_id);
+
+        -- Trigger for constraint context_node_ngrams_node_id_fkey
+        CREATE INDEX IF NOT EXISTS context_node_node_id_idx ON public.context_node_ngrams USING btree (node_id);
+
+  |]
+
+
+