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
  13 module Gargantext.Database.Action.Flow.Utils
  14     where
  15
  16 import Data.Map (Map)
  17 import qualified Data.Map as DM
  18
  19 import Gargantext.Database.Admin.Types.Node
  20 import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
  21 import Gargantext.Database.Prelude (Cmd)
  22 import Gargantext.Database.Query.Table.NodeNodeNgrams
  23 import Gargantext.Database.Schema.Ngrams
  24 import Gargantext.Database.Schema.Node
  25 import Gargantext.Prelude
  26
  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, documentNgrams 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      , documentNgrams :: 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 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