Merge branch 'dev' into dev-getting-started-readme

devops/postgres/schema.sql

@@ -166,7 +166,7 @@ CREATE INDEX        ON public.nodes_nodes  USING btree (node1_id, node2_id, cate
 CREATE UNIQUE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id, ngrams_id, ngrams_type);
 CREATE        INDEX ON public.node_node_ngrams USING btree (node1_id,  node2_id);
 CREATE        INDEX ON public.node_node_ngrams USING btree (ngrams_id, node2_id);
-
+CREATE        INDEX ON public.node_node_ngrams USING btree (ngrams_type);
 CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_id, node_ngrams1_id, node_ngrams2_id);
 CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams1_id);
 CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams2_id);

src/Gargantext/API.hs

@@ -15,12 +15,14 @@ This API is indeed typed in order to be able to derive both the server
 and the client sides.
 
 The Garg-API-Monad enables:
-  - Features
+  - Security (WIP)
+  - Features (WIP)
   - Database connection (long term)
   - In Memory stack management (short term)
-  - Logs
+  - Logs (WIP)
 
-Thanks to @yannEsposito (at the start) and @np (after).
+Thanks to Yann Esposito for our discussions at the start and to Nicolas
+Pouillard (who mainly made it).
 
 -}
 
@@ -92,6 +94,7 @@ import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgra
 import Gargantext.API.Node
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.API.Types
+import qualified Gargantext.API.Export as Export
 import qualified Gargantext.API.Corpus.New as New
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
@@ -260,6 +263,9 @@ type GargPrivateAPI' =
                         :> Capture "node2_id" NodeId
                         :> NodeNodeAPI HyperdataAny
 
+           :<|> "corpus" :> Capture "node_id" CorpusId
+                         :> Export.API
+
            -- Annuaire endpoint
            :<|> "annuaire":> Summary "Annuaire endpoint"
                           :> Capture "annuaire_id" AnnuaireId
@@ -310,9 +316,11 @@ type GargPrivateAPI' =
        -- :<|> "ngrams"   :> Capture "node_id" Int  :> NodeAPI
        -- :<|> "auth"     :> Capture "node_id" Int  :> NodeAPI
 ---------------------------------------------------------------------
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 
-type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
+type API = SwaggerAPI
+       :<|> FrontEndAPI
+       :<|> GargAPI
+       :<|> Get '[HTML] Html
 
 -- This is the concrete monad. It needs to be used as little as possible,
 -- instead, prefer GargServer, GargServerT, GargServerC.
@@ -331,7 +339,8 @@ type EnvC env =
 server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
-  pure $  swaggerFront
+  pure $  schemaUiServer swaggerDoc
+     :<|> frontEndServer
      :<|> hoistServerWithContext (Proxy :: Proxy GargAPI) (Proxy :: Proxy AuthContext) transform serverGargAPI
      :<|> serverStatic
   where
@@ -361,6 +370,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
+     :<|> Export.getCorpus   -- uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)  uid
 
@@ -414,13 +424,8 @@ serverStatic = $(do
                 )
 
 ---------------------------------------------------------------------
-swaggerFront :: Server SwaggerFrontAPI
-swaggerFront = schemaUiServer swaggerDoc
-           :<|> frontEndServer
-
 --gargMock :: Server GargAPI
 --gargMock = mock apiGarg Proxy
-
 ---------------------------------------------------------------------
 makeApp :: EnvC env => env -> IO Application
 makeApp env = serveWithContext api cfg <$> server env
@@ -433,7 +438,6 @@ makeApp env = serveWithContext api cfg <$> server env
 
 --appMock :: Application
 --appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
-
 ---------------------------------------------------------------------
 api :: Proxy API
 api  = Proxy
@@ -441,12 +445,10 @@ api  = Proxy
 apiGarg :: Proxy GargAPI
 apiGarg  = Proxy
 ---------------------------------------------------------------------
