[MERGE]

src/Gargantext/API/Search.hs

@@ -191,7 +191,7 @@ class ToRow a where
   toRow :: a -> Row
 
 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
 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int

src/Gargantext/Database/Action/Learn.hs

@@ -41,7 +41,7 @@ moreLike cId o _l order ft = do
 getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
 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
 
   docs_trash <- List.take (List.length docs_fav)
@@ -58,7 +58,7 @@ moreLikeWith :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
 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
 
   let results = map fst
@@ -73,7 +73,7 @@ fav2bool ft = if (==) ft IsFav then True else False
 
 
 text :: FacetDoc -> Text
-text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
+text (FacetDoc _ _ _ h _ _ _)  = title <> "" <> Text.take 100 abstr
   where
     title = maybe "" identity (_hd_title    h)
     abstr = maybe "" identity (_hd_abstract h)

src/Gargantext/Database/Action/Search.hs

@@ -88,12 +88,13 @@ queryInCorpus cId t q = proc () -> do
                  else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
   restrict -< (n ^. ns_search)           @@ (pgTSQuery (unpack q))
   restrict -< (n ^. ns_typename )       .== (pgInt4 $ nodeTypeId NodeDocument)
-  returnA  -< FacetDoc (n^.ns_id       )
-                       (n^.ns_date     )
-                       (n^.ns_name     )
-                       (n^.ns_hyperdata)
-                       (nn^.nn_category)
-                       (nn^.nn_score   )
+  returnA  -< FacetDoc (n^.ns_id        )
+                       (n^.ns_date      )
+                       (n^.ns_name      )
+                       (n^.ns_hyperdata )
+                       (nn^.nn_category )
+                       (nn^.nn_score    )
+                       (nn^.nn_score    )
 
 joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond

src/Gargantext/Database/Query/Facet.hs

@@ -76,19 +76,20 @@ type Category = Int
 type Title    = Text
 
 -- 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 FacetAuthors = 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_created    :: created
               , facetDoc_title      :: title
               , facetDoc_hyperdata  :: hyperdata
               , facetDoc_category   :: category
-              , facetDoc_score      :: ngramCount
+              , facetDoc_ngramCount :: ngramCount
+              , facetDoc_score      :: score
               } deriving (Show, Generic)
 {- | TODO after demo
 data Facet id date hyperdata score = 
@@ -99,8 +100,9 @@ data Facet id date hyperdata score =
               } deriving (Show, Generic)
 -}
 
-data Pair i l = Pair {_p_id    :: i
-                     ,_p_label :: l
+data Pair i l = Pair {
+    _p_id    :: i
+  , _p_label :: l
   } deriving (Show, Generic)
 $(deriveJSON (unPrefix "_p_") ''Pair)
 $(makeAdaptorAndInstance "pPair" ''Pair)
@@ -175,13 +177,14 @@ instance ToSchema FacetDoc where
 
 -- | Mock and Quickcheck instances
 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]
                          , year <- [1990..2000]
                          , t    <- ["title", "another title"]
                          , hp   <- arbitraryHyperdataDocuments
                          , cat  <- [0..2]
                          , ngramCount <- [3..100]
+                         , score <- [3..100]
                          ]
 
 -- Facets / Views for the Front End
@@ -194,6 +197,7 @@ type FacetDocRead = Facet (Column PGInt4       )
                           (Column PGText       )
                           (Column PGJsonb      )
                           (Column (Nullable PGInt4)) -- Category
+                          (Column (Nullable PGFloat8)) -- Ngrams Count
                           (Column (Nullable PGFloat8)) -- Score
 
 -----------------------------------------------------------------------
@@ -252,6 +256,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
                        (_node_hyperdata doc)
                        (toNullable $ pgInt4 1)
                        (toNullable $ pgDouble 1)
+                       (toNullable $ pgDouble 1)
 
 queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
 queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
@@ -318,20 +323,21 @@ viewDocuments cId t ntId mQuery = proc () -> do
                        (_node_hyperdata n)
                        (toNullable $ nn^.nn_category)
                        (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.Limit
      -> Maybe OrderBy
-     -> Select (Facet id (Column date) (Column title) hyperdata (Column score) ngramCount)
-     -> 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 category) ngramCount (Column score))
 filterWith o l order q = limit' l $ offset' o $ orderBy (orderWith order) q
 
 
 orderWith :: (PGOrd b1, PGOrd b2, PGOrd b3)
           => 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 DateDesc)  = desc facetDoc_created
 
@@ -347,6 +353,6 @@ orderWith (Just SourceDesc) = desc facetDoc_source
 orderWith _                = asc facetDoc_created
 
 facetDoc_source :: PGIsJson a
-                => Facet id created title (Column a) favorite ngramCount
+                => Facet id created title (Column a) favorite ngramCount score
                 -> Column (Nullable PGText)
 facetDoc_source x = toNullable (facetDoc_hyperdata x) .->> pgString "source"

src/Gargantext/Database/Query/Tree.hs

@@ -36,7 +36,7 @@ module Gargantext.Database.Query.Tree
   where
 
 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.Map (Map, fromListWith, lookup)
 import qualified Data.Set  as Set
@@ -196,19 +196,18 @@ toTree m =
         Just _r  -> treeError TooManyRoots
 
      where
-       toTree' :: Map (Maybe ParentId) [DbTreeNode]
-               -> DbTreeNode
-               -> Tree NodeTree
-       toTree' m' n =
-         TreeN (toNodeTree n) $
-           -- | Lines below are equivalent computationally but not semantically
-           -- m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
-           toListOf (at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')) m'
-
-       toNodeTree :: DbTreeNode
-                  -> NodeTree
-       toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId
-
+      toTree' :: Map (Maybe ParentId) [DbTreeNode]
+              -> DbTreeNode
+              -> Tree NodeTree
+      toTree' m' n =
+        TreeN (toNodeTree n) $
+          -- | Lines below are equivalent computationally but not semantically
+          -- m' ^.. at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')
+          toListOf (at (Just $ _dt_nodeId n) . _Just . each . to (toTree' m')) m'
+
+      toNodeTree :: DbTreeNode
+                 -> NodeTree
+      toNodeTree (DbTreeNode nId tId _ n) = NodeTree n (fromNodeTypeId tId) nId
 
 ------------------------------------------------------------------------
 toTreeParent :: [DbTreeNode]