src/Gargantext/Database/Query/Table/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.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 FunctionalDependencies #-}
  18 {-# LANGUAGE QuasiQuotes            #-}
  19 {-# LANGUAGE TemplateHaskell        #-}
  20
  21 module Gargantext.Database.Query.Table.NodeNode
  22   ( module Gargantext.Database.Schema.NodeNode
  23   , queryNodeNodeTable
  24   , selectDocsDates
  25   , selectDocNodes
  26   , selectDocs
  27   , nodeNodesCategory
  28   , getNodeNode
  29   , insertNodeNode
  30   , deleteNodeNode
  31   , selectPublicNodes
  32   )
  33   where
  34
  35 import Control.Arrow (returnA)
  36 import Control.Lens (view, (^.))
  37 import Data.Maybe (catMaybes)
  38 import Data.Text (Text, splitOn)
  39 import Database.PostgreSQL.Simple.SqlQQ (sql)
  40 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  41 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  42 import qualified Opaleye as O
  43 import Opaleye
  44
  45 import Gargantext.Core.Types
  46 import Gargantext.Database.Schema.NodeNode
  47 import Gargantext.Database.Admin.Config (nodeTypeId)
  48 import Gargantext.Database.Admin.Types.Hyperdata
  49 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId, pgNodeId)
  50 import Gargantext.Database.Prelude
  51 import Gargantext.Database.Schema.Node
  52 import Gargantext.Prelude
  53
  54
  55 queryNodeNodeTable :: Query NodeNodeRead
  56 queryNodeNodeTable = queryTable nodeNodeTable
  57
  58 -- | not optimized (get all ngrams without filters)
  59 _nodesNodes :: Cmd err [NodeNode]
  60 _nodesNodes = runOpaQuery queryNodeNodeTable
  61
  62 ------------------------------------------------------------------------
  63 -- | Basic NodeNode tools
  64 getNodeNode :: NodeId -> Cmd err [NodeNode]
  65 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  66   where
  67     selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
  68     selectNodeNode n' = proc () -> do
  69       ns <- queryNodeNodeTable -< ()
  70       restrict -< _nn_node1_id ns .== n'
  71       returnA -< ns
  72
  73 ------------------------------------------------------------------------
  74 -- TODO (refactor with Children)
  75 {-
  76 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  77 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  78   where
  79     query = selectChildren pId maybeNodeType
  80
  81     selectChildren :: ParentId
  82                    -> Maybe NodeType
  83                    -> Query NodeRead
  84     selectChildren parentId maybeNodeType = proc () -> do
  85         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  86         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  87
  88         let nodeType = maybe 0 nodeTypeId maybeNodeType
  89         restrict -< typeName  .== pgInt4 nodeType
  90
  91         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  92                           ( (.&&) (n1id .== pgNodeId parentId)
  93                                   (n2id .== nId))
  94         returnA -< row
  95 -}
  96
  97 ------------------------------------------------------------------------
  98 insertNodeNode :: [NodeNode] -> Cmd err Int
  99 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 100                           $ Insert nodeNodeTable ns' rCount Nothing)
 101   where
 102     ns' :: [NodeNodeWrite]
 103     ns' = map (\(NodeNode n1 n2 x y)
 104                 -> NodeNode (pgNodeId n1)
 105                             (pgNodeId n2)
 106                             (pgDouble <$> x)
 107                             (pgInt4   <$> y)
 108               ) ns
 109
 110
 111
 112 ------------------------------------------------------------------------
 113 type Node1_Id = NodeId
 114 type Node2_Id = NodeId
 115
 116 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 117 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 118   fromIntegral <$> runDelete conn nodeNodeTable
 119                  (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 120                                              .&& n2_id .== pgNodeId n2 )
 121
 122 ------------------------------------------------------------------------
 123 -- | Favorite management
 124 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 125 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
 126   where
 127     favQuery :: PGS.Query
 128     favQuery = [sql|UPDATE nodes_nodes SET category = ?
 129                WHERE node1_id = ? AND node2_id = ?
 130                RETURNING node2_id;
 131                |]
 132
 133 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
 134 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 135                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
 136   where
 137     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 138     catQuery :: PGS.Query
 139     catQuery = [sql| UPDATE nodes_nodes as nn0
 140                       SET category = nn1.category
 141                        FROM (?) as nn1(node1_id,node2_id,category)
 142                        WHERE nn0.node1_id = nn1.node1_id
 143                        AND   nn0.node2_id = nn1.node2_id
 144                        RETURNING nn1.node2_id
 145                   |]
 146
 147 ------------------------------------------------------------------------
 148 -- | TODO use UTCTime fast
 149 selectDocsDates :: CorpusId -> Cmd err [Text]
 150 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 151                    <$> catMaybes
 152                    <$> map (view hd_publication_date)
 153                    <$> selectDocs cId
 154
 155 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 156 selectDocs cId = runOpaQuery (queryDocs cId)
 157
 158 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 159 queryDocs cId = proc () -> do
 160   (n, nn) <- joinInCorpus -< ()
 161   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 162   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 163   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 164   returnA -< view (node_hyperdata) n
 165
 166 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 167 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 168
 169 queryDocNodes :: CorpusId -> O.Query NodeRead
 170 queryDocNodes cId = proc () -> do
 171   (n, nn) <- joinInCorpus -< ()
 172   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 173   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 174   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 175   returnA -<  n
 176
 177 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 178 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 179   where
 180     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 181     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 182
 183 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 184 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 185   where
 186     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 187     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 188
 189
 190 ------------------------------------------------------------------------
 191 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 192                   => Cmd err [(Node a, Maybe Int)]
 193 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 194
 195 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 196 queryWithType nt = proc () -> do
 197   (n, nn) <- joinOn1 -< ()
 198   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 199   returnA  -<  (n, nn^.nn_node2_id)
 200