[TSVector] added for full text queries.

install

@@ -27,6 +27,7 @@ git clone ssh://git@gitlab.iscpif.fr:20022/gargantext/clustering-louvain.git
 git clone https://github.com/np/servant-job.git
 git clone https://github.com/np/patches-map
 git clone https://gitlab.com/npouillard/patches-class.git
+git clone https://github.com:delanoe/haskell-opaleye.git
 cd ..
 
 ~/.local/bin/stack docker pull

package.yaml

 name: gargantext
-version: '4.0.0.2'
+version: '4.0.0.3'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data

src/Gargantext/Database/Facet.hs

@@ -50,7 +50,7 @@ import Gargantext.Database.NodeNgram
 import Gargantext.Database.NodeNode
 import Gargantext.Database.Queries
 import Opaleye
-import Opaleye.Internal.Join (NullMaker)
+import Opaleye.Internal.Join (NullMaker(..))
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Prelude hiding (null, id, map, sum, not, read)
 import Servant.API
@@ -193,8 +193,6 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable
          cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== nodeNgram_NodeNgramNodeId         nodeNgram2
 
 
-
-
 ------------------------------------------------------------------------
 
 runViewDocuments :: CorpusId -> Trash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd [FacetDoc]

src/Gargantext/Database/Flow/Utils.hs

@@ -26,7 +26,7 @@ import Gargantext.Database.NodeNgram
 toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
   where
-    ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
+    ns' = map (\(Node nId _ _ _ _ _ json _) -> DocumentWithId nId json) ns
 
 mapNodeIdNgrams :: Hyperdata a => [DocumentIdWithNgrams a] -> Map (NgramsT Ngrams) (Map NodeId Int)
 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs

src/Gargantext/Database/Node/Children.hs

@@ -40,7 +40,7 @@ getChildren c pId _ maybeNodeType maybeOffset maybeLimit = runQuery c
 
 selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
 selectChildren parentId maybeNodeType = proc () -> do
-    row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
+    row@(Node nId typeName _ parent_id _ _ _ _) <- queryNodeTable -< ()
     (NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
     
     let nodeType = maybe 0 nodeTypeId maybeNodeType

src/Gargantext/Database/Queries.hs

@@ -37,7 +37,7 @@ type NodeWrite = NodePoly  (Maybe (Column  PGInt4              ))
                                   (Column (PGText              ))
                                   (Maybe  (Column PGTimestamptz))
                                   (Column  PGJsonb              )
-                                  -- (Maybe (Column PGTSVector))
+                                  (Maybe (Column PGTSVector))
 
 type NodeRead = NodePoly  (Column  PGInt4           )
                           (Column  PGInt4           )
@@ -46,8 +46,7 @@ type NodeRead = NodePoly  (Column  PGInt4           )
                           (Column (PGText          ))
                           (Column PGTimestamptz     )
                           (Column PGJsonb) 
-                          -- (Column PGTSVector)
-
+                          (Column PGTSVector)
 
 
 type NodeReadNull = NodePoly  (Column  (Nullable PGInt4           ))
@@ -57,8 +56,7 @@ type NodeReadNull = NodePoly  (Column  (Nullable PGInt4           ))
                               (Column (Nullable PGText          ))
                               (Column (Nullable PGTimestamptz     ))
                               (Column (Nullable PGJsonb))
-
-
+                              (Column (Nullable PGTSVector))
 
 
 join3 :: Query columnsA -> Query columnsB -> Query columnsC 

src/Gargantext/Database/TextSearch.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE Arrows            #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -26,13 +27,30 @@ import Database.PostgreSQL.Simple.ToField
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (NodeType(..))
 import Gargantext.Prelude
+import Gargantext.Database.Node
+import Gargantext.Database.Queries
+import Gargantext.Core.Types
+import Control.Arrow (returnA)
+import qualified Opaleye as O hiding (Order)
+import Opaleye hiding (Query, Order)
 
 newtype TSQuery = UnsafeTSQuery [Text]
 
+
+
+searchQuery :: O.Query NodeRead
+searchQuery = proc () -> do
+    row <- queryNodeTable -< ()
+    restrict -< (_node_search row) @@ (pgTSQuery "test")
+    returnA -< row
+
+
+
 -- | TODO [""] -> panic "error"
 toTSQuery :: [Text] -> TSQuery
 toTSQuery txt = UnsafeTSQuery txt
 
+
 instance IsString TSQuery
   where
     fromString = UnsafeTSQuery . words . cs
@@ -48,9 +66,6 @@ instance ToField TSQuery
                                 ]
                     ) xs
 
