[FIX] ContextNodeNgrams2

src/Gargantext/Database/Action/Flow.hs

@@ -330,7 +330,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do
   -- insertDocNgrams
   _return <- insertContextNodeNgrams2
            $ catMaybes [ ContextNodeNgrams2 <$> Just nId
-                                            <*> getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')
+                                            <*> (getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms''))
                                             <*> Just (fromIntegral w :: Double)
                        | (terms'', mapNgramsTypes)      <- HashMap.toList mapNgramsDocs
                        , (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes
@@ -479,27 +479,24 @@ instance HasText a => HasText (Node a)
 -- | TODO putelsewhere
 -- | Upgrade function
 -- Suppose all documents are English (this is the case actually)
-indexAllDocumentsWithPosTag :: FlowCmdM env err m => m ()
+indexAllDocumentsWithPosTag :: FlowCmdM env err m
+                            => m ()
 indexAllDocumentsWithPosTag = do
   rootId    <- getRootId (UserName userMaster)
   corpusIds <- findNodesId rootId [NodeCorpus]
   docs      <- List.concat <$> mapM getDocumentsWithParentId corpusIds
-
   _ <- mapM extractInsert (splitEvery 1000 docs)
-
   pure ()
 
-extractInsert :: FlowCmdM env err m => [Node HyperdataDocument] -> m ()
+extractInsert :: FlowCmdM env err m
+              => [Node HyperdataDocument] -> m ()
 extractInsert docs = do
   let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
-
   mapNgramsDocs' <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
                     (extractNgramsT $ withLang (Multi EN) documentsWithId)
                     documentsWithId
-
   _ <- insertExtractedNgrams $ HashMap.keys mapNgramsDocs'
-
   pure ()
 
 

src/Gargantext/Database/Query/Join.hs

@@ -58,28 +58,10 @@ leftJoin2 = leftJoin
 
 ------------------------------------------------------------------------
 -- | LeftJoin3 in two ways to write it
-_leftJoin3 :: Select columnsA -> Select columnsB -> Select columnsC
+leftJoin3 :: Select columnsA -> Select columnsB -> Select columnsC
       -> ((columnsA, columnsB, columnsC) -> Column SqlBool) 
       -> Select (columnsA, columnsB, columnsC)
-_leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
-
-
-leftJoin3 :: ( Default Unpackspec b2 b2
-             , Default Unpackspec b3 b3
-             , Default Unpackspec fieldsL fieldsL
-             , Default Unpackspec fieldsR fieldsR
-             , Default NullMaker b3 b4
-             , Default NullMaker b2 b5
-             , Default NullMaker fieldsR b2) =>
-             Select fieldsR
-             -> Select b3
-             -> Select fieldsL
-             -> ((b3, fieldsR) -> Column SqlBool)
-             -> ((fieldsL, (b3, b2)) -> Column SqlBool)
-             -> Select (fieldsL, (b4, b5))
-leftJoin3 q1 q2     q3
-         cond12 cond23 =
-  leftJoin q3 (leftJoin q2 q1 cond12) cond23
+leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
 
 
 leftJoin4 :: (Default Unpackspec b2 b2,

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

@@ -18,6 +18,7 @@ Portability : POSIX
 module Gargantext.Database.Query.Table.ContextNodeNgrams2
   ( module Gargantext.Database.Schema.ContextNodeNgrams2
   , insertContextNodeNgrams2
+  , queryContextNodeNgrams2Table
   )
   where
 
@@ -28,15 +29,15 @@ import Gargantext.Database.Prelude (Cmd, mkCmd)
 import Prelude
 
 
-_queryContextNodeNgrams2Table :: Query ContextNodeNgrams2Read
-_queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
+queryContextNodeNgrams2Table :: Query ContextNodeNgrams2Read
+queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
 
 -- | Insert utils
 insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> Cmd err Int
 insertContextNodeNgrams2 = insertContextNodeNgrams2W
                      . map (\(ContextNodeNgrams2 n1 n2 w) ->
                               ContextNodeNgrams2 (pgNodeId n1)
-                                                 (sqlInt4   n2)
+                                                 (sqlInt4  n2)
                                                  (sqlDouble w)
                            )
 

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

@@ -22,39 +22,44 @@ module Gargantext.Database.Query.Table.Ngrams
     where
 
 import Control.Lens ((^.))
-import Data.HashMap.Strict (HashMap)
 import Data.ByteString.Internal (ByteString)
+import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
-import qualified Database.PostgreSQL.Simple as PGS
-import qualified Data.List                  as List
 import qualified Data.HashMap.Strict        as HashMap
+import qualified Data.List                  as List
+import qualified Database.PostgreSQL.Simple as PGS
 
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (runOpaQuery, Cmd)
-import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery)
-import Gargantext.Database.Query.Table.ContextNodeNgrams
+import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery)
+import Gargantext.Database.Query.Join (leftJoin3)
+import Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Schema.Ngrams
+import Gargantext.Database.Schema.NodeNgrams
+import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Types
 import Gargantext.Prelude
 
