[Graph Search] FacetPaired.

src/Gargantext/API.hs

@@ -84,6 +84,7 @@ import Gargantext.API.Node ( Roots    , roots
 import Gargantext.Database.Types.Node ()
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
+import Gargantext.Database.Facet
 
 --import Gargantext.API.Orchestrator
 --import Gargantext.API.Orchestrator.Types
@@ -243,7 +244,11 @@ type GargAPI' =
            
            -- Corpus endpoint
            :<|> "search":> Summary "Search endpoint"
-                        :> ReqBody '[JSON] SearchQuery :> SearchAPI
+                        :> ReqBody '[JSON] SearchQuery 
+                        :> QueryParam "offset" Int
+                        :> QueryParam "limit"  Int
+                        :> QueryParam "order"  OrderBy
+                        :> SearchAPI
            
            :<|> "graph" :> Summary "Graph endpoint"
                         :> Capture "id" Int         :> GraphAPI

src/Gargantext/API/Search.hs

@@ -24,8 +24,8 @@ module Gargantext.API.Search
       where
 
 import GHC.Generics (Generic)
+import Data.Time (UTCTime)
 import Control.Monad.IO.Class (liftIO)
-import Data.Aeson hiding (Error, fieldLabelModifier)
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
 import Data.Text (Text)
@@ -36,11 +36,14 @@ import Test.QuickCheck (elements)
 -- import Control.Applicative ((<*>))
 import Gargantext.Prelude
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Types.Main (Offset, Limit)
+import Gargantext.Database.Types.Node
 import Gargantext.Database.TextSearch
+import Gargantext.Database.Facet
 
 -----------------------------------------------------------------------
 data SearchQuery = SearchQuery { sq_query :: [Text]
-                               , sq_parent_id :: Int
+                               , sq_corpus_id :: Int
                                } deriving (Generic)
 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
 instance ToSchema SearchQuery where
@@ -52,39 +55,8 @@ instance Arbitrary SearchQuery where
   arbitrary = elements [SearchQuery ["electrodes"] 472764]
 
 -----------------------------------------------------------------------
-data Author = Author { _a_name :: Text
-                     , _a_id   :: Int
-         } deriving (Generic)
-
-$(deriveJSON (unPrefix "_a_") ''Author)
-
-instance ToSchema Author where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
-
-arbitraryAuthor :: Author
-arbitraryAuthor = Author "Jezequel" 1011669
-instance Arbitrary Author where
-  arbitrary = elements [arbitraryAuthor]
-
------------------------------------------------------------------------
-data SearchResult = SearchResult { sr_id      :: Int
-                                 , sr_title   :: Text
-                                 , sr_authors :: [Author]
-                                 } deriving (Generic)
-$(deriveJSON (unPrefix "sr_") ''SearchResult)
-instance Arbitrary SearchResult where
-  arbitrary = elements [SearchResult 1 "Title" [arbitraryAuthor]]
 
-instance ToSchema SearchResult where
-  declareNamedSchema =
-    genericDeclareNamedSchema
-      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
-
------------------------------------------------------------------------
-
-data SearchResults = SearchResults { srs_results :: [SearchResult]}
+data SearchResults = SearchResults { srs_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]}
   deriving (Generic)
 $(deriveJSON (unPrefix "srs_") ''SearchResults)
 
@@ -96,14 +68,10 @@ instance ToSchema SearchResults where
     genericDeclareNamedSchema
       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
 
-
 -----------------------------------------------------------------------
 type SearchAPI = Post '[JSON] SearchResults
 -----------------------------------------------------------------------
 
-search :: Connection -> SearchQuery -> Handler SearchResults
-search c (SearchQuery q pId) =
-  liftIO $ SearchResults <$> map (\(i, _, t, _, _, _) -> SearchResult i (cs $ encode t) [arbitraryAuthor])
-                         <$> textSearch c (toTSQuery q) pId 5 0 Desc
-
-
+search :: Connection -> SearchQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Handler SearchResults
+search c (SearchQuery q pId) o l order =
+  liftIO $ SearchResults <$> searchInCorpusWithContacts c pId q o l order

