src/Gargantext/Database/Flow/Utils.hs

   1 {-|
   2 Module      : Gargantext.Database.Flow.Utils
   3 Description : Database Flow
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE NoImplicitPrelude #-}
  13 {-# LANGUAGE OverloadedStrings #-}
  14 {-# LANGUAGE RankNTypes        #-}
  15
  16 module Gargantext.Database.Flow.Utils
  17     where
  18
  19 import Data.Map (Map)
  20 import qualified Data.Map as DM
  21 import Gargantext.Prelude
  22 import Gargantext.Database.Schema.Ngrams
  23 import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
  24 import Gargantext.Database.Utils (Cmd)
  25 import Gargantext.Database.Schema.NodeNgram
  26
  27 toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
  28 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
  29   where
  30     ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
  31
  32 mapNodeIdNgrams :: Hyperdata a => [DocumentIdWithNgrams a] -> Map (NgramsT Ngrams) (Map NodeId Int)
  33 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
  34   where
  35     xs  = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
  36     n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
  37
  38
  39 documentIdWithNgrams :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int)
  40                                      -> [DocumentWithId a] -> [DocumentIdWithNgrams a]
  41 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
  42
  43
  44 data DocumentWithId a =
  45      DocumentWithId { documentId   :: NodeId
  46                     , documentData :: a
  47                     } deriving (Show)
  48
  49
  50 data DocumentIdWithNgrams a =
  51      DocumentIdWithNgrams
  52      { documentWithId  :: DocumentWithId a
  53      , document_ngrams :: Map (NgramsT Ngrams) Int
  54      } deriving (Show)
  55
  56
  57 insertToNodeNgrams :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd err Int
  58 insertToNodeNgrams m = insertNodeNgrams [ NodeNgram Nothing nId  ((_ngramsId    . _ngramsT   ) ng)
  59                                                 (fromIntegral n) ((ngramsTypeId . _ngramsType) ng)
  60                                         | (ng, nId2int) <- DM.toList m
  61                                         , (nId, n)      <- DM.toList nId2int
  62                                         ]
  63
  64