[FIX][DB][FLOW] insert listngrams.

src/Gargantext/API/Ngrams.hs

@@ -58,7 +58,7 @@ import Gargantext.Core.Types (node_id)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Ngrams (NgramsId)
 import Gargantext.Database.Node (getListsWithParentId)
--- import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
+import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
 import Gargantext.Database.NodeNgramsNgrams -- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
 import Gargantext.Prelude
 import Gargantext.Text.List.Types (ListType(..), ListId, ListTypeId) -- ,listTypeId )
@@ -69,17 +69,18 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 ------------------------------------------------------------------------
 --data FacetFormat = Table | Chart
-data TabType   = Docs   | Terms  | Sources | Authors | Trash
+data TabType   = Docs   | Terms  | Sources | Authors | Institutes | Trash
   deriving (Generic, Enum, Bounded)
 
 instance FromHttpApiData TabType
   where
-    parseUrlPiece "Docs"    = pure Docs
-    parseUrlPiece "Terms"   = pure Terms
-    parseUrlPiece "Sources" = pure Sources
-    parseUrlPiece "Authors" = pure Authors
-    parseUrlPiece "Trash"   = pure Trash
-    parseUrlPiece _         = Left "Unexpected value of TabType"
+    parseUrlPiece "Docs"       = pure Docs
+    parseUrlPiece "Terms"      = pure Terms
+    parseUrlPiece "Sources"    = pure Sources
+    parseUrlPiece "Institutes" = pure Institutes
+    parseUrlPiece "Authors"    = pure Authors
+    parseUrlPiece "Trash"      = pure Trash
+    parseUrlPiece _            = Left "Unexpected value of TabType"
 
 instance ToParamSchema   TabType
 instance ToJSON    TabType
@@ -104,7 +105,7 @@ $(deriveJSON (unPrefix "_ne_") ''NgramsElement)
 
 instance ToSchema NgramsElement
 instance Arbitrary NgramsElement where
-  arbitrary = elements [NgramsElement "sport" StopList 1 Nothing mempty]
+  arbitrary = elements [NgramsElement "sport" GraphList 1 Nothing mempty]
 
 ------------------------------------------------------------------------
 newtype NgramsTable = NgramsTable { _ngramsTable :: [NgramsElement] }
