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