-
 schemaUiServer :: (Server api ~ Handler Swagger)
         => Swagger -> Server (SwaggerSchemaUI' dir api)
 schemaUiServer = swaggerSchemaUIServer
 
-
 -- Type Family for the Documentation
 type family TypeName (x :: *) :: Symbol where
     TypeName Int  = "Int"

src/Gargantext/API/Export.hs

+{-|
+Module      : Gargantext.API.Export
+Description : Get Metrics from Storage (Database like)
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Main exports of Gargantext:
+- corpus
+- document and ngrams
+- lists
+
+-}
+
+
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeOperators     #-}
+
+module Gargantext.API.Export
+  where
+
+import Data.Aeson.TH (deriveJSON)
+import Data.Map (Map)
+import Data.Set (Set)
+import Data.Maybe (fromMaybe)
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Gargantext.API.Ngrams
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
+import Gargantext.API.Types (GargNoServer)
+import Gargantext.Core.Types --
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Config (userMaster)
+import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
+import Gargantext.Database.Node.Select (selectNodesWithUsername)
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
+import Gargantext.Database.Schema.NodeNode (selectDocNodes)
+import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
+import Gargantext.Database.Utils (Cmd)
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils (sha)
+import Servant
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.List as List
+
+
+-- Corpus Export
+data Corpus =
+  Corpus { _c_corpus :: [Document]
+         , _c_hash   :: Hash
+         } deriving (Generic)
+
+-- | Document Export
+data Document =
+  Document { _d_document :: Node HyperdataDocument
+           , _d_ngrams   :: Ngrams
+           , _d_hash     :: Hash
+           } deriving (Generic)
+
+data Ngrams =
+  Ngrams { _ng_ngrams :: [Text]
+         , _ng_hash   :: Hash
+         } deriving (Generic)
+
+type Hash = Text
+-------
+instance ToSchema Corpus where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
+
+instance ToSchema Document where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
+
+instance ToSchema Ngrams where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ng_")
+
+-------
+instance ToParamSchema Corpus where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Document where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Ngrams where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+--------------------------------------------------
+type API = Summary "Corpus Export"
+            :> "export"
+            :> QueryParam "listId"     ListId
+            :> QueryParam "ngramsType" NgramsType
+            :> Get '[JSON] Corpus
+
+--------------------------------------------------
+getCorpus :: CorpusId
+          -> Maybe ListId
+          -> Maybe NgramsType
+          -> GargNoServer Corpus
+getCorpus cId lId nt' = do
+
+  let
+    nt = case nt' of
+      Nothing -> NgramsTerms
+      Just  t -> t
+
+  ns   <- Map.fromList
+       <$> map (\n -> (_node_id n, n))
+       <$> selectDocNodes cId
+  repo <- getRepo
+  ngs  <- getNodeNgrams cId lId nt repo
+  let  -- uniqId is hash computed already for each document imported in database
+    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (ng_hash b)) (d_hash a b)
+                             ) ns ngs
+          where
+            ng_hash b   = sha $ List.foldl (\x y -> x<>y) "" $ List.sort $ Set.toList b
+            d_hash  a b = sha $ (fromMaybe "" (_hyperdataDocument_uniqId $ _node_hyperdata a))
+                             <> (ng_hash b)
+
+  pure $ Corpus (Map.elems r) (sha $ List.foldl (\a b -> a<>b) ""
+                                   $ List.map _d_hash $ Map.elems r
+                              )
+
+getNodeNgrams :: HasNodeError err
+        => CorpusId
+        -> Maybe ListId
+        -> NgramsType
+        -> NgramsRepo
+        -> Cmd err (Map NodeId (Set Text))
+getNodeNgrams cId lId' nt repo = do
+  lId <- case lId' of
+    Nothing -> defaultList cId
+    Just  l -> pure l
+
+  lIds <- selectNodesWithUsername NodeList userMaster
+  let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
+  r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
+  pure r
+
+
+$(deriveJSON (unPrefix "_c_") ''Corpus)
+$(deriveJSON (unPrefix "_d_") ''Document)
+$(deriveJSON (unPrefix "_ng_") ''Ngrams)
+
+
+-- TODO
+-- Exports List
+-- Version number of the list
+
+

src/Gargantext/API/Ngrams.hs

@@ -78,7 +78,7 @@ module Gargantext.API.Ngrams
   , HasRepo(..)
   , RepoCmdM
   , QueryParamR
-  , TODO(..)
+  , TODO
 
   -- Internals
   , getNgramsTableMap
@@ -143,7 +143,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import qualified Gargantext.Database.Schema.Ngrams as Ngrams
 -- import Gargantext.Database.Schema.NodeNgram hiding (Action)
 import Gargantext.Prelude
