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)
+
+
+