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.Core.Types.Individu (User(..))
  22 import Gargantext.Database.Query.Table.Node
  23 import Gargantext.Database.Query.Table.User
  24 import Gargantext.Database.Admin.Types.Errors
  25 import Gargantext.Database.Admin.Types.Node
  26 import Gargantext.Database.Admin.Utils (Cmd)
  27 import Gargantext.Database.Schema.Ngrams
  28 import Gargantext.Database.Schema.Node
  29 import Gargantext.Database.Schema.NodeNodeNgrams
  30 import Gargantext.Prelude
  31 import qualified Data.Map as DM
  32
  33 getUserId :: HasNodeError err
  34           => User
  35           -> Cmd err UserId
  36 getUserId (UserDBId uid) = pure uid
  37 getUserId (RootId   rid) = do
  38   n <- getNode rid
  39   pure $ _node_userId n
  40 getUserId (UserName u  ) = do
  41   muser <- getUser u
  42   case muser of
  43     Just user -> pure $ userLight_id user
  44     Nothing   -> nodeError NoUserFound
  45
  46
  47 toMaps :: Hyperdata a
  48        => (a -> Map (NgramsT Ngrams) Int)
  49        -> [Node a]
  50        -> Map (NgramsT Ngrams) (Map NodeId Int)
  51 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
  52   where
  53     ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
  54
  55 mapNodeIdNgrams :: Hyperdata a
  56                 => [DocumentIdWithNgrams a]
  57                 -> Map (NgramsT Ngrams) (Map NodeId Int)
  58 mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
  59   where
  60     xs  = [(ng, [(nId, i)]) | (nId, n2i') <- n2i ds, (ng, i) <- DM.toList n2i']
  61     n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
  62
  63
  64 documentIdWithNgrams :: Hyperdata a
  65                      => (a -> Map (NgramsT Ngrams) Int)
  66                      -> [DocumentWithId a]
  67                      -> [DocumentIdWithNgrams a]
  68 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
  69
  70
  71 data DocumentWithId a =
  72      DocumentWithId { documentId   :: NodeId
  73                     , documentData :: a
  74                     } deriving (Show)
  75
  76
  77 data DocumentIdWithNgrams a =
  78      DocumentIdWithNgrams
  79      { documentWithId  :: DocumentWithId a
  80      , document_ngrams :: Map (NgramsT Ngrams) Int
  81      } deriving (Show)
  82
  83
  84 docNgrams2nodeNodeNgrams :: CorpusId
  85                          -> DocNgrams
  86                          -> NodeNodeNgrams
  87 docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
  88   NodeNodeNgrams cId d n nt w
  89
  90 data DocNgrams = DocNgrams { dn_doc_id :: DocId
  91                            , dn_ngrams_id :: Int
  92                            , dn_ngrams_type :: NgramsTypeId
  93                            , dn_weight  :: Double
  94                            }
  95
  96 insertDocNgramsOn :: CorpusId
  97                   -> [DocNgrams]
  98                   -> Cmd err Int
  99 insertDocNgramsOn cId dn =
 100   insertNodeNodeNgrams
 101   $ (map (docNgrams2nodeNodeNgrams cId) dn)
 102
 103 insertDocNgrams :: CorpusId
 104                 -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
 105                 -> Cmd err Int
 106 insertDocNgrams cId m =
 107   insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
 108                           | (ng, t2n2i) <- DM.toList m
 109                           , (t,  n2i)   <- DM.toList t2n2i
 110                           , (n,  i)     <- DM.toList n2i
 111                         ]
 112