--- import Gargantext.Core.Types (ListTypeId, listTypeId)
+import Gargantext.Core.Types (TODO)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid)
 import Servant hiding (Patch)
 import System.Clock (getTime, TimeSpec, Clock(..))
@@ -152,12 +152,6 @@ import System.IO (stderr)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-data TODO = TODO
-  deriving (Generic)
-
-instance ToSchema TODO where
-instance ToParamSchema TODO where
-
 ------------------------------------------------------------------------
 --data FacetFormat = Table | Chart
 data TabType   = Docs   | Trash   | MoreFav | MoreTrash
@@ -1044,14 +1038,14 @@ getTableNgrams _nType nId tabType listId limit_ offset
   -- trace (show lists) $
   -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
 
-  let nSco = needsScores orderBy
+  let scoresNeeded = needsScores orderBy
   tableMap1 <- getNgramsTableMap listId ngramsType
   t1 <- getTime'
-  tableMap2 <- tableMap1 & v_data %%~ setScores nSco
+  tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
                                     . Map.mapWithKey ngramsElementFromRepo
   t2 <- getTime'
   tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
-                                    . setScores (not nSco)
+                                    . setScores (not scoresNeeded)
                                     . selectAndPaginate
   t3 <- getTime'
   liftIO $ hprint stderr
@@ -1059,7 +1053,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
                           % " map1=" % timeSpecs
                           % " map2=" % timeSpecs
                           % " map3=" % timeSpecs
-                          % " sql="  % (if nSco then "map2" else "map3")
+                          % " sql="  % (if scoresNeeded then "map2" else "map3")
                           % "\n"
             ) t0 t3 t0 t1 t1 t2 t2 t3
   pure tableMap3

src/Gargantext/API/Node.hs

@@ -12,7 +12,6 @@ Portability : POSIX
 -- TODO-ACCESS: CanGetNode
 -- TODO-EVENTS: No events as this is a read only query.
 Node API
-
 -------------------------------------------------------------------
 -- TODO-ACCESS: access by admin only.
 --              At first let's just have an isAdmin check.
@@ -51,16 +50,17 @@ import Gargantext.API.Auth (withAccess, PathId(..))
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
 import Gargantext.API.Ngrams.NTree (MyTree)
-import Gargantext.API.Search (SearchDocsAPI, searchDocs)
+import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
 import Gargantext.API.Table
 import Gargantext.API.Types
 import Gargantext.Core.Types (NodeTableResult)
 import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
 import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Database.Flow.Pairing (pairing)
 import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
-import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
+import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Tree (treeDB)
 import Gargantext.Database.Types.Node
@@ -78,7 +78,6 @@ import qualified Gargantext.Text.List.Learn as Learn
 import qualified Data.Vector as Vec
 --}
 
-
 type NodesAPI  = Delete '[JSON] Int
 
 -- | Delete Nodes
@@ -128,11 +127,16 @@ type NodeAPI a = Get '[JSON] (Node a)
              -- TODO gather it
              :<|> "table"     :> TableApi
              :<|> "ngrams"    :> TableNgramsApi
-             -- :<|> "pairing"   :> PairingApi
 
              :<|> "category"  :> CatApi
              :<|> "search"     :> SearchDocsAPI
 
+             -- Pairing utilities
+             :<|> "pairwith"   :> PairWith
+             :<|> "pairs"      :> Pairs
+             :<|> "pairing"    :> PairingApi
+             :<|> "searchPair" :> SearchPairsAPI
+
              -- VIZ
              :<|> "metrics" :> ScatterAPI
              :<|> "chart"     :> ChartApi
@@ -188,12 +192,15 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
            -- TODO gather it
            :<|> tableApi             id
            :<|> apiNgramsTableCorpus id
-           -- :<|> getPairing           id
-           -- :<|> getTableNgramsDoc id
 
            :<|> catApi      id
 
            :<|> searchDocs  id
+           -- Pairing Tools
+           :<|> pairWith    id
+           :<|> pairs       id
+           :<|> getPair     id
+           :<|> searchPairs id
 
            :<|> getScatter id
            :<|> getChart   id
@@ -254,6 +261,7 @@ catApi = putCat
 
 ------------------------------------------------------------------------
 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
+-- Pairing utilities to move elsewhere
 type PairingApi = Summary " Pairing API"
               :> QueryParam "view"   TabType
               -- TODO change TabType -> DocType (CorpusId for pairing)
