[FEAT] SQL fun to insert postagging
[gargantext.git] / bin / gargantext-import / Main.hs
index e6877ec4c90725c57e0cf0279d971f53cd86b96e..073aa6aac2a331c6eab67a97664ad9764d374ece 100644 (file)
@@ -11,42 +11,77 @@ Import a corpus binary.
 
  -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE Strict            #-}
 
 module Main where
 
 import Control.Exception (finally)
-import Servant (ServantErr)
-import Gargantext.Prelude
-import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
-import Gargantext.Text.Parsers (FileFormat(CsvHalFormat))
-import Gargantext.Database.Utils (Cmd, )
-import Gargantext.Database.Types.Node (CorpusId)
---import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
-import Gargantext.API.Node () -- instances
-import Gargantext.API.Settings (newDevEnvWith, runCmdDev, DevEnv)
+import Data.Either
+import Data.Text (Text)
+import Prelude (read)
 import System.Environment (getArgs)
+import qualified Data.Text as Text
+
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Admin.EnvTypes (DevEnv(..))
+import Gargantext.API.Node () -- instances
+import Gargantext.API.Prelude (GargError)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire, TermType(..))
+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(..))
 
 main :: IO ()
 main = do
-  [iniPath, name, corpusPath] <- getArgs
+  [fun, user, name, iniPath, limit, corpusPath] <- getArgs
+
+  --{-
 
-  {-let createUsers :: Cmd ServantErr Int64
-      createUsers = insertUsers [gargantuaUser,simpleUser]
-  -}
+  let
+    --tt = (Unsupervised EN 6 0 Nothing)
+    tt = (Multi EN)
+    format = CsvGargV3 -- CsvHal --WOS
+    corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+    corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt  format corpusPath
 
-  let cmdCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
-      cmdCorpus = flowCorpus CsvHalFormat corpusPath (cs name)
+    corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath
 
-     -- cmd = {-createUsers >>-} cmdCorpus
+    annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+    annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath
 
-  env <- newDevEnvWith iniPath
-  -- Better if we keep only one call to runCmdDev.
-  _ <- runCmdDev env cmdCorpus
-  pure ()
+  {-
+  let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+      debatCorpus = do
+        docs <- liftIO ( splitEvery 500
+                       <$> take (read limit :: Int)
+                       <$> readFile corpusPath
+                       :: IO [[GrandDebatReference ]]
+                       )
+        flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
+  --}
 
+  withDevEnv iniPath $ \env -> do
+    _ <- if fun == "corpus"
+          then runCmdDev env corpus
+          else pure 0 --(cs "false")
 
+    _ <- if fun == "corpusCsvHal"
+          then runCmdDev env corpusCsvHal
+          else pure 0 --(cs "false")
+    _ <- if fun == "annuaire"
+            then runCmdDev env annuaire
+            else pure 0
+    {-
+    _ <- if corpusType == "csv"
+            then runCmdDev env csvCorpus
+            else if corpusType == "debat"
+              then runCmdDev env debatCorpus
+              else panic "corpusType unknown: try \"csv\" or \"debat\""
+    -}
+    pure ()