-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Action.Flow.Utils
where
import Data.Map (Map)
-import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.User
-import Gargantext.Database.Admin.Types.Errors
+import Data.HashMap.Strict (HashMap)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Table.ContextNodeNgrams
import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node
-import Gargantext.Database.Query.Table.NodeNodeNgrams
+import Gargantext.Database.Types
import Gargantext.Prelude
+import Control.Lens ((^.))
import qualified Data.Map as DM
+import qualified Data.HashMap.Strict as HashMap
-getUserId :: HasNodeError err
- => User
- -> Cmd err UserId
-getUserId (UserDBId uid) = pure uid
-getUserId (RootId rid) = do
- n <- getNode rid
- pure $ _node_userId n
-getUserId (UserName u ) = do
- muser <- getUser u
- case muser of
- Just user -> pure $ userLight_id user
- Nothing -> nodeError NoUserFound
-
-toMaps :: Hyperdata a
- => (a -> Map (NgramsT Ngrams) Int)
- -> [Node a]
- -> Map (NgramsT Ngrams) (Map NodeId Int)
-toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
- where
- ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
-
-mapNodeIdNgrams :: Hyperdata a
- => [DocumentIdWithNgrams a]
- -> Map (NgramsT Ngrams) (Map NodeId Int)
-mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
- where
- xs = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
- n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
-
-
-documentIdWithNgrams :: Hyperdata a
- => (a -> Map (NgramsT Ngrams) Int)
- -> [DocumentWithId a]
- -> [DocumentIdWithNgrams a]
-documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
-
-
-data DocumentWithId a =
- DocumentWithId { documentId :: NodeId
- , documentData :: a
- } deriving (Show)
-
-
-data DocumentIdWithNgrams a =
+data DocumentIdWithNgrams a b =
DocumentIdWithNgrams
- { documentWithId :: DocumentWithId a
- , document_ngrams :: Map (NgramsT Ngrams) Int
+ { documentWithId :: Indexed NodeId a
+ , documentNgrams :: HashMap b (Map NgramsType Int)
} deriving (Show)
+insertDocNgrams :: ListId
+ -> HashMap (Indexed NgramsId Ngrams) (Map NgramsType (Map DocId Int))
+ -> Cmd err Int
+insertDocNgrams lId m = insertContextNodeNgrams ns
+ where
+ ns = [ ContextNodeNgrams docId lId (ng^.index)
+ (ngramsTypeId t)
+ (fromIntegral i)
+ | (ng, t2n2i) <- HashMap.toList m
+ , (t, n2i) <- DM.toList t2n2i
+ , (docId, i) <- DM.toList n2i
+ ]
+
-docNgrams2nodeNodeNgrams :: CorpusId
- -> DocNgrams
- -> NodeNodeNgrams
-docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
- NodeNodeNgrams cId d n nt w
-data DocNgrams = DocNgrams { dn_doc_id :: DocId
- , dn_ngrams_id :: Int
- , dn_ngrams_type :: NgramsTypeId
- , dn_weight :: Double
- }
-insertDocNgramsOn :: CorpusId
- -> [DocNgrams]
- -> Cmd err Int
-insertDocNgramsOn cId dn =
- insertNodeNodeNgrams
- $ (map (docNgrams2nodeNodeNgrams cId) dn)
-insertDocNgrams :: CorpusId
- -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
- -> Cmd err Int
-insertDocNgrams cId m =
- insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
- | (ng, t2n2i) <- DM.toList m
- , (t, n2i) <- DM.toList t2n2i
- , (n, i) <- DM.toList n2i
- ]