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