[OPTIM][FIX] serialise/deserialise without encode/decode json
[gargantext.git] / bin / gargantext-import / Main.hs
index 5ff7b5b8c09086bc376a858ec49192c229db3b20..fbd625943d71643c5103f48b2179882eebe581dc 100644 (file)
@@ -19,31 +19,80 @@ Import a corpus binary.
 
 module Main where
 
-import Servant (ServantErr)
-import Gargantext.Prelude
-import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
-import Gargantext.Text.Parsers (FileFormat(CsvHalFormat))
-import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDev)
-import Gargantext.Database.Types.Node (CorpusId)
---import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
+import Control.Exception (finally)
+import Data.Either
+import Data.Text (Text)
 import Gargantext.API.Node () -- instances
-import Gargantext.API.Settings (newDevEnvWith, DevEnv)
+import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev, DevEnv)
+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.Query.Table.User (insertUsersDemo)
+import Gargantext.Database.Admin.Types.Node (CorpusId, toHyperdataDocument)
+import Gargantext.Database.Prelude (Cmd, )
+import Gargantext.Prelude
+import Gargantext.Text.Corpus.Parsers (FileFormat(..))
+import Prelude (read)
 import System.Environment (getArgs)
+import qualified Data.Text as Text
 
 main :: IO ()
 main = do
-  [iniPath, name, corpusPath] <- getArgs
+  [fun, user, name, iniPath, limit, corpusPath] <- getArgs
+
+  --{-
+
+  let createUsers :: Cmd GargError Int64
+      createUsers = insertUsersDemo
+  
+  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
+
+    corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath
+
+    annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
+    annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath
+
 
-  env <- newDevEnvWith iniPath
+  {-
+  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)
+  --}
 
-  {-let createUsers :: Cmd ServantErr Int64
-      createUsers = insertUsers [gargantuaUser,simpleUser]
-  _ <- runCmdDev env createUsers
-  -}
+  withDevEnv iniPath $ \env -> do
+    _ <- if fun == "users"
+          then runCmdDev env createUsers
+          else pure 0 --(cs "false")
 
-  let cmd :: FlowCmdM DevEnv ServantErr m => m CorpusId
-      cmd = flowCorpus CsvHalFormat corpusPath (cs name)
-  r <- runCmdDev env cmd
-  pure ()
+    _ <- 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 ()