src/Gargantext/Database/Schema/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodeNode
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE Arrows                 #-}
  17 {-# LANGUAGE FlexibleInstances      #-}
  18 {-# LANGUAGE FunctionalDependencies #-}
  19 {-# LANGUAGE QuasiQuotes            #-}
  20 {-# LANGUAGE MultiParamTypeClasses  #-}
  21 {-# LANGUAGE NoImplicitPrelude      #-}
  22 {-# LANGUAGE OverloadedStrings      #-}
  23 {-# LANGUAGE RankNTypes             #-}
  24 {-# LANGUAGE TemplateHaskell        #-}
  25
  26 module Gargantext.Database.Schema.NodeNode where
  27
  28 import Control.Lens (view)
  29 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  30 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  31 import Database.PostgreSQL.Simple.SqlQQ (sql)
  32 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  33 import Data.Maybe (Maybe, catMaybes)
  34 import Data.Text (Text, splitOn)
  35 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  36 import Gargantext.Database.Schema.Node
  37 import Gargantext.Core.Types
  38 import Gargantext.Database.Utils
  39 import Gargantext.Database.Config (nodeTypeId)
  40 import Gargantext.Database.Types.Node (CorpusId, DocId)
  41 import Gargantext.Prelude
  42 import Opaleye
  43 import Control.Arrow (returnA)
  44 import qualified Opaleye as O
  45
  46 data NodeNodePoly node1_id node2_id score fav del
  47                    = NodeNode { nn_node1_id   :: node1_id
  48                               , nn_node2_id   :: node2_id
  49                               , nn_score :: score
  50                               , nn_favorite :: fav
  51                               , nn_delete   :: del
  52                               } deriving (Show)
  53
  54 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
  55                                       (Column (PGInt4))
  56                                       (Maybe  (Column (PGFloat8)))
  57                                       (Maybe  (Column (PGBool)))
  58                                       (Maybe  (Column (PGBool)))
  59
  60 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
  61                                       (Column (PGInt4))
  62                                       (Column (PGFloat8))
  63                                       (Column (PGBool))
  64                                       (Column (PGBool))
  65
  66 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
  67                                       (Column (Nullable PGInt4))
  68                                       (Column (Nullable PGFloat8))
  69                                       (Column (Nullable PGBool))
  70                                       (Column (Nullable PGBool))
  71
  72 type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Bool) (Maybe Bool)
  73
  74 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  75 $(makeLensesWith abbreviatedFields   ''NodeNodePoly)
  76
  77 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  78 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
  79                                 NodeNode { nn_node1_id = required "node1_id"
  80                                          , nn_node2_id = required "node2_id"
  81                                          , nn_score    = optional "score"
  82                                          , nn_favorite = optional "favorite"
  83                                          , nn_delete   = optional "delete"
  84                                      }
  85                                      )
  86
  87 queryNodeNodeTable :: Query NodeNodeRead
  88 queryNodeNodeTable = queryTable nodeNodeTable
  89
  90
  91 -- | not optimized (get all ngrams without filters)
  92 nodesNodes :: Cmd err [NodeNode]
  93 nodesNodes = runOpaQuery queryNodeNodeTable
  94
  95 instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
  96     queryRunnerColumnDefault = fieldQueryRunnerColumn
  97
  98 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
  99     queryRunnerColumnDefault = fieldQueryRunnerColumn
 100
 101 instance QueryRunnerColumnDefault PGBool (Maybe Bool) where
 102     queryRunnerColumnDefault = fieldQueryRunnerColumn
 103
 104
 105 ------------------------------------------------------------------------
 106 -- | Favorite management
 107 nodeToFavorite :: CorpusId -> DocId -> Bool -> Cmd err [Int]
 108 nodeToFavorite cId dId b = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (b,cId,dId)
 109   where
 110     favQuery :: PGS.Query
 111     favQuery = [sql|UPDATE nodes_nodes SET favorite = ?
 112                WHERE node1_id = ? AND node2_id = ?
 113                RETURNING node2_id;
 114                |]
 115
 116 nodesToFavorite :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
 117 nodesToFavorite inputData = map (\(PGS.Only a) -> a)
 118                             <$> runPGSQuery trashQuery (PGS.Only $ Values fields inputData)
 119   where
 120     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 121     trashQuery :: PGS.Query
 122     trashQuery = [sql| UPDATE nodes_nodes as old SET
 123                  favorite = new.favorite
 124                  from (?) as new(node1_id,node2_id,favorite)
 125                  WHERE old.node1_id = new.node1_id
 126                  AND   old.node2_id = new.node2_id
 127                  RETURNING new.node2_id
 128                   |]
 129
 130 ------------------------------------------------------------------------
 131 -- | TODO use UTCTime fast
 132 selectDocsDates :: CorpusId -> Cmd err [Text]
 133 selectDocsDates cId =
 134                 map (head' "selectDocsDates" . splitOn "-")
 135                <$> catMaybes
 136                <$> map (view hyperdataDocument_publication_date)
 137                <$> selectDocs cId
 138
 139
 140 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 141 selectDocs cId = runOpaQuery (queryDocs cId)
 142
 143 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 144 queryDocs cId = proc () -> do
 145   (n, nn) <- joinInCorpus -< ()
 146   restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
 147   restrict -< ( nn_delete nn)    .== (toNullable $ pgBool False)
 148   restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
 149   returnA -< view (node_hyperdata) n
 150
 151
 152 selectDocNodes :: CorpusId -> Cmd err [NodeDocument]
 153 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 154
 155 queryDocNodes :: CorpusId -> O.Query NodeRead
 156 queryDocNodes cId = proc () -> do
 157   (n, nn) <- joinInCorpus -< ()
 158   restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
 159   restrict -< ( nn_delete nn)    .== (toNullable $ pgBool False)
 160   restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
 161   returnA -<  n
 162
 163
 164
 165 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 166 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 167   where
 168     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 169     cond (n, nn) = nn_node2_id nn .== (view node_id n)
 170
 171
 172 ------------------------------------------------------------------------
 173 -- | Trash management
 174 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
 175 nodeToTrash cId dId b = runPGSQuery trashQuery (b,cId,dId)
 176   where
 177     trashQuery :: PGS.Query
 178     trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
 179                   WHERE node1_id = ? AND node2_id = ?
 180                   RETURNING node2_id
 181                   |]
 182
 183 -- | Trash Massive
 184 nodesToTrash :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
 185 nodesToTrash input = map (\(PGS.Only a) -> a)
 186                         <$> runPGSQuery trashQuery (PGS.Only $ Values fields input)
 187   where
 188     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 189     trashQuery :: PGS.Query
 190     trashQuery = [sql| UPDATE nodes_nodes as old SET
 191                  delete = new.delete
 192                  from (?) as new(node1_id,node2_id,delete)
 193                  WHERE old.node1_id = new.node1_id
 194                  AND   old.node2_id = new.node2_id
 195                  RETURNING new.node2_id
 196                   |]
 197
 198 -- | /!\ Really remove nodes in the Corpus or Annuaire
 199 emptyTrash :: CorpusId -> Cmd err [PGS.Only Int]
 200 emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
 201   where
 202     delQuery :: PGS.Query
 203     delQuery = [sql|DELETE from nodes_nodes n
 204                     WHERE n.node1_id = ?
 205                       AND n.delete = true
 206                     RETURNING n.node2_id
 207                 |]
 208 ------------------------------------------------------------------------