src/Gargantext/Database/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.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 TemplateHaskell        #-}
  24
  25 module Gargantext.Database.NodeNode where
  26
  27 import qualified Database.PostgreSQL.Simple as PGS (Connection, Query, query, Only(..))
  28 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  29 import Database.PostgreSQL.Simple.SqlQQ (sql)
  30 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  31 import Data.Maybe (Maybe)
  32 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  33 import Gargantext.Database.Node (Cmd(..), mkCmd, CorpusId, DocId)
  34 import Gargantext.Prelude
  35 import Opaleye
  36
  37
  38 data NodeNodePoly node1_id node2_id score fav del
  39                    = NodeNode { nodeNode_node1_id   :: node1_id
  40                               , nodeNode_node2_id   :: node2_id
  41                               , nodeNode_score :: score
  42                               , nodeNode_favorite :: fav
  43                               , nodeNode_delete   :: del
  44                               } deriving (Show)
  45
  46 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
  47                                       (Column (PGInt4))
  48                                       (Maybe  (Column (PGFloat8)))
  49                                       (Maybe  (Column (PGBool)))
  50                                       (Maybe  (Column (PGBool)))
  51
  52 type NodeNodeRead      = NodeNodePoly (Column (PGInt4))
  53                                       (Column (PGInt4))
  54                                       (Column (PGFloat8))
  55                                       (Column (PGBool))
  56                                       (Column (PGBool))
  57
  58 type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
  59                                       (Column (Nullable PGInt4))
  60                                       (Column (Nullable PGFloat8))
  61                                       (Column (Nullable PGBool))
  62                                       (Column (Nullable PGBool))
  63
  64 type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Bool) (Maybe Bool)
  65
  66 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
  67 $(makeLensesWith abbreviatedFields   ''NodeNodePoly)
  68
  69 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
  70 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
  71                                 NodeNode { nodeNode_node1_id = required "node1_id"
  72                                          , nodeNode_node2_id = required "node2_id"
  73                                          , nodeNode_score    = optional "score"
  74                                          , nodeNode_favorite = optional "favorite"
  75                                          , nodeNode_delete   = optional "delete"
  76                                      }
  77                                      )
  78
  79 queryNodeNodeTable :: Query NodeNodeRead
  80 queryNodeNodeTable = queryTable nodeNodeTable
  81
  82
  83 -- | not optimized (get all ngrams without filters)
  84 nodesNodes :: Cmd [NodeNode]
  85 nodesNodes = mkCmd $ \c -> runQuery c queryNodeNodeTable
  86
  87 instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
  88     queryRunnerColumnDefault = fieldQueryRunnerColumn
  89
  90 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
  91     queryRunnerColumnDefault = fieldQueryRunnerColumn
  92
  93 instance QueryRunnerColumnDefault PGBool (Maybe Bool) where
  94     queryRunnerColumnDefault = fieldQueryRunnerColumn
  95
  96
  97 ------------------------------------------------------------------------
  98 -- | Favorite management
  99 nodeToFavorite :: PGS.Connection -> CorpusId -> DocId -> Bool -> IO [Int]
 100 nodeToFavorite c cId dId b = map (\(PGS.Only a) -> a) <$> PGS.query c favQuery (b,cId,dId)
 101   where
 102     favQuery :: PGS.Query
 103     favQuery = [sql|UPDATE nodes_nodes SET favorite = ?
 104                WHERE node1_id = ? AND node2_id = ?
 105                RETURNING node2_id;
 106                |]
 107
 108 nodesToFavorite :: PGS.Connection -> [(CorpusId,DocId,Bool)] -> IO [Int]
 109 nodesToFavorite c inputData = map (\(PGS.Only a) -> a)
 110                             <$> PGS.query c trashQuery (PGS.Only $ Values fields inputData)
 111   where
 112     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 113     trashQuery :: PGS.Query
 114     trashQuery = [sql| UPDATE nodes_nodes as old SET
 115                  favorite = new.favorite
 116                  from (?) as new(node1_id,node2_id,favorite)
 117                  WHERE old.node1_id = new.node1_id
 118                  AND   old.node2_id = new.node2_id
 119                  RETURNING new.node2_id
 120                   |]
 121
 122 ------------------------------------------------------------------------
 123 ------------------------------------------------------------------------
 124 -- | Trash management
 125 nodeToTrash :: PGS.Connection -> CorpusId -> DocId -> Bool -> IO [PGS.Only Int]
 126 nodeToTrash c cId dId b = PGS.query c trashQuery (b,cId,dId)
 127   where
 128     trashQuery :: PGS.Query
 129     trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
 130                   WHERE node1_id = ? AND node2_id = ?
 131                   RETURNING node2_id
 132                   |]
 133
 134 -- | Trash Massive
 135 nodesToTrash :: PGS.Connection -> [(CorpusId,DocId,Bool)] -> IO [Int]
 136 nodesToTrash c input = map (\(PGS.Only a) -> a)
 137                         <$> PGS.query c trashQuery (PGS.Only $ Values fields input)
 138   where
 139     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 140     trashQuery :: PGS.Query
 141     trashQuery = [sql| UPDATE nodes_nodes as old SET
 142                  delete = new.delete
 143                  from (?) as new(node1_id,node2_id,delete)
 144                  WHERE old.node1_id = new.node1_id
 145                  AND   old.node2_id = new.node2_id
 146                  RETURNING new.node2_id
 147                   |]
 148
 149 -- | /!\ Really remove nodes in the Corpus or Annuaire
 150 emptyTrash :: PGS.Connection -> CorpusId -> IO [PGS.Only Int]
 151 emptyTrash c cId = PGS.query c delQuery (PGS.Only cId)
 152   where
 153     delQuery :: PGS.Query
 154     delQuery = [sql|DELETE from nodes_nodes n
 155                     WHERE n.node1_id = ?
 156                       AND n.delete = true
 157                     RETURNING n.node2_id
 158                 |]
 159 ------------------------------------------------------------------------
 160
 161