-queryNgramsTable :: Query NgramsRead
+queryNgramsTable :: Select NgramsRead
 queryNgramsTable = selectTable ngramsTable
 
 selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
 selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
   where
 
-    join :: Query (NgramsRead, ContextNodeNgramsReadNull)
-    join = leftJoin queryNgramsTable queryContextNodeNgramsTable on1
+    join :: Select (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read)
+    join = leftJoin3 queryNgramsTable queryNodeNgramsTable queryContextNodeNgrams2Table on1 -- on2
       where
-        on1 (ng,cnng) = ng^.ngrams_id .== cnng^.cnng_ngrams_id
-
-    query cIds' dId' nt' = proc () -> do
-      (ng,cnng) <- join -< ()
-      restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== cnng^.cnng_node_id) .|| b) (sqlBool True) cIds'
-      restrict -< (toNullable $ pgNodeId dId')    .== cnng^.cnng_context_id
-      restrict -< (toNullable $ pgNgramsType nt') .== cnng^.cnng_ngramsType
+        on1 :: (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read) -> Column SqlBool
+        on1 (ng, nng, cnng) =  (.&&)
+                                 (ng^.ngrams_id .== nng^.nng_ngrams_id)
+                                 (nng^.nng_id   .== cnng^.cnng2_nodengrams_id)
+
+    query lIds' dId' nt' = proc () -> do
+      (ng,nng,cnng) <- join -< ()
+      restrict -< foldl (\b lId -> ((pgNodeId lId) .== nng^.nng_node_id) .|| b) (sqlBool True) lIds'
+      restrict -< (pgNodeId dId')    .== cnng^.cnng2_context_id
+      restrict -< (pgNgramsType nt') .== nng^.nng_ngrams_type
       returnA  -< ng^.ngrams_terms
 
 

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

@@ -116,7 +116,6 @@ getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
   pure $ TableResult { tr_docs = map context2node docs, tr_count = docCount }
 
 
-
 selectChildren' :: HasDBid NodeType
                => ParentId
                -> Maybe NodeType

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

@@ -40,20 +40,19 @@ import Data.Maybe (catMaybes)
 import Data.Text (Text, splitOn)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Opaleye
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import qualified Opaleye as O
-import Opaleye
 
 import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Schema.NodeContext
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude
-import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Context
+import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.NodeContext
 import Gargantext.Prelude
 
-
 queryNodeContextTable :: Select NodeContextRead
 queryNodeContextTable = selectTable nodeContextTable
 

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

@@ -22,6 +22,7 @@ module Gargantext.Database.Query.Table.NodeNgrams
   ( getCgramsId
   , listInsertDb
   , module Gargantext.Database.Schema.NodeNgrams
+  , queryNodeNgramsTable
   )
   where
 
@@ -29,22 +30,22 @@ import Data.List.Extra (nubOrd)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
-import Database.PostgreSQL.Simple (FromRow)
-import Database.PostgreSQL.Simple.FromRow (fromRow, field)
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Database.PostgreSQL.Simple.ToField (toField)
-import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
 import Gargantext.Database.Schema.NodeNgrams
+import Gargantext.Database.Schema.Prelude (Select, FromRow, sql, fromRow, toField, field, Values(..), QualifiedIdentifier(..), selectTable)
 import Gargantext.Prelude
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 
 
+queryNodeNgramsTable :: Select NodeNgramsRead
+queryNodeNgramsTable = selectTable nodeNgramsTable
+
+
 -- | Type for query return
 data Returning = Returning { re_type      :: !(Maybe NgramsType)
                            , re_terms     :: !Text

src/Gargantext/Database/Schema/ContextNodeNgrams2.hs

@@ -24,10 +24,8 @@ import Gargantext.Database.Schema.Prelude
 import Prelude
 
 
-type ContextNodeNgrams2 =
-  ContextNodeNgrams2Poly ContextId NodeNgramsId Weight
+type ContextNodeNgrams2 = ContextNodeNgrams2Poly ContextId NodeNgramsId Double
 
-type Weight = Double
 
 data ContextNodeNgrams2Poly context_id nodengrams_id w
    = ContextNodeNgrams2 { _cnng2_context_id    :: !context_id

src/Gargantext/Database/Schema/NodeNgrams.hs

@@ -23,6 +23,7 @@ module Gargantext.Database.Schema.NodeNgrams where
 import Data.Text (Text)
 import Gargantext.Core.Types
 import Gargantext.Database.Schema.Ngrams (NgramsType)
+import Gargantext.Database.Schema.Prelude
 import Gargantext.Prelude
 
 
@@ -46,7 +47,7 @@ data NodeNgramsPoly id
                                 , _nng_ngrams_weight :: !weight
                               } deriving (Show, Eq, Ord)
 
-{-
+
 type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (SqlInt4)))
                                       (Column (SqlInt4))
                                       (Maybe  (Column (SqlInt4)))
@@ -57,7 +58,7 @@ type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (SqlInt4)))
                                       (Maybe  (Column (SqlInt4)))
                                       (Maybe  (Column (SqlFloat8)))
 
-type NodeNodeRead    = NodeNgramsPoly (Column SqlInt4)
+type NodeNgramsRead    = NodeNgramsPoly (Column SqlInt4)
                                       (Column SqlInt4)
                                       (Column SqlInt4)
                                       (Column SqlInt4)
@@ -67,6 +68,7 @@ type NodeNodeRead    = NodeNgramsPoly (Column SqlInt4)
                                       (Column SqlInt4)
                                       (Column SqlFloat8)
 
+
 type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable SqlInt4))
                                          (Column (Nullable SqlInt4))
                                          (Column (Nullable SqlInt4))
