Commit e6bfc498 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[API][DB] Pairing tools: get pairs and pairWith.

parent 5e9336e4
Pipeline #722 failed with stage
...@@ -12,7 +12,6 @@ Portability : POSIX ...@@ -12,7 +12,6 @@ Portability : POSIX
-- TODO-ACCESS: CanGetNode -- TODO-ACCESS: CanGetNode
-- TODO-EVENTS: No events as this is a read only query. -- TODO-EVENTS: No events as this is a read only query.
Node API Node API
------------------------------------------------------------------- -------------------------------------------------------------------
-- TODO-ACCESS: access by admin only. -- TODO-ACCESS: access by admin only.
-- At first let's just have an isAdmin check. -- At first let's just have an isAdmin check.
...@@ -61,7 +60,7 @@ import Gargantext.Database.Flow.Pairing (pairing) ...@@ -61,7 +60,7 @@ import Gargantext.Database.Flow.Pairing (pairing)
import Gargantext.Database.Facet (FacetDoc, OrderBy(..)) import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
import Gargantext.Database.Node.Children (getChildren) import Gargantext.Database.Node.Children (getChildren)
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..)) import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
import Gargantext.Database.Schema.NodeNode (nodeNodesCategory) import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Tree (treeDB) import Gargantext.Database.Tree (treeDB)
import Gargantext.Database.Types.Node import Gargantext.Database.Types.Node
...@@ -132,7 +131,10 @@ type NodeAPI a = Get '[JSON] (Node a) ...@@ -132,7 +131,10 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "category" :> CatApi :<|> "category" :> CatApi
:<|> "search" :> SearchDocsAPI :<|> "search" :> SearchDocsAPI
-- Pairing utilities -- Pairing utilities
:<|> "pairwith" :> PairWith
:<|> "pairs" :> Pairs
:<|> "pairing" :> PairingApi :<|> "pairing" :> PairingApi
:<|> "searchPair" :> SearchPairsAPI :<|> "searchPair" :> SearchPairsAPI
...@@ -192,11 +194,13 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i ...@@ -192,11 +194,13 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
:<|> tableApi id :<|> tableApi id
:<|> apiNgramsTableCorpus id :<|> apiNgramsTableCorpus id
:<|> catApi id :<|> catApi id
:<|> searchDocs id :<|> searchDocs id
-- Pairing Tools -- Pairing Tools
:<|> getPair id :<|> pairWith id
:<|> pairs id
:<|> getPair id
:<|> searchPairs id :<|> searchPairs id
:<|> getScatter id :<|> getScatter id
...@@ -268,6 +272,12 @@ type PairingApi = Summary " Pairing API" ...@@ -268,6 +272,12 @@ type PairingApi = Summary " Pairing API"
:> Get '[JSON] [FacetDoc] :> Get '[JSON] [FacetDoc]
---------- ----------
type Pairs = Summary "List of Pairs"
:> Get '[JSON] [AnnuaireId]
pairs :: CorpusId -> GargServer Pairs
pairs cId = do
ns <- getNodeNode cId
pure $ map _nn_node2_id ns
type PairWith = Summary "Pair a Corpus with an Annuaire" type PairWith = Summary "Pair a Corpus with an Annuaire"
:> "annuaire" :> Capture "annuaire_id" AnnuaireId :> "annuaire" :> Capture "annuaire_id" AnnuaireId
...@@ -277,6 +287,7 @@ type PairWith = Summary "Pair a Corpus with an Annuaire" ...@@ -277,6 +287,7 @@ type PairWith = Summary "Pair a Corpus with an Annuaire"
pairWith :: CorpusId -> GargServer PairWith pairWith :: CorpusId -> GargServer PairWith
pairWith cId aId lId = do pairWith cId aId lId = do
r <- pairing cId aId lId r <- pairing cId aId lId
_ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
pure r pure r
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -75,7 +75,6 @@ prepare pId ns = map (\nId -> InputData pId nId) ns ...@@ -75,7 +75,6 @@ prepare pId ns = map (\nId -> InputData pId nId) ns
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- * Main Types used -- * Main Types used
data InputData = InputData { inNode1_id :: NodeId data InputData = InputData { inNode1_id :: NodeId
, inNode2_id :: NodeId , inNode2_id :: NodeId
} deriving (Show, Generic, Typeable) } deriving (Show, Generic, Typeable)
......
...@@ -135,7 +135,6 @@ instance InsertDb HyperdataContact ...@@ -135,7 +135,6 @@ instance InsertDb HyperdataContact
, (toField . toJSON) h , (toField . toJSON) h
] ]
-- | Debug SQL function -- | Debug SQL function
-- --
-- to print rendered query (Debug purpose) use @formatQuery@ function. -- to print rendered query (Debug purpose) use @formatQuery@ function.
......
...@@ -530,9 +530,16 @@ arbitraryDashboard = HyperdataDashboard (Just "Preferences") ...@@ -530,9 +530,16 @@ arbitraryDashboard = HyperdataDashboard (Just "Preferences")
------------------------------------------------------------------------ ------------------------------------------------------------------------
node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData) node nodeType name hyperData parentId userId =
where Node Nothing
typeId = nodeTypeId nodeType (pgInt4 typeId)
(pgInt4 userId)
(pgNodeId <$> parentId)
(pgStrictText name)
Nothing
(pgJSONB $ cs $ encode hyperData)
where
typeId = nodeTypeId nodeType
------------------------------- -------------------------------
insertNodes :: [NodeWrite] -> Cmd err Int64 insertNodes :: [NodeWrite] -> Cmd err Int64
......
...@@ -65,7 +65,7 @@ type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4)) ...@@ -65,7 +65,7 @@ type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
(Column (Nullable PGFloat8)) (Column (Nullable PGFloat8))
(Column (Nullable PGInt4)) (Column (Nullable PGInt4))
type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int) type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
$(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly) $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
makeLenses ''NodeNodePoly makeLenses ''NodeNodePoly
...@@ -102,8 +102,30 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where ...@@ -102,8 +102,30 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn 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 -- | Favorite management
nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int] nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId) nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
...@@ -131,12 +153,10 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a) ...@@ -131,12 +153,10 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | TODO use UTCTime fast -- | TODO use UTCTime fast
selectDocsDates :: CorpusId -> Cmd err [Text] selectDocsDates :: CorpusId -> Cmd err [Text]
selectDocsDates cId = selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
map (head' "selectDocsDates" . splitOn "-") <$> catMaybes
<$> catMaybes <$> map (view hyperdataDocument_publication_date)
<$> map (view hyperdataDocument_publication_date) <$> selectDocs cId
<$> selectDocs cId
selectDocs :: CorpusId -> Cmd err [HyperdataDocument] selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
selectDocs cId = runOpaQuery (queryDocs cId) selectDocs cId = runOpaQuery (queryDocs cId)
...@@ -149,7 +169,6 @@ queryDocs cId = proc () -> do ...@@ -149,7 +169,6 @@ queryDocs cId = proc () -> do
restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument) restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< view (node_hyperdata) n returnA -< view (node_hyperdata) n
selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument] selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
selectDocNodes cId = runOpaQuery (queryDocNodes cId) selectDocNodes cId = runOpaQuery (queryDocNodes cId)
...@@ -161,14 +180,12 @@ queryDocNodes cId = proc () -> do ...@@ -161,14 +180,12 @@ queryDocNodes cId = proc () -> do
restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument) restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< n returnA -< n
joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull) joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
where where
cond :: (NodeRead, NodeNodeRead) -> Column PGBool cond :: (NodeRead, NodeNodeRead) -> Column PGBool
cond (n, nn) = nn^.nn_node2_id .== (view node_id n) cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Trash management -- | Trash management
nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int] nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment