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