Merge branch 'dev-ngrams-repo' of ssh://delanoe.org/haskell-gargantext into dev-ngrams-repo

bin/gargantext-import/Main.hs

@@ -19,6 +19,7 @@ Import a corpus binary.
 
 module Main where
 
+import Control.Exception (finally)
 import Servant (ServantErr)
 import Gargantext.Prelude
 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
@@ -27,7 +28,7 @@ import Gargantext.Database.Utils (Cmd, connectGargandb, runCmdDev)
 import Gargantext.Database.Types.Node (CorpusId)
 --import Gargantext.Database.Schema.User (insertUsers, gargantuaUser, simpleUser)
 import Gargantext.API.Node () -- instances
-import Gargantext.API.Settings (newDevEnvWith, DevEnv)
+import Gargantext.API.Settings (newDevEnvWith, cleanEnv, DevEnv)
 import System.Environment (getArgs)
 
 main :: IO ()
@@ -36,14 +37,16 @@ main = do
 
   env <- newDevEnvWith iniPath
 
-  {-let createUsers :: Cmd ServantErr Int64
-      createUsers = insertUsers [gargantuaUser,simpleUser]
-  _ <- runCmdDev env createUsers
-  -}
-
-  let cmd :: FlowCmdM DevEnv ServantErr m => m CorpusId
-      cmd = flowCorpus CsvHalFormat corpusPath (cs name)
-  r <- runCmdDev env cmd
-  pure ()
+  (do
+    {-let createUsers :: Cmd ServantErr Int64
+        createUsers = insertUsers [gargantuaUser,simpleUser]
+    _ <- runCmdDev env createUsers
+    -}
+
+    let cmd :: FlowCmdM DevEnv ServantErr m => m CorpusId
+        cmd = flowCorpus CsvHalFormat corpusPath (cs name)
+    _ <- runCmdDev env cmd
+    pure ()
+    ) `finally` cleanEnv env
 
 

src/Gargantext/API.hs

@@ -44,6 +44,7 @@ import           GHC.Generics (D1, Meta (..), Rep)
 import           GHC.TypeLits (AppendSymbol, Symbol)
 
 import           Control.Lens
+import           Control.Exception (finally)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Reader (runReaderT)
 import           Data.Aeson.Encode.Pretty (encodePretty)
@@ -72,7 +73,7 @@ import Gargantext.Prelude
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
-import Gargantext.API.Ngrams (HasRepoVar)
+import Gargantext.API.Ngrams (HasRepoVar(..))
 import Gargantext.API.Node ( GargServer
                            , Roots    , roots
                            , NodeAPI  , nodeAPI
@@ -369,6 +370,11 @@ portRouteInfo port = do
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
+stopGargantext :: HasRepoVar env => env -> IO ()
+stopGargantext env = do
+  T.putStrLn "----- Stopping gargantext -----"
+  cleanEnv env
+
 -- | startGargantext takes as parameters port number and Ini file.
 startGargantext :: PortNumber -> FilePath -> IO ()
 startGargantext port file = do
@@ -376,7 +382,7 @@ startGargantext port file = do
   portRouteInfo port
   app <- makeApp env
   mid <- makeDevMiddleware
-  run port $ mid app
+  run port (mid app) `finally` stopGargantext env
 
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do

src/Gargantext/API/Ngrams.hs

@@ -568,6 +568,14 @@ data Repo s p = Repo
   , _r_history :: [p]
     -- ^ first patch in the list is the most recent
   }
+  deriving (Generic)
+
+instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
+  parseJSON = genericParseJSON $ unPrefix "_r_"
+
+instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
+  toJSON     = genericToJSON     $ unPrefix "_r_"
+  toEncoding = genericToEncoding $ unPrefix "_r_"
 
 makeLenses ''Repo
 

src/Gargantext/API/Settings.hs

@@ -22,16 +22,18 @@ Portability : POSIX
 module Gargantext.API.Settings
     where
 
