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