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 Int64
  99 insertNodeNode ns = mkCmd $ \conn -> 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 type Node1_Id = NodeId
 112 type Node2_Id = NodeId
 113
 114 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 115 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 116   fromIntegral <$> runDelete conn nodeNodeTable
 117                  (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 118                                              .&& n2_id .== pgNodeId n2 )
 119
 120 ------------------------------------------------------------------------
 121 -- | Favorite management
 122 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 123 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
 124   where
 125     favQuery :: PGS.Query
 126     favQuery = [sql|UPDATE nodes_nodes SET category = ?
 127                WHERE node1_id = ? AND node2_id = ?
 128                RETURNING node2_id;
 129                |]
 130
 131 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
 132 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 133                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
 134   where
 135     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 136     catQuery :: PGS.Query
 137     catQuery = [sql| UPDATE nodes_nodes as nn0
 138                       SET category = nn1.category
 139                        FROM (?) as nn1(node1_id,node2_id,category)
 140                        WHERE nn0.node1_id = nn1.node1_id
 141                        AND   nn0.node2_id = nn1.node2_id
 142                        RETURNING nn1.node2_id
 143                   |]
 144
 145 ------------------------------------------------------------------------
 146 -- | TODO use UTCTime fast
 147 selectDocsDates :: CorpusId -> Cmd err [Text]
 148 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 149                    <$> catMaybes
 150                    <$> map (view hd_publication_date)
 151                    <$> selectDocs cId
 152
 153 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 154 selectDocs cId = runOpaQuery (queryDocs cId)
 155
 156 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 157 queryDocs cId = proc () -> do
 158   (n, nn) <- joinInCorpus -< ()
 159   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 160   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 161   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 162   returnA -< view (node_hyperdata) n
 163
 164 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 165 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 166
 167 queryDocNodes :: CorpusId -> O.Query NodeRead
 168 queryDocNodes cId = proc () -> do
 169   (n, nn) <- joinInCorpus -< ()
 170   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 171   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 172   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 173   returnA -<  n
 174
 175 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 176 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 177   where
 178     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 179     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 180
 181 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 182 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 183   where
 184     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 185     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 186
 187
 188 ------------------------------------------------------------------------
 189 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 190                   => Cmd err [(Node a, Maybe Int)]
 191 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 192
 193 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 194 queryWithType nt = proc () -> do
 195   (n, nn) <- joinOn1 -< ()
 196   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 197   returnA  -<  (n, nn^.nn_node2_id)
 198