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 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 153 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 154   where
 155     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 156     cond (n, nn) = nn_node2_id nn .== (view node_id n)
 157
 158
 159 ------------------------------------------------------------------------
 160 -- | Trash management
 161 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
 162 nodeToTrash cId dId b = runPGSQuery trashQuery (b,cId,dId)
 163   where
 164     trashQuery :: PGS.Query
 165     trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
 166                   WHERE node1_id = ? AND node2_id = ?
 167                   RETURNING node2_id
 168                   |]
 169
 170 -- | Trash Massive
 171 nodesToTrash :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
 172 nodesToTrash input = map (\(PGS.Only a) -> a)
 173                         <$> runPGSQuery trashQuery (PGS.Only $ Values fields input)
 174   where
 175     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 176     trashQuery :: PGS.Query
 177     trashQuery = [sql| UPDATE nodes_nodes as old SET
 178                  delete = new.delete
 179                  from (?) as new(node1_id,node2_id,delete)
 180                  WHERE old.node1_id = new.node1_id
 181                  AND   old.node2_id = new.node2_id
 182                  RETURNING new.node2_id
 183                   |]
 184
 185 -- | /!\ Really remove nodes in the Corpus or Annuaire
 186 emptyTrash :: CorpusId -> Cmd err [PGS.Only Int]
 187 emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
 188   where
 189     delQuery :: PGS.Query
 190     delQuery = [sql|DELETE from nodes_nodes n
 191                     WHERE n.node1_id = ?
 192                       AND n.delete = true
 193                     RETURNING n.node2_id
 194                 |]
 195 ------------------------------------------------------------------------