@@ -262,6 +270,25 @@ type PairingApi = Summary " Pairing API"
               :> QueryParam "order"  OrderBy
               :> Get '[JSON] [FacetDoc]
 
+----------
+type Pairs    = Summary "List of Pairs"
+              :> Get '[JSON] [AnnuaireId]
+pairs :: CorpusId -> GargServer Pairs
+pairs cId = do
+  ns <- getNodeNode cId
+  pure $ map _nn_node2_id ns
+
+type PairWith = Summary "Pair a Corpus with an Annuaire"
+              :> "annuaire" :> Capture "annuaire_id" AnnuaireId
+              :> "list"     :> Capture "list_id"     ListId
+              :> Post '[JSON] Int
+
+pairWith :: CorpusId -> GargServer PairWith
+pairWith cId aId lId = do
+  r <- pairing cId aId lId
+  _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
+  pure r
+
 ------------------------------------------------------------------------
 type ChartApi = Summary " Chart API"
               :> QueryParam "from" UTCTime
@@ -343,3 +370,4 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
         -> Cmd err Int
 putNode n h = fromIntegral <$> updateHyperdata n h
 -------------------------------------------------------------
+

src/Gargantext/API/Orchestrator/Types.hs

@@ -22,7 +22,7 @@ import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Gargantext.API.Ngrams (TODO(..))
+import Gargantext.Core.Types (TODO(..))
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
   arbitrary = panic "TODO"
 

src/Gargantext/API/Search.hs

@@ -79,8 +79,7 @@ instance ToSchema SearchPairedResults where
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
 -- TODO-EVENTS: No event, this is a read-only query.
-type SearchAPI results
-  = Summary "Search endpoint"
+type SearchAPI results = Summary "Search endpoint"
                        :> ReqBody '[JSON] SearchQuery
                        :> QueryParam "offset" Int
                        :> QueryParam "limit"  Int
@@ -88,18 +87,20 @@ type SearchAPI results
                        :> Post '[JSON] results
 
 type SearchDocsAPI  = SearchAPI SearchDocResults
-type SearchPairsAPI = 
-  Summary "" :> "list"  :> Capture "list"   ListId
-  :> SearchAPI SearchPairedResults
------------------------------------------------------------------------
-
-searchPairs :: NodeId -> GargServer SearchPairsAPI
-searchPairs pId lId (SearchQuery q) o l order =
-  SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
-
 searchDocs :: NodeId -> GargServer SearchDocsAPI
 searchDocs nId (SearchQuery q) o l order =
   SearchDocResults <$> searchInCorpus nId False q o l order
   --SearchResults <$> searchInCorpusWithContacts nId q o l order
 
+-----------------------------------------------------------------------
+type SearchPairsAPI = Summary ""
+                    :> "list"
+                    :> Capture "list" ListId
+                    :> SearchAPI SearchPairedResults
+searchPairs :: NodeId -> GargServer SearchPairsAPI
+
+searchPairs pId lId (SearchQuery q) o l order =
+  SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
+
+-----------------------------------------------------------------------
 

src/Gargantext/API/Table.hs

@@ -46,7 +46,7 @@ import GHC.Generics (Generic)
 import Gargantext.API.Ngrams (TabType(..))
 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..))
+import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.TextSearch
 import Gargantext.Database.Types.Node
@@ -121,14 +121,13 @@ getTable' cId ft o l order =
     (Just MoreTrash) -> moreLike cId o l order IsTrash
     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 
-{-
-getPairing :: ContactId -> Maybe TabType
+
+getPair :: ContactId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
          -> Maybe OrderBy -> Cmd err [FacetDoc]
-getPairing cId ft o l order =
+getPair cId ft o l order =
   case ft of
     (Just Docs)  -> runViewAuthorsDoc cId False o l order
     (Just Trash) -> runViewAuthorsDoc cId True  o l order
     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 
--}

src/Gargantext/API/Types.hs

@@ -94,6 +94,19 @@ type GargServerT env err m api = GargServerC env err m => ServerT api m
 type GargServer api =
   forall env err m. GargServerT env err m api
 
