module Gargantext.Database.Schema.NodeNode where
+import Control.Lens (view, (^.))
import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Data.Maybe (Maybe)
+import Control.Lens.TH (makeLenses)
+import Data.Maybe (Maybe, catMaybes)
+import Data.Text (Text, splitOn)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Gargantext.Database.Schema.Node
+import Gargantext.Core.Types
import Gargantext.Database.Utils
+import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Types.Node (CorpusId, DocId)
import Gargantext.Prelude
import Opaleye
-
-
-data NodeNodePoly node1_id node2_id score fav del
- = NodeNode { nodeNode_node1_id :: node1_id
- , nodeNode_node2_id :: node2_id
- , nodeNode_score :: score
- , nodeNode_favorite :: fav
- , nodeNode_delete :: del
+import Control.Arrow (returnA)
+import qualified Opaleye as O
+
+data NodeNodePoly node1_id node2_id score cat
+ = NodeNode { _nn_node1_id :: node1_id
+ , _nn_node2_id :: node2_id
+ , _nn_score :: score
+ , _nn_category :: cat
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column (PGInt4))
(Column (PGInt4))
(Maybe (Column (PGFloat8)))
- (Maybe (Column (PGBool)))
- (Maybe (Column (PGBool)))
+ (Maybe (Column (PGInt4)))
type NodeNodeRead = NodeNodePoly (Column (PGInt4))
(Column (PGInt4))
(Column (PGFloat8))
- (Column (PGBool))
- (Column (PGBool))
-
+ (Column (PGInt4))
+
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGFloat8))
- (Column (Nullable PGBool))
- (Column (Nullable PGBool))
+ (Column (Nullable PGInt4))
-type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Bool) (Maybe Bool)
+type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
-$(makeLensesWith abbreviatedFields ''NodeNodePoly)
+makeLenses ''NodeNodePoly
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode
- NodeNode { nodeNode_node1_id = required "node1_id"
- , nodeNode_node2_id = required "node2_id"
- , nodeNode_score = optional "score"
- , nodeNode_favorite = optional "favorite"
- , nodeNode_delete = optional "delete"
+ NodeNode { _nn_node1_id = required "node1_id"
+ , _nn_node2_id = required "node2_id"
+ , _nn_score = optional "score"
+ , _nn_category = optional "category"
}
)
instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
-instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
+instance QueryRunnerColumnDefault (Nullable PGFloat8) Int where
queryRunnerColumnDefault = fieldQueryRunnerColumn
-instance QueryRunnerColumnDefault PGBool (Maybe Bool) where
+instance QueryRunnerColumnDefault (Nullable PGFloat8) Double where
queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
+ queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
+ queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------
+-- | Basic NodeNode tools
+getNodeNode :: NodeId -> Cmd err [NodeNode]
+getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
+ where
+ selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
+ selectNodeNode n' = proc () -> do
+ ns <- queryNodeNodeTable -< ()
+ restrict -< _nn_node1_id ns .== n'
+ returnA -< ns
+
+-------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int64
+insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
+ where
+ ns' :: [NodeNodeWrite]
+ ns' = map (\(NodeNode n1 n2 x y)
+ -> NodeNode (pgNodeId n1)
+ (pgNodeId n2)
+ (pgDouble <$> x)
+ (pgInt4 <$> y)
+ ) ns
+
+
-- | Favorite management
-nodeToFavorite :: CorpusId -> DocId -> Bool -> Cmd err [Int]
-nodeToFavorite cId dId b = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (b,cId,dId)
+nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
+nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
where
favQuery :: PGS.Query
- favQuery = [sql|UPDATE nodes_nodes SET favorite = ?
+ favQuery = [sql|UPDATE nodes_nodes SET category = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
-nodesToFavorite :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
-nodesToFavorite inputData = map (\(PGS.Only a) -> a)
- <$> runPGSQuery trashQuery (PGS.Only $ Values fields inputData)
+nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
+nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
+ <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
where
- fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
- trashQuery :: PGS.Query
- trashQuery = [sql| UPDATE nodes_nodes as old SET
- favorite = new.favorite
- from (?) as new(node1_id,node2_id,favorite)
- WHERE old.node1_id = new.node1_id
- AND old.node2_id = new.node2_id
- RETURNING new.node2_id
+ fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
+ catQuery :: PGS.Query
+ catQuery = [sql| UPDATE nodes_nodes as nn0
+ SET category = nn1.category
+ FROM (?) as nn1(node1_id,node2_id,category)
+ WHERE nn0.node1_id = nn1.node1_id
+ AND nn0.node2_id = nn1.node2_id
+ RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
+-- | TODO use UTCTime fast
+selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
+ <$> catMaybes
+ <$> map (view hyperdataDocument_publication_date)
+ <$> selectDocs cId
+
+selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs cId = runOpaQuery (queryDocs cId)
+
+queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs cId = proc () -> do
+ (n, nn) <- joinInCorpus -< ()
+ restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
+ restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
+ restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+ returnA -< view (node_hyperdata) n
+
+selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
+selectDocNodes cId = runOpaQuery (queryDocNodes cId)
+
+queryDocNodes :: CorpusId -> O.Query NodeRead
+queryDocNodes cId = proc () -> do
+ (n, nn) <- joinInCorpus -< ()
+ restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
+ restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
+ restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+ returnA -< n
+
+joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
+joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
+ where
+ cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+ cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
+
------------------------------------------------------------------------
-- | Trash management
nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
trashQuery :: PGS.Query
- trashQuery = [sql| UPDATE nodes_nodes as old SET
- delete = new.delete
- from (?) as new(node1_id,node2_id,delete)
- WHERE old.node1_id = new.node1_id
- AND old.node2_id = new.node2_id
- RETURNING new.node2_id
+ trashQuery = [sql| UPDATE nodes_nodes as nn0 SET
+ delete = nn1.delete
+ from (?) as nn1(node1_id,node2_id,delete)
+ WHERE nn0.node1_id = nn1.node1_id
+ AND nn0.node2_id = nn1.node2_id
+ RETURNING nn1.node2_id
|]
-- | /!\ Really remove nodes in the Corpus or Annuaire
RETURNING n.node2_id
|]
------------------------------------------------------------------------
-
-