Commit 0dc3d444 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Graph Search] union of pairs.

parent cce2004f
...@@ -90,13 +90,6 @@ data Facet id date hyperdata score = ...@@ -90,13 +90,6 @@ data Facet id date hyperdata score =
} deriving (Show, Generic) } deriving (Show, Generic)
-} -}
{-
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 data Pair i l = Pair {_p_id :: i
,_p_label :: l ,_p_label :: l
} deriving (Show, Generic) } deriving (Show, Generic)
......
...@@ -15,6 +15,8 @@ Portability : POSIX ...@@ -15,6 +15,8 @@ Portability : POSIX
module Gargantext.Database.TextSearch where module Gargantext.Database.TextSearch where
import Data.Aeson import Data.Aeson
import Data.Map.Strict hiding (map)
import Data.Maybe
import Data.List (intersperse) import Data.List (intersperse)
import Data.String (IsString(..)) import Data.String (IsString(..))
import Data.Text (Text, words, unpack, intercalate) import Data.Text (Text, words, unpack, intercalate)
...@@ -75,7 +77,12 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond ...@@ -75,7 +77,12 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
type AuthorName = Text type AuthorName = Text
searchInCorpusWithContacts :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] searchInCorpusWithContacts :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
searchInCorpusWithContacts = undefined searchInCorpusWithContacts c cId q o l order = map (\((i,u,h,s), ps) -> FacetPaired i u h s (catMaybes ps)) <$> toList <$> fromListWith (<>) <$> map (\(FacetPaired i u h s p) -> ((i,u,h,s), [maybePair p])) <$> searchInCorpusWithContacts' c cId q o l order
where
maybePair (Pair Nothing Nothing) = Nothing
maybePair (Pair _ Nothing) = Nothing
maybePair (Pair Nothing _) = Nothing
maybePair (Pair (Just i) (Just l)) = Just $ Pair i l
searchInCorpusWithContacts' :: Connection -> CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> IO [(FacetPaired Int UTCTime HyperdataDocument Int (Pair (Maybe Int) (Maybe Text)))] 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 searchInCorpusWithContacts' c cId q o l order = runQuery c $ queryInCorpusWithContacts cId q' o l order
......
...@@ -131,6 +131,12 @@ data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd ...@@ -131,6 +131,12 @@ data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd
$(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument) $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
$(makeLenses ''HyperdataDocument) $(makeLenses ''HyperdataDocument)
instance Eq HyperdataDocument where
(==) h1 h2 = (==) (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
instance Ord HyperdataDocument where
compare h1 h2 = compare (_hyperdataDocument_uniqId h1) (_hyperdataDocument_uniqId h2)
instance Hyperdata HyperdataDocument instance Hyperdata HyperdataDocument
instance ToField HyperdataDocument where instance ToField HyperdataDocument where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment