[DB] clean and instance insertDB

devops/postgres/schema.sql

@@ -88,22 +88,14 @@ ALTER TABLE public.node_nodengrams_nodengrams OWNER TO gargantua;
 ---------------------------------------------------------------
 -- TODO nodes_nodes(node1_id int, node2_id int, edge_type int , weight real)
 CREATE TABLE public.nodes_nodes (
-    id INTEGER NOT NULL,
     node1_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
     node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
     score REAL,
     category INTEGER,
-    PRIMARY KEY (id)
+    PRIMARY KEY (node1_id, node2_id)
 );
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
 
-CREATE TABLE public.nodesnodes_nodesnodes (
-    nn1_id INTEGER NOT NULL REFERENCES public.nodes_nodes(id) ON DELETE CASCADE,
-    nn2_id INTEGER NOT NULL REFERENCES public.nodes_nodes(id) ON DELETE CASCADE,
-    weight double precision,
-    PRIMARY KEY (nn1_id,nn2_id)
-);
-ALTER TABLE public.nodesnodes_nodesnodes OWNER TO gargantua;
 
 ---------------------------------------------------------------
 CREATE TABLE public.node_node_ngrams (

src/Gargantext/Database.hs

@@ -16,12 +16,33 @@ Gargantext's database.
 
 
 module Gargantext.Database ( module Gargantext.Database.Prelude
+                           , insertDB
                         -- , module Gargantext.Database.Bashql
                            )
     where
 
-import Gargantext.Database.Prelude (connectGargandb)
--- import Gargantext.Database.Bashql
+import Gargantext.Prelude
+import Gargantext.Database.Prelude -- (connectGargandb)
 
+import Gargantext.Database.Schema.Node
+import Gargantext.Database.Query.Table.Node
 
+import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Query.Table.NodeNode
 
+
+class InsertDB a where
+  insertDB :: a -> Cmd err Int64
+
+instance InsertDB [NodeNode] where
+  insertDB = insertNodeNode
+
+{-
+instance InsertDB [Node a] where
+  insertDB = insertNodes'
+
+instance InsertDB [NodeNodeNgram] where
+  insertDB = ...
+
+
+-}

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -7,31 +7,6 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-# Spécifications for pairing
-
-database:
-
-add NodeType Community (instead of texts, contacts)
-
-nodes_nodes
-corpusId_communitId
-
-get defaultList Id of each (for now)
-
-corpusId_docId
-listId_ngramsId (authors)
-
-listId_docId_[ngrams]
-listId_contactId_[ngramsId']
-
-
-if isSame ngramsId ngramsId'
- then
-   insert listId_docId_contactId
- else
-   nothing
-
-
 -}
 
 {-# LANGUAGE QuasiQuotes       #-}
@@ -97,13 +72,6 @@ pairingPolicyToMap :: (Terms -> Terms)
                    -> Map (NgramsT Ngrams) a
 pairingPolicyToMap f = DM.mapKeys (pairingPolicy f)
 
-lastName :: Terms -> Terms
-lastName texte = DT.toLower
-               $ maybe texte (\x -> if DT.length x > 3 then x else texte)
-                             (lastName' texte)
-  where
-    lastName' = lastMay . DT.splitOn " "
-
 
 pairingPolicy :: (Terms -> Terms)
               -> NgramsT Ngrams
@@ -172,6 +140,23 @@ projectionFrom ss f = fromList $ map (\s -> (s, f s)) (Set.toList ss)
 
 projectionTo :: Set DocAuthor -> (DocAuthor -> Projected) -> Map Projected (Set DocAuthor)
 projectionTo ss f = fromListWith (<>) $ map (\s -> (f s, Set.singleton s)) (Set.toList ss)
+------------------------------------------------------------------------
+
+
+lastName :: Terms -> Terms
+lastName texte = DT.toLower
+               $ maybe texte (\x -> if DT.length x > 3 then x else texte)
+                             (lastName' texte)
+  where
+    lastName' = lastMay . DT.splitOn " "
+
+
+
+
+
+
+------------------------------------------------------------------------
+
 
 align :: Map ContactName Projected
       -> Map Projected (Set DocAuthor)
@@ -182,13 +167,13 @@ align mc ma md = fromListWith (<>)
                $ Map.keys mc
   where
     getProjection :: Map DocAuthor (Set DocId) -> Set DocAuthor -> Set DocId
-    getProjection ma sa =
-      if Set.null sa
+    getProjection ma' sa' =
+      if Set.null sa'
          then Set.empty
-         else Set.unions $ sets ma
+         else Set.unions $ sets ma' sa'
            where
-             sets ma'= Set.map (\s -> lookup s ma') sa
-             lookup s' ma'= fromMaybe Set.empty (Map.lookup s' ma')
+             sets ma'' sa'' = Set.map (\s -> lookup s ma'') sa''
+             lookup s' ma''= fromMaybe Set.empty (Map.lookup s' ma'')
 
     testProjection :: ContactName
                    -> Map ContactName Projected
@@ -224,17 +209,15 @@ finalPairing aId (cId, lId, ngt) fc fa = do
   md <- getNgramsDocId cId lId ngt
 
   let
-    contactNameProjected = projectionFrom (Set.fromList $ Map.keys mc) fc
-    authorDocProjected   = projectionTo   (Set.fromList $ Map.keys md) fa
+    from = projectionFrom (Set.fromList $ Map.keys mc) fc
+    to   = projectionTo   (Set.fromList $ Map.keys md) fa
 
-  pure $ fusion mc $ align contactNameProjected authorDocProjected md
+  pure $ fusion mc $ align from to md
 
 
 
 ------------------------------------------------------------------------
 
-
-
 getNgramsContactId :: AnnuaireId
                    -> Cmd err (Map ContactName (Set NodeId))
 getNgramsContactId aId = do
@@ -257,6 +240,7 @@ getNgramsDocId corpusId listId ngramsType
   <$> map (\(t,nId) -> (t, Set.singleton (NodeId nId)))
   <$> selectNgramsDocId corpusId listId ngramsType
 
+
 selectNgramsDocId :: CorpusId
                    -> ListId
                    -> NgramsType
@@ -274,21 +258,3 @@ selectNgramsDocId corpusId' listId' ngramsType' =
                     ;
                    |]
 
-
-
-
-
-{- | TODO more typed SQL queries
-selectNgramsTindexed :: CorpusId -> NgramsType -> Query NgramsRead
-selectNgramsTindexed corpusId ngramsType = proc () -> do
-    nodeNode   <- queryNodeNodeTable     -< ()
-    nodeNgrams <- queryNodesNgramsTable  -< ()
-    ngrams     <- queryNgramsTable       -< ()
-
-    restrict -< node1_id nodeNode .== pgInt4 corpusId
-    restrict -< node2_id nodeNode .== node_id nodeNgrams
-    restrict -< ngrams_id ngrams  .== node_ngrams nodeNgrams
-
-    result <- aggregate groupBy (ngrams_id ngrams)
-    returnA -< result
---}

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -59,7 +59,7 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
 _postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
 _postNgrams = undefined
 
-_dbGetNgramsDb :: Cmd err [NgramsDb]
+_dbGetNgramsDb :: Cmd err [NgramsDB]
 _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 

src/Gargantext/Database/Query/Table/Node.hs

@@ -190,6 +190,22 @@ node nodeType name hyperData parentId userId =
 insertNodes :: [NodeWrite] -> Cmd err Int64
 insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
+-- insertNodes' :: [Node a] -> Cmd err Int64
+insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
+                        $ Insert nodeTable ns' rCount Nothing
+  where
+    ns' :: [NodeWrite]
+    ns' = map (\(Node i t u p n d h)
+                -> Node (pgNodeId          <$> i)
+                        (pgInt4 $ nodeTypeId   t)
+                        (pgInt4                u)
+                        (pgNodeId          <$> p)
+                        (pgStrictText          n)
+                        (pgUTCTime         <$> d)
+                        (pgJSONB $ cs $ encode h)
+              ) ns
+
+
 insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
   runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)