+import System.Directory
 import System.Log.FastLogger
 import GHC.Enum
 import GHC.Generics (Generic)
-import Prelude (Bounded())
+import Prelude (Bounded(), fail)
 import System.Environment (lookupEnv)
 import System.IO (FilePath)
 import Database.PostgreSQL.Simple (Connection, connect)
 import Network.HTTP.Client (Manager)
 import Network.HTTP.Client.TLS (newTlsManager)
 
+import Data.Aeson
 import Data.Maybe (fromMaybe)
 import Data.Either (either)
 import Data.Text
@@ -50,7 +52,7 @@ import Control.Monad.Logger
 import Control.Lens
 import Gargantext.Prelude
 import Gargantext.Database.Utils (databaseParameters, HasConnection(..))
-import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initMockRepo)
+import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), initMockRepo, r_version)
 import Gargantext.API.Orchestrator.Types
 
 type PortNumber = Int
@@ -152,6 +154,26 @@ data MockEnv = MockEnv
 
 makeLenses ''MockEnv
 
+repoSnapshot :: FilePath
+repoSnapshot = "repo.json"
+
+readRepo :: IO (MVar NgramsRepo)
+readRepo = do
+  repoExists <- doesFileExist repoSnapshot
+  newMVar =<<
+    if repoExists
+      then do
+        e_repo <- eitherDecodeFileStrict repoSnapshot
+        repo <- either fail pure e_repo
+        let archive = repoSnapshot <> ".v" <> show (repo ^. r_version)
+        renameFile repoSnapshot archive
+        pure repo
+      else
+        pure initMockRepo
+
+cleanEnv :: HasRepoVar env => env -> IO ()
+cleanEnv env = encodeFile repoSnapshot =<< readMVar (env ^. repoVar)
+
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
   manager <- newTlsManager
@@ -161,7 +183,7 @@ newEnv port file = do
   self_url <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   param <- databaseParameters file
   conn <- connect param
-  repo_var <- newMVar initMockRepo
+  repo_var <- readRepo
   scrapers_env <- newJobEnv defaultSettings manager
   logger <- newStderrLoggerSet defaultBufSize
   pure $ Env

src/Gargantext/Database/Schema/Ngrams.hs

@@ -28,6 +28,7 @@ module Gargantext.Database.Schema.Ngrams where
 import Data.Aeson (FromJSON, FromJSONKey)
 import Control.Lens (makeLenses, view, over)
 import Control.Monad (mzero)
+import Data.Aeson
 import Data.ByteString.Internal (ByteString)
 import Data.Map (Map, fromList, lookup, fromListWith)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
@@ -105,6 +106,8 @@ data NgramsType = Authors | Institutes | Sources | NgramsTerms
 
 instance FromJSON NgramsType
 instance FromJSONKey NgramsType
+instance ToJSON NgramsType
+instance ToJSONKey NgramsType
 
 newtype NgramsTypeId = NgramsTypeId Int
   deriving (Eq, Show, Ord, Num)

src/Gargantext/Database/Types/Node.hs

@@ -60,7 +60,7 @@ import           Gargantext.Core.Utils.Prefix (unPrefix)
 --import Gargantext.Database.Utils
 ------------------------------------------------------------------------
 newtype NodeId = NodeId Int
-  deriving (Show, Read, Generic, Num, Eq, Ord, Enum)
+  deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON)
 
 instance ToField NodeId where
   toField (NodeId n) = toField n
@@ -71,10 +71,7 @@ instance FromField NodeId where
     if (n :: Int) > 0 then return $ NodeId n
                       else mzero
 
-instance ToJSON      NodeId
-instance FromJSON    NodeId
-instance FromJSONKey NodeId
-instance ToSchema    NodeId
+instance ToSchema NodeId
 
 instance FromHttpApiData NodeId where
   parseUrlPiece n = pure $ NodeId $ (read . cs) n