src/Gargantext/Database/Metrics/Count.hs

   1 {-|
   2 Module      : Gargantext.Database.Metrics.Count
   3 Description : Ngram connection to the Database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Count Ngrams by Context
  11
  12 -}
  13
  14 {-# LANGUAGE QuasiQuotes       #-}
  15 {-# LANGUAGE Arrows            #-}
  16 {-# LANGUAGE NoImplicitPrelude #-}
  17 {-# LANGUAGE OverloadedStrings #-}
  18 {-# LANGUAGE QuasiQuotes       #-}
  19 {-# LANGUAGE RankNTypes        #-}
  20
  21 module Gargantext.Database.Metrics.Count where
  22
  23 {-
  24
  25 import Control.Arrow (returnA)
  26 import Control.Lens (view)
  27 import Data.Map.Strict (Map, fromListWith, elems)
  28 import Data.Monoid (mempty)
  29 import Data.Text (Text)
  30 import Database.PostgreSQL.Simple.SqlQQ (sql)
  31 import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement)
  32 import Gargantext.Core.Types.Main (listTypeId, ListType(..))
  33 import Gargantext.Database.Access
  34 import Gargantext.Database.Config (nodeTypeId)
  35 import Gargantext.Database.Queries.Join (leftJoin4, leftJoin3)
  36 import Gargantext.Database.Schema.Ngrams
  37 import Gargantext.Database.Schema.Ngrams (NgramsId, NgramsType(..), ngramsTypeId, Ngrams(..), NgramsIndexed(..), ngrams, ngramsTerms, fromNgramsTypeId)
  38 import Gargantext.Database.Schema.Node
  39 import Gargantext.Database.Schema.Node (HasNodeError(..))
  40 import Gargantext.Database.Schema.NodeNgram
  41 import Gargantext.Database.Schema.NodeNode
  42 --import Gargantext.Database.Schema.NodeNodeNgrams
  43 import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
  44 import Gargantext.Database.Utils
  45 import Gargantext.Database.Utils (Cmd, runPGSQuery)
  46 import Gargantext.Prelude hiding (sum)
  47 import Gargantext.Text.Metrics.Count (Coocs, coocOn)
  48 import Opaleye
  49 import Safe (headMay)
  50 import qualified Database.PostgreSQL.Simple as PGS
  51
  52
  53
  54 getNgramsByNode :: NodeId -> NgramsType -> Cmd err [[Text]]
  55 getNgramsByNode nId nt =  elems
  56                    <$> fromListWith (<>)
  57                    <$> map (\(i,t) -> (i,[t]))
  58                    <$> getNgramsByNodeNodeIndexed nId nt
  59
  60 -- | TODO add join with nodeNodeNgram (if it exists)
  61 getNgramsByNodeNodeIndexed :: NodeId -> NgramsType -> Cmd err [(NodeId, Text)]
  62 getNgramsByNodeNodeIndexed nId nt = runOpaQuery (select' nId nt)
  63   where
  64     select' nId' nt' = proc () -> do
  65       (ng,(nng,(nn,n))) <- getNgramsByNodeNodeIndexedJoin -< ()
  66       restrict          -< _node_id n         .== toNullable (pgNodeId nId')
  67       restrict          -< nng_ngramsType nng .== toNullable (pgNgramsTypeId $ ngramsTypeId nt')
  68       restrict          -< nn_delete      nn  ./= (toNullable . pgBool) True
  69       returnA           -< (nng_node_id nng, ngrams_terms ng)
  70
  71
  72 getNgramsByNodeNodeIndexedJoin :: Query ( NgramsRead
  73                                     , (NodeNgramReadNull
  74                                       , (NodeNodeReadNull
  75                                         , NodeReadNull
  76                                         )
  77                                       )
  78                                     )
  79 getNgramsByNodeNodeIndexedJoin = leftJoin4 queryNodeTable
  80                                        queryNodeNodeTable
  81                                        queryNodeNgramTable
  82                                        queryNgramsTable
  83                                        c1 c2 c3
  84   where
  85     c1 :: (NodeNodeRead, NodeRead) -> Column PGBool
  86     c1 (nn,n)       = nn_node1_id nn .== _node_id n
  87
  88     c2 :: ( NodeNgramRead
  89           , (NodeNodeRead
  90             , NodeReadNull
  91             )
  92           ) -> Column PGBool
  93     c2 (nng,(nn',_)) = (nng_node_id nng)   .== nn_node2_id nn'
  94
  95     c3 :: ( NgramsRead
  96           , ( NodeNgramRead
  97             , ( NodeNodeReadNull
  98               , NodeReadNull
  99               )
 100             )
 101           ) -> Column PGBool
 102     c3 (ng,(nng',(_,_))) = (ngrams_id ng)   .== nng_ngrams_id nng'
 103
 104 {-
 105 getNgramsByNodeNodeIndexedJoin5 :: Query ( NodeNodesNgramsRead
 106                                     , (NgramsReadNull
 107                                       , (NodeNgramReadNull
 108                                         , (NodeNodeReadNull
 109                                           , NodeReadNull
 110                                           )
 111                                         )
 112                                       )
 113                                     )
 114 getNgramsByNodeNodeIndexedJoin5 = leftJoin5 queryNodeTable
 115                                        queryNodeNodeTable
 116                                        queryNodeNgramTable
 117                                        queryNgramsTable
 118                                        queryNodeNodeNgramsTable
 119                                        c1 c2 c3 c4
 120   where
 121     c1 :: (NodeNodeRead, NodeRead) -> Column PGBool
 122     c1 (nn,n)       = nn_node1_id nn .== _node_id n
 123
 124     c2 :: ( NodeNgramRead
 125           , (NodeNodeRead
 126             , NodeReadNull
 127             )
 128           ) -> Column PGBool
 129     c2 (nng,(nn',_)) = (nng_node_id nng)   .== nn_node2_id nn'
 130
 131     c3 :: ( NgramsRead
 132           , ( NodeNgramRead
 133             , ( NodeNodeReadNull
 134               , NodeReadNull
 135               )
 136             )
 137           ) -> Column PGBool
 138     c3 (ng,(nng',(_,_))) = (ngrams_id ng)   .== nng_ngrams_id nng'
 139
 140     c4 :: ( NodeNodeNgramsRead
 141             , (NgramsRead
 142               , ( NodeNgramReadNull
 143                 , ( NodeNodeReadNull
 144                   , NodeReadNull
 145                   )
 146                 )
 147               )
 148             ) -> Column PGBool
 149     c4 (nnng,(_,(_,(nn,_)))) =  (toNullable $ nnng_node1_id nnng) .== (nn_node1_id nn)
 150                             .&& (toNullable $ nnng_node2_id nnng) .== (nn_node2_id nn)
 151
 152 --}
 153
 154 --{-
 155
 156 getNgramsElementsWithParentNodeId :: NodeId -> Cmd err (Map NgramsType [NgramsElement])
 157 getNgramsElementsWithParentNodeId nId = do
 158   ns <- getNgramsWithParentNodeId nId
 159   pure $ fromListWith (<>)
 160                 [ (maybe (panic "error") identity $ fromNgramsTypeId nt,
 161                    [mkNgramsElement ng CandidateTerm Nothing mempty])
 162                 | (_,(nt,ng)) <- ns
 163                 ]
 164
 165
 166 -------------------------------------------------------------------------
 167 getNgramsWithParentNodeId :: NodeId -> Cmd err [(NodeId, (NgramsTypeId, Text))]
 168 getNgramsWithParentNodeId nId = runOpaQuery (select nId)
 169   where
 170     select nId' = proc () -> do
 171       (ng,(nng,n)) <- getNgramsWithParentNodeIdJoin -< ()
 172       restrict -< _node_parentId n .== (toNullable $ pgNodeId nId')
 173       restrict -< _node_typename n .== (toNullable $ pgInt4 $ nodeTypeId NodeDocument)
 174       returnA  -< (nng_node_id nng, (nng_ngramsType nng, ngrams_terms ng))
 175 --}
 176
 177 getNgramsWithParentNodeIdJoin :: Query ( NgramsRead
 178                                        , ( NodeNgramReadNull
 179                                          , NodeReadNull
 180                                          )
 181                                        )
 182 getNgramsWithParentNodeIdJoin = leftJoin3 queryNodeTable queryNodeNgramTable queryNgramsTable on1 on2
 183   where
 184     on1 :: (NodeNgramRead, NodeRead) -> Column PGBool
 185     on1 (nng,n) = nng_node_id nng .== _node_id n
 186
 187     on2 :: (NgramsRead, (NodeNgramRead, NodeReadNull))-> Column PGBool
 188     on2 (ng, (nng,_)) = ngrams_id ng .== nng_ngrams_id nng
 189
 190
 191 countCorpusDocuments :: Roles -> Int -> Cmd err Int
 192 countCorpusDocuments r cId = maybe 0 identity
 193                         <$> headMay
 194                         <$> map (\(PGS.Only n) -> n)
 195                         <$> runQuery' r cId
 196   where
 197     runQuery' RoleUser cId' = runPGSQuery
 198                         "SELECT count(*) from nodes_nodes nn WHERE nn.node1_id = ? AND nn.delete = False"
 199                         (PGS.Only cId')
 200     runQuery' RoleMaster cId' = runPGSQuery
 201                         "SELECT count(*) from nodes n WHERE n.parent_id = ? AND n.typename = ?"
 202                         (cId', nodeTypeId NodeDocument)
 203
 204
 205 -}