src/Gargantext/Database/Schema/Ngrams.hs

@@ -42,7 +42,7 @@ type NgramsId    = Int
 type NgramsTerms = Text
 type Size        = Int
 
-data NgramsPoly id terms n = NgramsDb { _ngrams_id    :: !id
+data NgramsPoly id terms n = NgramsDB { _ngrams_id    :: !id
                                       , _ngrams_terms :: !terms
                                       , _ngrams_n     :: !n
                                       } deriving (Show)
@@ -59,14 +59,14 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
                                  (Column (Nullable PGText))
                                  (Column (Nullable PGInt4))
 
-type NgramsDb = NgramsPoly Int Text Int
+type NgramsDB = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
 makeLenses ''NgramsPoly
 
 
 ngramsTable :: Table NgramsWrite NgramsRead
-ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
+ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optional "id"
                                                  , _ngrams_terms = required "terms"
                                                  , _ngrams_n     = required "n"
                                                  }

src/Gargantext/Database/Schema/Node.hs

@@ -25,7 +25,6 @@ import Prelude hiding (null, id, map, sum)
 
 ------------------------------------------------------------------------
 -- Main polymorphic Node definition
-
 data NodePoly id
               typename
               userId
@@ -53,7 +52,6 @@ $(makeLenses ''NodePoly)
 $(makeAdaptorAndInstance "pNode"   ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
 
-------------------------------------------------------------------------
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
                                       , _node_typename   = required "typename"