+-------------------------------------------------------------------
+-- | This Type is needed to prepare the function before the GargServer
+type GargNoServer' env err m =
+  ( CmdM           env err m
+  , HasRepo        env
+  , HasSettings    env
+  , HasNodeError       err
+  )
+
+type GargNoServer t =
+  forall env err m. GargNoServer' env err m => m t
+-------------------------------------------------------------------
+
 data GargError
   = GargNodeError    NodeError
   | GargTreeError    TreeError

src/Gargantext/Core/Types.hs

@@ -25,32 +25,29 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
                              , Name
                              , TableResult(..)
                              , NodeTableResult
+                             , TODO(..)
                              ) where
 
+--import qualified Data.Set as S
 import Control.Lens (Prism', (#))
 import Control.Monad.Error.Class (MonadError, throwError)
-
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Monoid
 import Data.Semigroup
 import Data.Set (Set, empty)
+import Data.Swagger (ToParamSchema)
 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
---import qualified Data.Set as S
-
 import Data.Text (Text, unpack)
 import Data.Validity
-
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
+import GHC.Generics
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Types.Node
 import Gargantext.Prelude
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-import GHC.Generics
 ------------------------------------------------------------------------
-
 type Name = Text
 type Term  = Text
 type Stems = Set Text
@@ -158,3 +155,13 @@ instance Arbitrary a => Arbitrary (TableResult a) where
   arbitrary = TableResult <$> arbitrary <*> arbitrary
 
 type NodeTableResult a = TableResult (Node a)
+
+-- TO BE removed
+data TODO = TODO
+  deriving (Generic)
+
+instance ToSchema TODO where
+instance ToParamSchema TODO where
+
+
+

src/Gargantext/Core/Types/Main.hs

@@ -52,8 +52,6 @@ instance ToSchema NodeTree where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nt_")
 ------------------------------------------------------------------------
 
-
-
 --data Classification = Favorites | MyClassifcation
 
 type HashId   = Text

src/Gargantext/Database/Facet.hs

@@ -26,8 +26,8 @@ Portability : POSIX
 {-# LANGUAGE TypeFamilies              #-}
 ------------------------------------------------------------------------
 module Gargantext.Database.Facet
-  ( -- runViewAuthorsDoc
-   runViewDocuments
+  ( runViewAuthorsDoc
+  , runViewDocuments
   , filterWith
 
   , Pair(..)
@@ -57,9 +57,13 @@ import Gargantext.Core.Types
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Schema.NodeNodeNgrams
+-- import Gargantext.Database.Schema.NodeNodeNgrams2
 import Gargantext.Database.Utils
 import Gargantext.Database.Queries.Filter
+import Gargantext.Database.Queries.Join (leftJoin5)
 import Opaleye
 import Prelude hiding (null, id, map, sum, not, read)
 import Servant.API
@@ -208,7 +212,7 @@ instance Arbitrary OrderBy
 
 -- TODO-SECURITY check
 
-{-
+--{-
 runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
@@ -227,26 +231,31 @@ viewAuthorsDoc cId _ nt = proc () -> do
   restrict -< _node_id   contact   .== (toNullable $ pgNodeId cId)
   restrict -< _node_typename doc   .== (pgInt4 $ nodeTypeId nt)
 
-  returnA  -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (toNullable $ pgInt4 1) (toNullable $ pgDouble 1)
+  returnA  -< FacetDoc (_node_id        doc)
+                       (_node_date      doc)
+                       (_node_name      doc)
+                       (_node_hyperdata doc)
+                       (toNullable $ pgInt4 1)
+                       (toNullable $ pgDouble 1)
 
-queryAuthorsDoc :: Query (NodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))
-queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34 cond45
+queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
+queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
     where
-         cond12 :: (NodeNgramRead, NodeRead) -> Column PGBool
+         cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
          cond12 (nodeNgram, doc) =  _node_id                  doc
-                                .== nng_node_id nodeNgram
+                                .== _nnng_node1_id nodeNgram
 
-         cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
+         cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
          cond23 (ngrams, (nodeNgram, _)) =  ngrams^.ngrams_id
-                                        .== nng_ngrams_id nodeNgram
+                                        .== _nnng_ngrams_id nodeNgram
 
-         cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== nng_ngrams_id       nodeNgram2
+         cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column PGBool
+         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== _nnng_ngrams_id       nodeNgram2
 
-         cond45 :: (NodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== nng_node_id         nodeNgram2
+         cond45 :: (NodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column PGBool
+         cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== _nnng_node1_id         nodeNgram2
 
--}
+--}
 ------------------------------------------------------------------------
 
 -- TODO-SECURITY check
@@ -265,8 +274,12 @@ viewDocuments cId t ntId = proc () -> do
   restrict -< n^.node_typename .== (pgInt4 ntId)
   restrict -< if t then nn^.nn_category .== (pgInt4 0)
                    else nn^.nn_category .>= (pgInt4 1)
-  returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (toNullable $ nn^.nn_category) (toNullable $ nn^.nn_score)
-
+  returnA  -< FacetDoc (_node_id        n)
+                       (_node_date      n)
+                       (_node_name      n)
+                       (_node_hyperdata n)
+                       (toNullable $ nn^.nn_category)
+                       (toNullable $ nn^.nn_score)
 
 ------------------------------------------------------------------------
 filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) =>

src/Gargantext/Database/Flow/Pairing.hs

@@ -52,11 +52,11 @@ pairing' = undefined
 -}
 
 -- | TODO : add paring policy as parameter
-pairing :: AnnuaireId
-        -> CorpusId
+pairing :: CorpusId   -- (CorpusId,   ListId) -- Pair (Either CorpusId AnnuaireId) ListId
+        -> AnnuaireId -- (AnnuaireId, ListId) -- Pair (Either CorpusId AnnuaireId) ListId
         -> ListId
         -> Cmd err Int
-pairing aId cId lId = do
+pairing cId aId lId = do
   contacts' <- getAllContacts aId
   let contactsMap = pairingPolicyToMap toLower
                   $ toMaps extractNgramsT (tr_docs contacts')
@@ -120,6 +120,7 @@ getNgramsTindexed corpusId ngramsType' = fromList
       where
         selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
                       JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
+                      -- JOIN node_node_ngrams2 occ ON occ.ngrams_id = n.id
                       JOIN nodes_nodes      nn  ON nn.node2_id   = occ.node2_id
 
                       WHERE nn.node1_id     = ?

src/Gargantext/Database/Metrics/NgramsByNode.hs

@@ -180,11 +180,11 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
            -> NgramsType
            -> [Text]
            -> Cmd err [(Text, Double)]
-      run cId' lId' _nt' tms' = runPGSQuery query
+      run cId' lId' nt' tms' = runPGSQuery query
                 ( Values fields (DPS.Only <$> tms')
                 , cId'
                 , lId'
-                -- , ngramsTypeId nt'
+                , ngramsTypeId nt'
                 )
 
       query :: DPS.Query
@@ -194,9 +194,9 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
           JOIN ngrams ng      ON nng.ngrams_id = ng.id
           JOIN input_rows  ir ON ir.terms      = ng.terms
           WHERE nng.node1_id     = ?   -- CorpusId
-            AND nng.node2_id     = ?
-            -- AND nng.ngrams_type = ? -- NgramsTypeId
-            -- AND nn.category     > 0
+            AND nng.node2_id     = ?   -- ListId
+            AND nng.ngrams_type  = ? -- NgramsTypeId
+            -- AND nn.category     > 0 -- TODO
             GROUP BY ng.terms, nng.weight
         |]
 
@@ -278,15 +278,32 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
       GROUP BY nng.node2_id, ng.terms
   |]
 
+------------------------------------------------------------------------
 
 getNodesByNgramsOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
                          -> Cmd err (Map Text (Set NodeId))
 getNodesByNgramsOnlyUser cId ls nt ngs =
      Map.unionsWith    (<>)
-   . map (fromListWith (<>) . map (second Set.singleton))
+   . map (fromListWith (<>)
+   . map (second Set.singleton))
+  <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
+           (splitEvery 1000 ngs)
+
+
+getNgramsByNodeOnlyUser :: NodeId
+                        -> [ListId]
+                        -> NgramsType
+                        -> [Text]
+                        -> Cmd err (Map NodeId (Set Text))
+getNgramsByNodeOnlyUser cId ls nt ngs =
+     Map.unionsWith    (<>)
+   . map (fromListWith (<>)
+   . map (second Set.singleton))
+   . map (map swap)
   <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
            (splitEvery 1000 ngs)
 
+------------------------------------------------------------------------
 selectNgramsOnlyByNodeUser :: CorpusId -> [ListId] -> NgramsType -> [Text]
                            -> Cmd err [(Text, NodeId)]
 selectNgramsOnlyByNodeUser cId ls nt tms =
@@ -319,7 +336,6 @@ queryNgramsOnlyByNodeUser = [sql|
 
 
 
-
 selectNgramsOnlyByNodeUser' :: CorpusId -> [ListId] -> NgramsType -> [Text]
                            -> Cmd err [(Text, Int)]
 selectNgramsOnlyByNodeUser' cId ls nt tms =
@@ -349,7 +365,6 @@ queryNgramsOnlyByNodeUser' = [sql|
 
 
 
-
 getNgramsByDocOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
                          -> Cmd err (Map Text (Set NodeId))
 getNgramsByDocOnlyUser cId ls nt ngs =

src/Gargantext/Database/Node/Document/Add.hs

@@ -75,7 +75,6 @@ prepare pId ns = map (\nId -> InputData pId nId) ns
 ------------------------------------------------------------------------
 -- * Main Types used
 
-
 data InputData = InputData { inNode1_id :: NodeId
                            , inNode2_id :: NodeId
                            } deriving (Show, Generic, Typeable)

src/Gargantext/Database/Node/Document/Insert.hs

@@ -135,7 +135,6 @@ instance InsertDb HyperdataContact
                       , (toField . toJSON) h
                       ]
 
-
 -- | Debug SQL function
 --
 -- to print rendered query (Debug purpose) use @formatQuery@ function.

src/Gargantext/Database/Schema/Ngrams.hs

@@ -41,8 +41,12 @@ import Database.PostgreSQL.Simple.ToRow   (toRow)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
 import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery)
+import Gargantext.Core.Types (TODO(..))
 import Gargantext.Prelude
 import Opaleye hiding (FromField)
+import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
+import Text.Read (read)
+import Data.Swagger (ToParamSchema, toParamSchema)
 import Prelude (Enum, Bounded, minBound, maxBound, Functor)
 import qualified Database.PostgreSQL.Simple as PGS
 
@@ -94,7 +98,7 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
 -- ngrams in authors field of document has Authors Type
 -- ngrams in text (title or abstract) of documents has Terms Type
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
-  deriving (Eq, Show, Ord, Enum, Bounded, Generic)
+  deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 
 instance FromJSON NgramsType
 instance FromJSONKey NgramsType where
@@ -115,6 +119,15 @@ instance FromField NgramsTypeId where
     if (n :: Int) > 0 then return $ NgramsTypeId n
                       else mzero
 
+instance FromHttpApiData NgramsType where
+  parseUrlPiece n = pure $ (read . cs) n
+
+instance ToParamSchema NgramsType where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+
+
+
 instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Schema/Node.hs

@@ -530,13 +530,20 @@ arbitraryDashboard = HyperdataDashboard (Just "Preferences")
 ------------------------------------------------------------------------
 
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
-node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
+node nodeType name hyperData parentId userId =
+  Node Nothing 
+       (pgInt4 typeId)
+       (pgInt4 userId)
+       (pgNodeId <$> parentId)
+       (pgStrictText name)
+       Nothing
+       (pgJSONB $ cs $ encode hyperData)
     where
       typeId = nodeTypeId nodeType
 
                   -------------------------------
 insertNodes :: [NodeWrite] -> Cmd err Int64
-insertNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
+insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
 insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
@@ -576,10 +583,10 @@ data Node' = Node' { _n_type :: NodeType
                    } deriving (Show)
 
 mkNodes :: [NodeWrite] -> Cmd err Int64
-mkNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
+mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
 mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
-mkNodeR ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
+mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
 
 ------------------------------------------------------------------------
 

src/Gargantext/Database/Schema/NodeNode.hs

@@ -65,7 +65,7 @@ type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
                                       (Column (Nullable PGFloat8))
                                       (Column (Nullable PGInt4))
 
-type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
+type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
 makeLenses ''NodeNodePoly
@@ -102,8 +102,30 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-
 ------------------------------------------------------------------------
+-- | Basic NodeNode tools
+getNodeNode :: NodeId -> Cmd err [NodeNode]
+getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
+  where
+    selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
+    selectNodeNode n' = proc () -> do
+      ns <- queryNodeNodeTable -< ()
+      restrict -< _nn_node1_id ns .== n'
+      returnA -< ns
+
+-------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int64
+insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
+  where
+    ns' :: [NodeNodeWrite]
+    ns' = map (\(NodeNode n1 n2 x y)
+                -> NodeNode (pgNodeId n1)
+                            (pgNodeId n2)
+                            (pgDouble <$> x)
+                            (pgInt4   <$> y) 
+              ) ns
+
+
 -- | Favorite management
 nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
@@ -131,13 +153,11 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 ------------------------------------------------------------------------
 -- | TODO use UTCTime fast 
 selectDocsDates :: CorpusId -> Cmd err [Text]
-selectDocsDates cId = 
-                map (head' "selectDocsDates" . splitOn "-")
+selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
                    <$> map (view hyperdataDocument_publication_date)
                    <$> selectDocs cId
 
-
 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
 
@@ -149,7 +169,6 @@ queryDocs cId = proc () -> do
   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -< view (node_hyperdata) n
 
-
 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
@@ -161,14 +180,12 @@ queryDocNodes cId = proc () -> do
   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -<  n
 
-
 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
   where
     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
-
 ------------------------------------------------------------------------
 -- | Trash management
 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]

src/Gargantext/Database/Schema/NodeNodeNgrams.hs

@@ -78,6 +78,8 @@ nodeNodeNgramsTable  = Table "node_node_ngrams"
                                }
                           )
 
