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.NodeNodeNgrams
  26 import Gargantext.Database.Types.Node
  27
  28 toMaps :: Hyperdata a
  29        => (a -> Map (NgramsT Ngrams) Int)
  30        -> [Node a]
  31        -> Map (NgramsT Ngrams) (Map NodeId Int)
  32 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
  33   where
  34     ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
  35
  36 mapNodeIdNgrams :: Hyperdata a
  37                 => [DocumentIdWithNgrams a]
  38                 -> Map (NgramsT Ngrams) (Map NodeId Int)
  39 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
  40   where
  41     xs  = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
  42     n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
  43
  44
  45 documentIdWithNgrams :: Hyperdata a
  46                      => (a -> Map (NgramsT Ngrams) Int)
  47                      -> [DocumentWithId a]
  48                      -> [DocumentIdWithNgrams a]
  49 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
  50
  51
  52 data DocumentWithId a =
  53      DocumentWithId { documentId   :: NodeId
  54                     , documentData :: a
  55                     } deriving (Show)
  56
  57
  58 data DocumentIdWithNgrams a =
  59      DocumentIdWithNgrams
  60      { documentWithId  :: DocumentWithId a
  61      , document_ngrams :: Map (NgramsT Ngrams) Int
  62      } deriving (Show)
  63
  64
  65 docNgrams2nodeNodeNgrams :: CorpusId
  66                          -> DocNgrams
  67                          -> NodeNodeNgrams
  68 docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
  69   NodeNodeNgrams Nothing cId d n nt w
  70
  71 data DocNgrams = DocNgrams { dn_doc_id :: DocId
  72                            , dn_ngrams_id :: Int
  73                            , dn_ngrams_type :: NgramsTypeId
  74                            , dn_weight  :: Double
  75                            }
  76
  77 insertDocNgramsOn :: CorpusId
  78                   -> [DocNgrams]
  79                   -> Cmd err Int
  80 insertDocNgramsOn cId dn =
  81   insertNodeNodeNgrams
  82   $ (map (docNgrams2nodeNodeNgrams cId) dn)
  83
  84 insertDocNgrams :: CorpusId
  85                 -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
  86                 -> Cmd err Int
  87 insertDocNgrams cId m =
  88   insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
  89                           | (ng, t2n2i) <- DM.toList m
  90                           , (t,  n2i)   <- DM.toList t2n2i
  91                           , (n,  i)     <- DM.toList n2i
  92                         ]
  93