Commit a37be465 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE]

parents 167b8698 c02e87d8
Pipeline #1290 failed with stage
...@@ -191,7 +191,7 @@ class ToRow a where ...@@ -191,7 +191,7 @@ class ToRow a where
toRow :: a -> Row toRow :: a -> Row
instance ToRow FacetDoc where instance ToRow FacetDoc where
toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md) toRow (FacetDoc nId utc t h mc _md sc) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
-- | TODO rename FacetPaired -- | TODO rename FacetPaired
type FacetContact = FacetPaired Int UTCTime HyperdataContact Int type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
......
...@@ -41,7 +41,7 @@ moreLike cId o _l order ft = do ...@@ -41,7 +41,7 @@ moreLike cId o _l order ft = do
getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool) getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
getPriors ft cId = do getPriors ft cId = do
docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2) docs_fav <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
<$> runViewDocuments cId False Nothing Nothing Nothing Nothing <$> runViewDocuments cId False Nothing Nothing Nothing Nothing
docs_trash <- List.take (List.length docs_fav) docs_trash <- List.take (List.length docs_fav)
...@@ -58,7 +58,7 @@ moreLikeWith :: CorpusId -> Maybe Offset -> Maybe Limit -> Maybe OrderBy ...@@ -58,7 +58,7 @@ moreLikeWith :: CorpusId -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
-> FavOrTrash -> Events Bool -> Cmd err [FacetDoc] -> FavOrTrash -> Events Bool -> Cmd err [FacetDoc]
moreLikeWith cId o l order ft priors = do moreLikeWith cId o l order ft priors = do
docs_test <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 1) docs_test <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1)
<$> runViewDocuments cId False o Nothing order Nothing <$> runViewDocuments cId False o Nothing order Nothing
let results = map fst let results = map fst
...@@ -73,7 +73,7 @@ fav2bool ft = if (==) ft IsFav then True else False ...@@ -73,7 +73,7 @@ fav2bool ft = if (==) ft IsFav then True else False
text :: FacetDoc -> Text text :: FacetDoc -> Text
text (FacetDoc _ _ _ h _ _) = title <> "" <> Text.take 100 abstr text (FacetDoc _ _ _ h _ _ _) = title <> "" <> Text.take 100 abstr
where where
title = maybe "" identity (_hd_title h) title = maybe "" identity (_hd_title h)
abstr = maybe "" identity (_hd_abstract h) abstr = maybe "" identity (_hd_abstract h)
......
...@@ -91,8 +91,9 @@ queryInCorpus cId t q = proc () -> do ...@@ -91,8 +91,9 @@ queryInCorpus cId t q = proc () -> do
returnA -< FacetDoc (n^.ns_id ) returnA -< FacetDoc (n^.ns_id )
(n^.ns_date ) (n^.ns_date )
(n^.ns_name ) (n^.ns_name )
(n^.ns_hyperdata) (n^.ns_hyperdata )
(nn^.nn_category) (nn^.nn_category )
(nn^.nn_score )
(nn^.nn_score ) (nn^.nn_score )
joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull) joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
......
...@@ -76,19 +76,20 @@ type Category = Int ...@@ -76,19 +76,20 @@ type Category = Int
type Title = Text type Title = Text
-- TODO remove Title -- TODO remove Title
type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double) type FacetDoc = Facet NodeId UTCTime Title HyperdataDocument (Maybe Category) (Maybe Double) (Maybe Double)
-- type FacetSources = FacetDoc -- type FacetSources = FacetDoc
-- type FacetAuthors = FacetDoc -- type FacetAuthors = FacetDoc
-- type FacetTerms = FacetDoc -- type FacetTerms = FacetDoc
data Facet id created title hyperdata category ngramCount = data Facet id created title hyperdata category ngramCount score =
FacetDoc { facetDoc_id :: id FacetDoc { facetDoc_id :: id
, facetDoc_created :: created , facetDoc_created :: created
, facetDoc_title :: title , facetDoc_title :: title
, facetDoc_hyperdata :: hyperdata , facetDoc_hyperdata :: hyperdata
, facetDoc_category :: category , facetDoc_category :: category
, facetDoc_score :: ngramCount , facetDoc_ngramCount :: ngramCount
, facetDoc_score :: score
} deriving (Show, Generic) } deriving (Show, Generic)
{- | TODO after demo {- | TODO after demo
data Facet id date hyperdata score = data Facet id date hyperdata score =
...@@ -99,8 +100,9 @@ data Facet id date hyperdata score = ...@@ -99,8 +100,9 @@ data Facet id date hyperdata score =
} deriving (Show, Generic) } deriving (Show, Generic)
-} -}
data Pair i l = Pair {_p_id :: i data Pair i l = Pair {
,_p_label :: l _p_id :: i
, _p_label :: l
} deriving (Show, Generic) } deriving (Show, Generic)
$(deriveJSON (unPrefix "_p_") ''Pair) $(deriveJSON (unPrefix "_p_") ''Pair)
$(makeAdaptorAndInstance "pPair" ''Pair) $(makeAdaptorAndInstance "pPair" ''Pair)
...@@ -175,13 +177,14 @@ instance ToSchema FacetDoc where ...@@ -175,13 +177,14 @@ instance ToSchema FacetDoc where
-- | Mock and Quickcheck instances -- | Mock and Quickcheck instances
instance Arbitrary FacetDoc where instance Arbitrary FacetDoc where
arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount) arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount) (Just score)
| id' <- [1..10] | id' <- [1..10]
, year <- [1990..2000] , year <- [1990..2000]
, t <- ["title", "another title"] , t <- ["title", "another title"]
, hp <- arbitraryHyperdataDocuments , hp <- arbitraryHyperdataDocuments
, cat <- [0..2] , cat <- [0..2]
, ngramCount <- [3..100] , ngramCount <- [3..100]
, score <- [3..100]
] ]
-- Facets / Views for the Front End -- Facets / Views for the Front End
...@@ -194,6 +197,7 @@ type FacetDocRead = Facet (Column PGInt4 ) ...@@ -194,6 +197,7 @@ type FacetDocRead = Facet (Column PGInt4 )
(Column PGText ) (Column PGText )
(Column PGJsonb ) (Column PGJsonb )
(Column (Nullable PGInt4)) -- Category (Column (Nullable PGInt4)) -- Category
(Column (Nullable PGFloat8)) -- Ngrams Count
(Column (Nullable PGFloat8)) -- Score (Column (Nullable PGFloat8)) -- Score
----------------------------------------------------------------------- -----------------------------------------------------------------------
...@@ -252,6 +256,7 @@ viewAuthorsDoc cId _ nt = proc () -> do ...@@ -252,6 +256,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
(_node_hyperdata doc) (_node_hyperdata doc)
(toNullable $ pgInt4 1) (toNullable $ pgInt4 1)
(toNullable $ pgDouble 1) (toNullable $ pgDouble 1)
(toNullable $ pgDouble 1)
queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45 queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
...@@ -318,20 +323,21 @@ viewDocuments cId t ntId mQuery = proc () -> do ...@@ -318,20 +323,21 @@ viewDocuments cId t ntId mQuery = proc () -> do
(_node_hyperdata n) (_node_hyperdata n)
(toNullable $ nn^.nn_category) (toNullable $ nn^.nn_category)
(toNullable $ nn^.nn_score) (toNullable $ nn^.nn_score)
(toNullable $ nn^.nn_score)
------------------------------------------------------------------------ ------------------------------------------------------------------------
filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) => filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~ Column SqlJsonb) =>
Maybe Gargantext.Core.Types.Offset Maybe Gargantext.Core.Types.Offset
-> Maybe Gargantext.Core.Types.Limit -> Maybe Gargantext.Core.Types.Limit
-> Maybe OrderBy -> Maybe OrderBy
-> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount) -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
-> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount) -> Select (Facet id (Column date) (Column title) hyperdata (Column category) ngramCount (Column score))
filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3) orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3)
=> Maybe OrderBy => Maybe OrderBy
-> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) score) -> Order (Facet id (Column b1) (Column b2) (Column SqlJsonb) (Column b3) ngramCount score)
orderWith (Just DateAsc) = asc facetDoc_created orderWith (Just DateAsc) = asc facetDoc_created
orderWith (Just DateDesc) = desc facetDoc_created orderWith (Just DateDesc) = desc facetDoc_created
...@@ -347,6 +353,6 @@ orderWith (Just SourceDesc) = desc facetDoc_source ...@@ -347,6 +353,6 @@ orderWith (Just SourceDesc) = desc facetDoc_source
orderWith _ = asc facetDoc_created orderWith _ = asc facetDoc_created
facetDoc_source :: PGIsJson a facetDoc_source :: PGIsJson a
=> Facet id created title (Column a) favorite ngramCount => Facet id created title (Column a) favorite ngramCount score
-> Column (Nullable PGText) -> Column (Nullable PGText)
facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source" facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"
...@@ -36,7 +36,7 @@ module Gargantext.Database.Query.Tree ...@@ -36,7 +36,7 @@ module Gargantext.Database.Query.Tree
where where
import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses) import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses)
import Control.Monad.Except (MonadError()) import Control.Monad.Error.Class (MonadError())
import Data.List (tail, concat, nub) import Data.List (tail, concat, nub)
import Data.Map (Map, fromListWith, lookup) import Data.Map (Map, fromListWith, lookup)
import qualified Data.Set as Set import qualified Data.Set as Set
...@@ -209,7 +209,6 @@ toTree m = ...@@ -209,7 +209,6 @@ toTree m =
-> NodeTree -> NodeTree
toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId
------------------------------------------------------------------------ ------------------------------------------------------------------------
toTreeParent :: [DbTreeNode] toTreeParent :: [DbTreeNode]
-> Map (Maybe ParentId) [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
......
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