+------------------------------------------------
+
 queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
 queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
 

src/Gargantext/Database/Schema/NodesNgramsRepo.hs

@@ -80,7 +80,7 @@ selectPatches = proc () -> do
 
 
 insertRepos :: [NgramsStatePatch] -> Cmd err Int64
-insertRepos ns = mkCmd $ \conn -> runInsertMany conn repoTable (toWrite ns)
+insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite ns) rCount Nothing
   where
     toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
     toWrite = undefined

src/Gargantext/Database/Schema/User.hs

@@ -115,7 +115,9 @@ userTable = Table "auth_user" (pUser User { user_id      = optional "id"
 
 -- TODO: on conflict, nice message
 insertUsers :: [UserWrite] -> Cmd err Int64
-insertUsers us = mkCmd $ \c -> runInsertMany c userTable us
+insertUsers us = mkCmd $ \c -> runInsert_ c insert
+  where
+    insert = Insert userTable us rCount Nothing
 
 
 gargantextUser :: Username -> UserWrite

src/Gargantext/Database/Tree.hs

@@ -108,7 +108,7 @@ dbTree rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
           FROM nodes AS c
 
           INNER JOIN tree AS s ON c.parent_id = s.id
-           WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90)
+           WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90,71)
         )
     SELECT * from tree;
     |] (Only rootId)