@@ -77,9 +79,7 @@ type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable SqlInt4))
                                          (Column (Nullable SqlInt4))
                                          (Column (Nullable SqlInt4))
                                          (Column (Nullable SqlFloat8))
--}
 type NodeNgramsId = Int
-type NgramsId     = Int
 type NgramsField  = Int
 type NgramsTag    = Int
 type NgramsClass  = Int
@@ -93,3 +93,21 @@ type NodeNgramsW =
                   NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
                   Double
 
+$(makeAdaptorAndInstance "pNodeNgrams" ''NodeNgramsPoly)
+makeLenses ''NodeNgramsPoly
+
+nodeNgramsTable :: Table NodeNgramsWrite NodeNgramsRead
+nodeNgramsTable  =
+  Table "node_ngrams"
+         ( pNodeNgrams
+           NodeNgrams { _nng_id            = optionalTableField "id"
+                      , _nng_node_id       = requiredTableField "node_id"
+                      , _nng_node_subtype  = optionalTableField "node_subtype"
+                      , _nng_ngrams_id     = requiredTableField "ngrams_id"
+                      , _nng_ngrams_type   = optionalTableField "ngrams_type"
+                      , _nng_ngrams_field  = optionalTableField "ngrams_field"
+                      , _nng_ngrams_tag    = optionalTableField "ngrams_tag"
+                      , _nng_ngrams_class  = optionalTableField "ngrams_class"
+                      , _nng_ngrams_weight = optionalTableField "weight"
+                      }
+                  )