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