src/Gargantext/Database/Types/Node.hs

@@ -106,7 +106,6 @@ type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName U
 
 ------------------------------------------------------------------------
 
-
 instance FromHttpApiData NodeId where
   parseUrlPiece n = pure $ NodeId $ (read . cs) n
 

src/Gargantext/Prelude/Utils.hs

@@ -36,12 +36,11 @@ import Crypto.Argon2 as Crypto
 import Data.Either
 import Data.ByteString.Base64.URL as URL
 
+--------------------------------------------------------------------------
 shuffle :: MonadRandom m => [a] -> m [a]
 shuffle ns = SRS.shuffleM ns 
 
-type FolderPath = FilePath
-type FileName   = FilePath
-
+--------------------------------------------------------------------------
 sha :: Text -> Text
 sha = Text.pack
      . SHA.showDigest
@@ -49,6 +48,7 @@ sha = Text.pack
      . Char.pack
      . Text.unpack
 
+--------------------------------------------------------------------------
 data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId
                              }
@@ -58,6 +58,9 @@ secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
 
 type SecretKey = ByteString
 
+type FolderPath = FilePath
+type FileName   = FilePath
+
 hashNode :: SecretKey -> NodeToHash -> ByteString
 hashNode sk (NodeToHash nt ni) = case hashResult of
     Left  e -> panic (cs $ show e)

src/Gargantext/Viz/Phylo/API.hs

@@ -37,7 +37,7 @@ import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Main
 import Gargantext.Viz.Phylo.Example
-import Gargantext.API.Ngrams (TODO(..))
+import Gargantext.Core.Types (TODO(..))
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)