src/Gargantext/Database/Facet.hs

@@ -89,8 +89,61 @@ data Facet id date hyperdata score =
               , facetDoc_score     :: score
               } deriving (Show, Generic)
 -}
--- | JSON instance
 
+{-
+type PairLabel = Text
+instance ToJSON PairLabel
+instance ToSchema PairLabel
+instance Arbitrary PairLabel where
+  arbitrary = elements (["Label 1", "Label 2"] :: [PairLabel])
+-}
+data Pair i l = Pair {_p_id    :: i
+                     ,_p_label :: l
+  } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_p_") ''Pair)
+$(makeAdaptorAndInstance "pPair" ''Pair)
+
+instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 3 fieldLabel}
+instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
+  arbitrary = Pair <$> arbitrary <*> arbitrary
+
+data FacetPaired id date hyperdata score pairs =
+  FacetPaired {_fp_id        :: id
+              ,_fp_date      :: date
+              ,_fp_hyperdata :: hyperdata
+              ,_fp_score     :: score
+              ,_fp_pairs     :: pairs
+  } deriving (Show, Generic)
+$(deriveJSON (unPrefix "_fp_") ''FacetPaired)
+$(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
+
+instance (ToSchema id, ToSchema date, ToSchema hyperdata, ToSchema pairs, ToSchema score) => ToSchema (FacetPaired id date hyperdata score pairs) where
+  declareNamedSchema =
+    genericDeclareNamedSchema
+      defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+
+instance ( Arbitrary id
+         , Arbitrary date
+         , Arbitrary hyperdata
+         , Arbitrary score
+         , Arbitrary pairs
+         ) => Arbitrary (FacetPaired id date hyperdata score pairs) where
+  arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+--{-
+type FacetPairedRead = FacetPaired (Column PGInt4       )
+                                   (Column PGTimestamptz)
+                                   (Column PGJsonb      )
+                                   (Column PGInt4       )
+                                   (Pair (Column (Nullable PGInt4)) (Column (Nullable PGText)))
+--}
+
+
+
+-- | JSON instance
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
 
 -- | Documentation instance

src/Gargantext/Database/TextSearch.hs

@@ -74,11 +74,18 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
 ------------------------------------------------------------------------
 type AuthorName = Text
 
-searchInCorpusWithContacts :: Connection -> CorpusId -> Text -> IO [((Int, HyperdataDocument),(ContactId, Maybe AuthorName))]
-searchInCorpusWithContacts c cId q = runQuery c $ queryInCorpusWithContacts cId q
+searchInCorpusWithContacts :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
+searchInCorpusWithContacts = undefined
 
-queryInCorpusWithContacts :: CorpusId -> Text -> O.Query ((Column PGInt4, Column PGJsonb), (Column (PGInt4), Column (Nullable PGText)))
-queryInCorpusWithContacts cId q = proc () -> do
+searchInCorpusWithContacts' :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [(FacetPaired Int UTCTime HyperdataDocument Int (Pair (Maybe Int) (Maybe Text)))]
+searchInCorpusWithContacts' c cId q o l order = runQuery c $ queryInCorpusWithContacts cId q' o l order
+  where
+    q' = intercalate " || " $ map stemIt q
+
+
+
+queryInCorpusWithContacts :: CorpusId -> Text -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> O.Query FacetPairedRead
+queryInCorpusWithContacts cId q _ _ _ = proc () -> do
   (docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
   restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
   restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
@@ -86,7 +93,7 @@ queryInCorpusWithContacts cId q = proc () -> do
   restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
   restrict -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
-  returnA  -< ((_ns_id docs, _ns_hyperdata docs),(fromNullable (pgInt4 0) (_node_id contacts), ngrams_terms ngrams'))
+  returnA  -< FacetPaired (_ns_id docs) (_ns_date docs) (_ns_hyperdata docs) (pgInt4 0) (Pair (_node_id contacts) (ngrams_terms ngrams'))
 
 joinInCorpusWithContacts :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))))
 joinInCorpusWithContacts = leftJoin6 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34 cond45 cond56