[graphql] first asynctask work
[gargantext.git] / src / Gargantext / Database / Action / Metrics.hs
index 5771ed05a701eaaf845347f3950d70b56d253368..4fd263ea3d04a94cf8727e26ca215c6edf862e8e 100644 (file)
@@ -10,74 +10,75 @@ Portability : POSIX
 Node API
 -}
 
-
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
-
 module Gargantext.Database.Action.Metrics
   where
 
-import Data.Map (Map)
-import Data.Text (Text)
-import Gargantext.API.Ngrams (TabType(..), ngramsTypeFromTabType)
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
+import Data.HashMap.Strict (HashMap)
+import Data.Vector (Vector)
+import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo')
+import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm)
+import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
+import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
-import Gargantext.Database.Flow (FlowCmdM)
-import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
-import Gargantext.Database.Node.Select
-import Gargantext.Database.Schema.Node (defaultList)
-import Gargantext.Database.Types.Node (ListId, CorpusId{-, HyperdataCorpus-})
---import Gargantext.Database.Flow (getOrMkRootWithCorpus)
-import Gargantext.Database.Config (userMaster)
+import Gargantext.Core.NodeStory
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
+import Gargantext.Database.Admin.Config (userMaster)
+import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
+import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Prelude
-import Gargantext.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
-import qualified Data.Map    as Map
---import qualified Data.Vector.Storable as Vec
+import qualified Data.HashMap.Strict as HM
 
 getMetrics :: FlowCmdM env err m
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m (Map Text (ListType, Maybe Text), [Scored Text])
+            -> m (HashMap NgramsTerm (ListType, Maybe NgramsTerm), Vector (Scored NgramsTerm))
 getMetrics cId maybeListId tabType maybeLimit = do
   (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
+  -- TODO HashMap
   pure (ngs, scored myCooc)
 
 
 getNgramsCooc :: (FlowCmdM env err m)
             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-            -> m ( Map Text (ListType, Maybe Text)
-                 , Map Text (Maybe RootTerm)
-                 , Map (Text, Text) Int
+            -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                 , HashMap NgramsTerm (Maybe RootTerm)
+                 , HashMap (NgramsTerm, NgramsTerm) Int
                  )
 getNgramsCooc cId maybeListId tabType maybeLimit = do
   (ngs', ngs) <- getNgrams cId maybeListId tabType
-  
+
   let
-    take' Nothing xs  = xs
+    take' Nothing  xs = xs
     take' (Just n) xs = take n xs
 
   lId  <- defaultList cId
   lIds <- selectNodesWithUsername NodeList userMaster
 
-  myCooc <- Map.filter (>1) <$> getCoocByNgrams (Diagonal True)
-                            <$> groupNodesByNgrams ngs
-                            <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
-                                                             (take' maybeLimit $ Map.keys ngs)
+  myCooc <- HM.filter (>1) <$> getCoocByNgrams (Diagonal True)
+                           <$> groupNodesByNgrams ngs
+                           <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) (ngramsTypeFromTabType tabType)
+                                                            (take' maybeLimit $ HM.keys ngs)
   pure $ (ngs', ngs, myCooc)
 
 
 
-getNgrams :: (FlowCmdM env err m)
+getNgrams :: (HasMail env, HasNodeStory env err m)
             => CorpusId -> Maybe ListId -> TabType
-            -> m (Map Text (ListType, Maybe Text), Map Text (Maybe RootTerm))
+            -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
+                 , HashMap NgramsTerm (Maybe RootTerm)
+                 )
 getNgrams cId maybeListId tabType = do
 
   lId <- case maybeListId of
     Nothing   -> defaultList cId
     Just lId' -> pure lId'
 
-  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo
-  let maybeSyn = Map.unions $ map (\t -> filterListWithRoot t lists)
-                             [GraphTerm, StopTerm, CandidateTerm]
+  lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId]
+  let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
+                             [MapTerm, StopTerm, CandidateTerm]
   pure (lists, maybeSyn)
 
+
+
+