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
  15 module Gargantext.Database.Flow.Utils
  16     where
  17
  18 import Data.Map (Map)
  19 import qualified Data.Map as DM
  20 import Gargantext.Prelude
  21 import Gargantext.Database.Schema.Ngrams
  22 import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
  23 import Gargantext.Database.Schema.Node  -- (Cmd)
  24 import Gargantext.Database.Schema.NodeNgram
  25
  26 toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
  27 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
  28   where
  29     ns' = map (\(Node nId _ _ _ _ _ json _) -> DocumentWithId nId json) ns
  30
  31 mapNodeIdNgrams :: Hyperdata a => [DocumentIdWithNgrams a] -> Map (NgramsT Ngrams) (Map NodeId Int)
  32 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
  33   where
  34     xs  = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
  35     n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
  36
  37
  38 documentIdWithNgrams :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int)
  39                                      -> [DocumentWithId a] -> [DocumentIdWithNgrams a]
  40 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
  41
  42
  43 data DocumentWithId a =
  44      DocumentWithId { documentId   :: NodeId
  45                     , documentData :: a
  46                     } deriving (Show)
  47
  48
  49 data DocumentIdWithNgrams a =
  50      DocumentIdWithNgrams
  51      { documentWithId  :: DocumentWithId a
  52      , document_ngrams :: Map (NgramsT Ngrams) Int
  53      } deriving (Show)
  54
  55
  56 insertToNodeNgrams :: Map (NgramsT NgramsIndexed) (Map NodeId Int) -> Cmd Int
  57 insertToNodeNgrams m = insertNodeNgrams [ NodeNgram Nothing nId  ((_ngramsId    . _ngramsT   ) ng)
  58                                                 (fromIntegral n) ((ngramsTypeId . _ngramsType) ng)
  59                                           | (ng, nId2int) <- DM.toList m
  60                                           , (nId, n)      <- DM.toList nId2int
  61                                         ]
  62
  63