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