Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext...
[gargantext.git] / src / Gargantext / Database / Action / Learn.hs
index 4087b4c77c4b681f7a8a15e161c70556fd0c0fe3..4a7abc4fc1db4069e7da7d6858710831f8a46ae2 100644 (file)
@@ -9,11 +9,7 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE RankNTypes        #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE MonoLocalBinds    #-}
 
 module Gargantext.Database.Action.Learn
@@ -21,13 +17,13 @@ module Gargantext.Database.Action.Learn
 
 import Data.Maybe
 import Data.Text (Text)
-import Data.Tuple (snd)
 import Gargantext.Core.Types (Offset, Limit)
-import Gargantext.Database.Action.Facet
+import Gargantext.Database.Query.Facet
+import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Utils (Cmd)
+import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
-import Gargantext.Text.Learn
+import Gargantext.Core.Text.Learn
 import qualified Data.List as List
 import qualified Data.Text as Text
 
@@ -37,20 +33,20 @@ data FavOrTrash = IsFav | IsTrash
 
 moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
          -> FavOrTrash -> Cmd err [FacetDoc]
-moreLike cId o l order ft = do
+moreLike cId o _l order ft = do
   priors <- getPriors ft cId
-  moreLikeWith cId o l order ft priors
+  moreLikeWith cId o (Just 3) order ft priors
 
 ---------------------------------------------------------------------------
 getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
 getPriors ft cId = do
-  
+
   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2)
               <$> runViewDocuments cId False Nothing Nothing Nothing
-  
+
   docs_trash <- List.take (List.length docs_fav)
             <$> runViewDocuments cId True Nothing Nothing Nothing
-  
+
 
   let priors = priorEventsWith text (fav2bool ft) (  List.zip (repeat False) docs_fav
                                       <> List.zip (repeat True ) docs_trash
@@ -79,8 +75,8 @@ fav2bool ft = if (==) ft IsFav then True else False
 text :: FacetDoc -> Text
 text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
   where
-    title = maybe "" identity (_hyperdataDocument_title    h)
-    abstr = maybe "" identity (_hyperdataDocument_abstract h)
+    title = maybe "" identity (_hd_title    h)
+    abstr = maybe "" identity (_hd_abstract h)
 
 ---------------------------------------------------------------------------