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   , selectCountDocs
  33   )
  34   where
  35
  36 import Control.Arrow (returnA)
  37 import Control.Lens (view, (^.))
  38 import Data.Maybe (catMaybes)
  39 import Data.Text (Text, splitOn)
  40 import Database.PostgreSQL.Simple.SqlQQ (sql)
  41 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  42 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  43 import qualified Opaleye as O
  44 import Opaleye
  45
  46 import Gargantext.Core.Types
  47 import Gargantext.Database.Schema.NodeNode
  48 import Gargantext.Database.Admin.Config (nodeTypeId)
  49 import Gargantext.Database.Admin.Types.Hyperdata
  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 (Just DoNothing))
 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 selectCountDocs :: CorpusId -> Cmd err Int
 149 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 150   where
 151     queryCountDocs cId' = proc () -> do
 152       (n, nn) <- joinInCorpus -< ()
 153       restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId')
 154       restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 155       restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 156       returnA -< n
 157
 158
 159
 160
 161 -- | TODO use UTCTime fast
 162 selectDocsDates :: CorpusId -> Cmd err [Text]
 163 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 164                    <$> catMaybes
 165                    <$> map (view hd_publication_date)
 166                    <$> selectDocs cId
 167
 168 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 169 selectDocs cId = runOpaQuery (queryDocs cId)
 170
 171 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 172 queryDocs cId = proc () -> do
 173   (n, nn) <- joinInCorpus -< ()
 174   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 175   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 176   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 177   returnA -< view (node_hyperdata) n
 178
 179 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 180 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 181
 182 queryDocNodes :: CorpusId -> O.Query NodeRead
 183 queryDocNodes cId = proc () -> do
 184   (n, nn) <- joinInCorpus -< ()
 185   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 186   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 187   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 188   returnA -<  n
 189
 190 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 191 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 192   where
 193     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 194     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 195
 196 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 197 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 198   where
 199     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 200     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 201
 202
 203 ------------------------------------------------------------------------
 204 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 205                   => Cmd err [(Node a, Maybe Int)]
 206 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 207
 208 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 209 queryWithType nt = proc () -> do
 210   (n, nn) <- joinOn1 -< ()
 211   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 212   returnA  -<  (n, nn^.nn_node2_id)
 213