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