2 Module : Gargantext.Database.Flow.List
3 Description : List Flow
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
14 {-# LANGUAGE ConstraintKinds #-}
15 {-# LANGUAGE RankNTypes #-}
16 {-# LANGUAGE ConstrainedClassMethods #-}
17 {-# LANGUAGE ConstraintKinds #-}
18 {-# LANGUAGE DeriveGeneric #-}
19 {-# LANGUAGE FlexibleContexts #-}
20 {-# LANGUAGE InstanceSigs #-}
21 {-# LANGUAGE NoImplicitPrelude #-}
22 {-# LANGUAGE OverloadedStrings #-}
24 module Gargantext.Database.Flow.List
26 import Control.Monad (mapM_)
27 import Data.Map (Map, toList)
28 import Data.Maybe (Maybe(..), catMaybes)
29 import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
30 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId)
31 import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
32 import Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams -- (insert_Node_NodeNgrams_NodeNgrams, Node_NodeNgrams_NodeNgrams(..))
33 import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
34 import Gargantext.Database.Flow.Types
35 import Gargantext.Prelude
36 import qualified Data.List as List
37 import qualified Data.Map as Map
41 -- | TODO check optimization
42 mapNodeIdNgrams :: [DocumentIdWithNgrams a]
43 -> Map Ngrams (Map NgramsType (Map NodeId Int))
44 mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
46 f :: DocumentIdWithNgrams a
47 -> Map Ngrams (Map NgramsType (Map NodeId Int))
48 f d = fmap (fmap (Map.singleton nId)) $ document_ngrams d
50 nId = documentId $ documentWithId d
52 ------------------------------------------------------------------------
53 flowList_DbRepo :: FlowCmdM env err m
55 -> Map NgramsType [NgramsElement]
57 flowList_DbRepo lId ngs = do
58 -- printDebug "listId flowList" lId
59 mapCgramsId <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
60 let toInsert = catMaybes [ (,) <$> (getCgramsId mapCgramsId ntype <$> parent)
61 <*> getCgramsId mapCgramsId ntype ngram
62 | (ntype, ngs') <- Map.toList ngs
63 , NgramsElement ngram _ _ _ _ parent _ <- ngs'
65 -- Inserting groups of ngrams
66 _r <- insert_Node_NodeNgrams_NodeNgrams
67 $ map (\(a,b) -> Node_NodeNgrams_NodeNgrams lId a b Nothing) toInsert
69 --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
71 ------------------------------------------------------------------------
72 ------------------------------------------------------------------------
74 toNodeNgramsW :: ListId
75 -> [(NgramsType, [NgramsElement])]
77 toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW' l) ngs
79 toNodeNgramsW' :: ListId
80 -> (NgramsType, [NgramsElement])
82 toNodeNgramsW' l' (ngrams_type, elms) =
83 [ NodeNgrams Nothing l' list_type ngrams_terms' ngrams_type Nothing Nothing Nothing 0 |
84 (NgramsElement ngrams_terms' _size list_type _occ _root _parent _children) <- elms
87 listInsert :: FlowCmdM env err m
89 -> Map NgramsType [NgramsElement]
91 listInsert lId ngs = mapM_ (\(typeList, ngElmts)
92 -> putListNgrams lId typeList ngElmts
94 ------------------------------------------------------------------------
95 ------------------------------------------------------------------------