-type ParentId = Int
-type Limit    = Int
-type Offset   = Int
 data Order    = Asc | Desc
 
 instance ToField Order

src/Gargantext/Database/Types/Node.hs

@@ -63,8 +63,6 @@ type UTCTime' = UTCTime
 instance Arbitrary UTCTime' where
     arbitrary = elements $ timesAfter 100 D (jour 2000 01 01)
 
-
-
 ------------------------------------------------------------------------
 data Status  = Status { status_failed    :: Int
                       , status_succeeded :: Int
@@ -324,18 +322,15 @@ instance Hyperdata HyperdataNotebook
 
 
 -- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
+type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
 
 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 type NodeTypeId   = Int
 type NodeParentId = Int
 type NodeUserId   = Int
 type NodeName     = Text
---type NodeVector   = Vector
+type TSVector     = Text
 
---type NodeUser    = Node HyperdataUser
-
-type NodeAny      = Node HyperdataAny
 
 -- | Then a Node can be either a Folder or a Corpus or a Document
 type NodeUser     = Node HyperdataUser
@@ -347,6 +342,9 @@ type NodeDocument = Node HyperdataDocument
 
 type NodeAnnuaire = Node HyperdataAnnuaire
 
+-- | Any others nodes
+type NodeAny      = Node HyperdataAny
+
 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 type NodeList     = Node HyperdataList
 type NodeGraph    = Node HyperdataGraph
@@ -379,24 +377,30 @@ instance ToParamSchema NodeType
 instance ToSchema      NodeType
 
 ------------------------------------------------------------------------
-data NodePoly id typename userId parentId name date hyperdata = Node { _node_id        :: id
-                                                                     , _node_typename  :: typename
-                                                                     , _node_userId    :: userId
+data NodePoly id        typename userId 
+              parentId  name     date 
+              hyperdata search = Node { _node_id        :: id
+                                      , _node_typename  :: typename
+                                      , _node_userId    :: userId
                                                                 --   , nodeUniqId    :: hashId
-                                                                     , _node_parentId  :: parentId
-                                                                     , _node_name      :: name
-                                                                     , _node_date      :: date
-                                                                     , _node_hyperdata :: hyperdata
-                                                                     } deriving (Show, Generic)
+                                      , _node_parentId  :: parentId
+                                      , _node_name      :: name
+                                      , _node_date      :: date
+                                  
+                                      , _node_hyperdata :: hyperdata
+                                      , _node_search    :: search
+                                      } deriving (Show, Generic)
 $(deriveJSON (unPrefix "_node_") ''NodePoly)
 $(makeLenses ''NodePoly)
 
-instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime hyperdata) where
-    arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) <$> arbitrary
-
-instance Arbitrary hyperdata => Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime hyperdata) where
-    arbitrary = Node 1 1 1 (Just 1) "name" (jour 2018 01 01) <$> arbitrary
 
+instance Arbitrary hyperdata => Arbitrary (NodePoly          NodeId       NodeTypeId
+                                          (Maybe NodeUserId) NodeParentId NodeName
+                                          UTCTime            hyperdata    (Maybe TSVector)) where
+    --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
+    arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
+                     <*> arbitrary <*> arbitrary <*> arbitrary
+                     <*> arbitrary <*> arbitrary
 ------------------------------------------------------------------------
 hyperdataDocument :: HyperdataDocument
 hyperdataDocument = case decode docExample of
@@ -438,18 +442,17 @@ instance ToSchema hyperdata =>
          ToSchema (NodePoly NodeId NodeTypeId
                             (Maybe NodeUserId)
                             NodeParentId NodeName
-                            UTCTime hyperdata
+                            UTCTime hyperdata TSVector
                   )
 
 instance ToSchema hyperdata =>
          ToSchema (NodePoly NodeId NodeTypeId
                             NodeUserId
                             (Maybe NodeParentId) NodeName
-                            UTCTime hyperdata
+                            UTCTime hyperdata TSVector
                   )
 
 
-
 instance ToSchema Status
 
 

stack.yaml

@@ -7,6 +7,7 @@ packages:
 - 'deps/clustering-louvain'
 - 'deps/patches-map'
 - 'deps/patches-class'
+- 'deps/haskell-opaleye'
 
 allow-newer: true
 extra-deps:
@@ -17,7 +18,7 @@ extra-deps:
 - git: https://github.com/delanoe/servant-static-th.git
   commit: ba5347e7d8a13ce5275af8470c15b2305fbb23af
 - accelerate-1.2.0.0
-- opaleye-0.6.7002.0
+#- opaleye-0.6.7002.0
 - aeson-lens-0.5.0.0
 - duckling-0.1.3.0
 - full-text-search-0.2.1.4