@@ -113,20 +114,19 @@ newtype NgramsTable = NgramsTable { _ngramsTable :: [NgramsElement] }
 instance Arbitrary NgramsTable where
   arbitrary = elements
               [ NgramsTable
-                [ NgramsElement "animal" GraphList 1 Nothing (Set.fromList ["dog"])
-                ,    NgramsElement "dog" GraphList 3 (Just "animal")
-                        (Set.fromList ["object", "cat", "nothing"])
-                ,    NgramsElement "object" CandidateList 2 (Just "animal") mempty
-                ,    NgramsElement "cat"    GraphList 1 (Just "animal") mempty
-                ,    NgramsElement "nothing" StopList 4 (Just "animal") mempty
+                [ NgramsElement "animal"  GraphList     1  Nothing       (Set.fromList ["dog", "cat"])
+                , NgramsElement "cat"     GraphList     1 (Just "animal") mempty
+                , NgramsElement "dog"     GraphList     3 (Just "animal")(Set.fromList ["dogs"])
+                , NgramsElement "dogs"    StopList      4 (Just "dog")    mempty
+                , NgramsElement "object"  CandidateList 2  Nothing        mempty
+                , NgramsElement "nothing" StopList      4  Nothing        mempty
                 ]
               , NgramsTable
-                [ NgramsElement "plant" GraphList 3 Nothing
-                        (Set.fromList ["flower", "moon", "cat", "sky"])
-                ,    NgramsElement "flower" GraphList 3 (Just "plant") mempty
-                ,    NgramsElement "moon" CandidateList 1 (Just "plant") mempty
-                ,    NgramsElement "cat"  GraphList 2 (Just "plant") mempty
-                ,    NgramsElement "sky" StopList 1 (Just "plant") mempty
+                [ NgramsElement "organic" GraphList     3  Nothing        (Set.singleton "flower")
+                , NgramsElement "flower"  GraphList     3 (Just "organic") mempty
+                , NgramsElement "moon"    CandidateList 1  Nothing         mempty
+                , NgramsElement "cat"     GraphList     2  Nothing         mempty
+                , NgramsElement "sky"     StopList      1  Nothing         mempty
                 ]
               ]
 instance ToSchema NgramsTable
@@ -182,11 +182,10 @@ instance Arbitrary NgramsPatch where
   arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
 
 data NgramsIdPatch =
-     NgramsIdPatch { _nip_ngramsId    :: NgramsTerm
+     NgramsIdPatch { _nip_ngrams      :: NgramsTerm
                    , _nip_ngramsPatch :: NgramsPatch
                    }
       deriving (Ord, Eq, Show, Generic)
-
 $(deriveJSON (unPrefix "_nip_") ''NgramsIdPatch)
 
 instance ToSchema  NgramsIdPatch
@@ -213,7 +212,6 @@ data Versioned a = Versioned
   , _v_data    :: a
   }
 
-
 {-
 -- TODO sequencs of modifications (Patchs)
 type NgramsIdPatch = Patch NgramsId NgramsPatch
@@ -236,16 +234,17 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 type CorpusId = Int
-type TableNgramsApi = Summary " Table Ngrams API Change"
-                      :> QueryParam "list"   ListId
-                      :> ReqBody '[JSON] NgramsIdPatchs -- Versioned ...
-                      :> Put     '[JSON] NgramsIdPatchsBack -- Versioned ...
 
 type TableNgramsApiGet = Summary " Table Ngrams API Get"
                       :> QueryParam "ngramsType"   TabType
                       :> QueryParam "list"   ListId
                       :> Get    '[JSON] NgramsTable
 
+type TableNgramsApi = Summary " Table Ngrams API Change"
+                      :> QueryParam "list"   ListId
+                      :> ReqBody '[JSON] NgramsIdPatchsFeed -- Versioned ...
+                      :> Put     '[JSON] NgramsIdPatchsBack -- Versioned ...
+
 type NgramsIdPatchsFeed = NgramsIdPatchs
 type NgramsIdPatchsBack = NgramsIdPatchs
 
@@ -257,12 +256,10 @@ defaultList c cId = view node_id <$> maybe (panic noListFound) identity
   where
     noListFound = "Gargantext.API.Ngrams.defaultList: no list found"
 
-toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
-toLists = undefined
 {-
-toLists lId np =
-  [ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ]
--}
+toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
+-- toLists = undefined
+toLists lId np = [ (lId,ngId,listTypeId lt) | map (toList lId) (_nip_ngramsIdPatchs np) ]
 
 toList :: ListId -> NgramsIdPatch -> (ListId, NgramsId, ListTypeId)
 toList = undefined
@@ -271,13 +268,11 @@ toGroups :: ListId -> (NgramsPatch -> Set NgramsId) -> NgramsIdPatchs -> [NodeNg
 toGroups lId addOrRem ps = concat $ map (toGroup lId addOrRem) $ _nip_ngramsIdPatchs ps
 
 toGroup :: ListId -> (NgramsPatch -> Set NgramsId) -> NgramsIdPatch -> [NodeNgramsNgrams]
-toGroup = undefined
-
-{-
+-- toGroup = undefined
 toGroup lId addOrRem (NgramsIdPatch ngId patch)  =
   map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
--}
 
+-}
 
 tableNgramsPatch :: Connection -> CorpusId -> Maybe ListId -> NgramsIdPatchsFeed -> IO NgramsIdPatchsBack
 tableNgramsPatch = undefined 
@@ -290,7 +285,7 @@ tableNgramsPatch conn corpusId maybeList patchs = do
   _ <- ngramsGroup' conn Del $ toGroups listId _np_rem_children patchs
   _ <- updateNodeNgrams conn (toLists listId patchs)
   pure (NgramsIdPatchs [])
-  -}
+-}
 
 getTableNgramsPatch :: Connection -> CorpusId -> Maybe TabType -> Maybe ListId -> IO NgramsTable
 getTableNgramsPatch = undefined

src/Gargantext/Core/Types/Main.hs

@@ -80,7 +80,7 @@ corpusTree nId t  = TreeN (NodeTree ("Corpus " <> t)  NodeCorpus nId) (  [ leafT
 
 -- TODO multiple ListType declaration, remove it
 data ListType  =  Stop  | Candidate | Map
-  deriving (Generic, Eq, Ord)
+  deriving (Generic, Eq, Ord, Show)
 
 instance ToJSON   ListType
 instance FromJSON ListType
@@ -93,7 +93,6 @@ listId Map       = 2
 -- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
 --              | TfidfCorpus | TfidfGlobal   | TirankLocal | TirankGlobal
 
-
 -- | Community Manager Use Case
 type Annuaire  = NodeCorpus
 

src/Gargantext/Database/Flow.hs

@@ -22,7 +22,7 @@ authors
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Gargantext.Database.Flow (flowDatabase)
+module Gargantext.Database.Flow (flowDatabase, ngrams2list)
     where
 
 import GHC.Show (Show)
@@ -66,7 +66,7 @@ flowDatabase ff fp cName = do
   --printDebug "Docs IDs : " (ids)
   idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments
   --printDebug "Repeated Docs IDs : " (length ids)
-  
+
   -- Ngrams Flow
   -- todo: flow for new documents only
   -- let tids = toInserted ids
@@ -92,14 +92,12 @@ flowDatabase ff fp cName = do
   listId2 <- runCmd' $ listFlow masterUserId corpusId indexedNgrams
   printDebug "list id : " listId2
 
-  printDebug "Docs IDs : " (length idsRepeat)
-
   (_, _, corpusId2) <- subFlow "user1" cName
   inserted <- runCmd' $ add corpusId2 (map reId ids)
   printDebug "Inserted : " (length inserted)
-  -- pure [corpusId2, corpusId]
-
-  runCmd' $ del [corpusId2, corpusId]
+  
+  pure corpusId2
+  -- runCmd' $ del [corpusId2, corpusId]
 
 type CorpusName = Text
 
@@ -204,15 +202,20 @@ insertToNodeNgrams m = insertNodeNgrams [ NodeNgram Nothing nId  ((_ngramsId
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 listFlow :: UserId -> CorpusId -> Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd ListId
-listFlow uId cId ng = do
+listFlow uId cId ngs = do
+  printDebug "ngs:" ngs
   lId <- maybe (panic "mkList error") identity <$> head <$> mkList cId uId
+  printDebug "ngs" (DM.keys ngs)
   -- TODO add stemming equivalence of 2 ngrams
-  let groupEd = groupNgramsBy (\(NgramsT t1 n1) (NgramsT t2 n2) -> if (((==) t1 t2) && ((==) n1 n2)) then (Just (n1,n2)) else Nothing) ng
+  let groupEd = groupNgramsBy (\(NgramsT t1 n1) (NgramsT t2 n2) -> if (((==) t1 t2) && ((==) n1 n2)) then (Just (n1,n2)) else Nothing) ngs
   _ <- insertGroups lId groupEd
 
 -- compute Candidate / Map
-  let lists = ngrams2list ng
-  _ <- insertLists lId lists
+  let lists = ngrams2list ngs
+  printDebug "lists:" lists
+  
+  is <- insertLists lId lists
+  printDebug "listNgrams inserted :" is
 
   pure lId
 
@@ -230,18 +233,19 @@ insertGroups :: ListId -> Map NgramsIndexed NgramsIndexed -> Cmd Int
 insertGroups lId ngrs =
   insertNodeNgramsNgramsNew [ NodeNgramsNgrams lId ng1 ng2 (Just 1)
                               | (ng1, ng2) <- map (both _ngramsId) $ DM.toList ngrs
+                              , ng1 /= ng2
                             ]
 
 ------------------------------------------------------------------------
 -- TODO: verify NgramsT lost here
-ngrams2list :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Map ListType NgramsIndexed
-ngrams2list = DM.fromList . zip (repeat Candidate) . map (\(NgramsT _lost_t ng) -> ng) . DM.keys
+ngrams2list :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> [(ListType,NgramsIndexed)]
+ngrams2list = zip (repeat Candidate) . map (\(NgramsT _lost_t ng) -> ng) . DM.keys
 
 -- | TODO: weight of the list could be a probability
-insertLists :: ListId -> Map ListType NgramsIndexed -> Cmd Int
-insertLists lId list2ngrams =
+insertLists :: ListId -> [(ListType,NgramsIndexed)] -> Cmd Int
+insertLists lId lngs =
   insertNodeNgrams [ NodeNgram Nothing lId ngr (fromIntegral $ listId l) (listId l)
-                     | (l,ngr) <- map (second _ngramsId)   $ DM.toList list2ngrams
+                     | (l,ngr) <- map (second _ngramsId) lngs
                    ]
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Node.hs

@@ -379,14 +379,14 @@ nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aI
     name    = maybe "Contact" identity maybeName
     contact = maybe defaultContact identity maybeContact
 ------------------------------------------------------------------------
-defaultList :: HyperdataList
-defaultList = HyperdataList (Just "Preferences")
+arbitraryList :: HyperdataList
+arbitraryList = HyperdataList (Just "Preferences")
 
 nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite'
 nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
   where
     name = maybe "Listes" identity maybeName
-    list = maybe defaultList identity maybeList
+    list = maybe arbitraryList identity maybeList
 
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
@@ -470,7 +470,6 @@ mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
 mkNodeR' :: [NodeWriteT] -> Cmd [Int]
 mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
 
-
 ------------------------------------------------------------------------
 
 data NewNode = NewNode { _newNodeId :: Int

src/Gargantext/Database/NodeNgram.hs

@@ -29,6 +29,7 @@ if Node is a List     then it is listing (either Stop, Candidate or Map)
 -- TODO NodeNgrams
 module Gargantext.Database.NodeNgram where
 
+import Data.Text (Text)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
@@ -98,16 +99,18 @@ insertNodeNgramW nns =
   mkCmd $ \c -> fromIntegral
        <$> runInsertMany c nodeNgramTable nns
 
+type NgramsText = Text
 
-updateNodeNgrams :: PGS.Connection -> [(ListId, NgramsId, ListTypeId)] -> IO [PGS.Only Int]
+updateNodeNgrams :: PGS.Connection -> [(ListId, NgramsText, ListTypeId)] -> IO [PGS.Only Int]
 updateNodeNgrams c input = PGS.query c updateQuery (PGS.Only $ Values fields $ input)
   where
-    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
     updateQuery = [sql| UPDATE nodes_ngrams as old SET
                  ngrams_type = new.typeList
-                 from (?) as new(node_id,ngram_id,typeList)
+                 from (?) as new(node_id,terms,typeList)
+                 JOIN ngrams ON ngrams.terms = new.terms
                  WHERE old.node_id = new.node_id
-                 AND   old.gram_id = new.gram_id
-                 RETURNING new.ngram_id
+                 AND   old.ngram_id = ngrams.id;
+                 -- RETURNING new.ngram_id
                  |]
 

src/Gargantext/Database/NodeNgramsNgrams.hs

@@ -32,6 +32,7 @@ module Gargantext.Database.NodeNgramsNgrams
   where
 
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Data.Text (Text)
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
@@ -117,11 +118,14 @@ insertNodeNgramsNgramsW ns =
 ------------------------------------------------------------------------
 data Action   = Del | Add
 
-ngramsGroup :: Action -> [NodeNgramsNgrams] -> Cmd [Int]
+type NgramsParent = Text
+type NgramsChild  = Text
+
+ngramsGroup :: Action -> [(Int, NgramsParent, NgramsChild, Maybe Double)] -> Cmd [Int]
 ngramsGroup a ngs = mkCmd $ \c -> ngramsGroup' c a ngs
 
 -- TODO: remove this function (use Reader Monad only)
-ngramsGroup' :: DPS.Connection -> Action -> [NodeNgramsNgrams] -> IO [Int]
+ngramsGroup' :: DPS.Connection -> Action -> [(Int, NgramsParent, NgramsChild, Maybe Double)] -> IO [Int]
 ngramsGroup' c action ngs = runNodeNgramsNgrams c q ngs
   where
     q = case action of
@@ -129,32 +133,34 @@ ngramsGroup' c action ngs = runNodeNgramsNgrams c q ngs
           Add -> queryInsertNodeNgramsNgrams
 
 
-runNodeNgramsNgrams :: DPS.Connection -> DPS.Query -> [NodeNgramsNgrams] -> IO [Int]
+runNodeNgramsNgrams :: DPS.Connection -> DPS.Query -> [(Int, NgramsParent, NgramsChild, Maybe Double)] -> IO [Int]
 runNodeNgramsNgrams c q ngs = map (\(DPS.Only a) -> a) <$> DPS.query c q (DPS.Only $ Values fields ngs' )
   where
-    ngs'   = map (\(NodeNgramsNgrams n ng1 ng2 w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
+    ngs'   = map (\(n,ng1,ng2,w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
     fields = map (\t -> QualifiedIdentifier Nothing t)
-                 ["int4","int4","int4","double"]
+                 ["int4","text","text","double"]
 
 --------------------------------------------------------------------
 -- TODO: on conflict update weight
 queryInsertNodeNgramsNgrams :: DPS.Query
 queryInsertNodeNgramsNgrams = [sql|
     WITH input_rows(nId,ng1,ng2,w) AS (?)
-    , ins AS (
-       INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
-       SELECT * FROM input_rows
-       ON CONFLICT (node_id,ngram1_id,ngram2_id) DO NOTHING -- unique index created here
-       )
+    INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
+    SELECT nId,ngrams1.id,ngrams2.id,w FROM input_rows
+    JOIN ngrams ngrams1 ON ngrams1.terms = ng1
+    JOIN ngrams ngrams2 ON ngrams2.terms = ng2
+    ON CONFLICT (node_id,ngram1_id,ngram2_id) DO NOTHING -- unique index created here
            |]
 
 queryDelNodeNgramsNgrams :: DPS.Query
 queryDelNodeNgramsNgrams = [sql|
     WITH input(nId,ng1,ng2,w) AS (?)
-    , DELETE FROM nodes_ngrams_ngrams
-    WHERE   node_id = input.nId
-      AND ngram1_id = input.ng1
-      AND ngram2_id = input.ng2
+    DELETE FROM nodes_ngrams_ngrams nnn
+    JOIN ngrams ngrams1 ON ngrams.terms = ng1
+    JOIN ngrams ngrams2 ON ngrams.terms = ng2
+    WHERE   nnn.node_id = input.nId
+      AND nnn.ngram1_id = ngrams1.id
+      AND nnn.ngram2_id = ngrams2.id
        ;)
            |]
 

src/Gargantext/Text/List/Types.hs

@@ -29,6 +29,8 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 
 -------------------------------------------------------------------
+
+-- TODO : clean multiples types declaration
 data ListType = GraphList | StopList | CandidateList
   deriving (Show, Eq, Ord, Enum, Bounded, Generic)