Skip to content

haskell-gargantext
haskell-gargantext
Commit 77c37772 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[CODE ERGO] Instance method renamed

parent 70057b4c
Hide whitespace changes
Inline Side-by-side
Showing with 78 additions and 78 deletions
src/Gargantext/Core.hs
View file @ 77c37772
...@@ -51,13 +51,13 @@ allLangs :: [Lang] ...@@ -51,13 +51,13 @@ allLangs :: [Lang]
allLangs = [minBound ..] allLangs = [minBound ..]
class HasDBid a where class HasDBid a where
hasDBid :: a -> Int toDBid :: a -> Int
fromDBid :: Int -> a fromDBid :: Int -> a
instance HasDBid Lang where instance HasDBid Lang where
hasDBid All = 0 toDBid All = 0
hasDBid FR = 1 toDBid FR = 1
hasDBid EN = 2 toDBid EN = 2
fromDBid 0 = All fromDBid 0 = All
fromDBid 1 = FR fromDBid 1 = FR
...@@ -70,7 +70,7 @@ data PostTagAlgo = CoreNLP ...@@ -70,7 +70,7 @@ data PostTagAlgo = CoreNLP
deriving (Show, Read) deriving (Show, Read)
instance HasDBid PostTagAlgo where instance HasDBid PostTagAlgo where
hasDBid CoreNLP = 1 toDBid CoreNLP = 1
fromDBid 1 = CoreNLP fromDBid 1 = CoreNLP
fromDBid _ = panic "HasDBid posTagAlgo : Not implemented" fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"
src/Gargantext/Database/Action/Delete.hs
View file @ 77c37772
...@@ -44,13 +44,13 @@ deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err) ...@@ -44,13 +44,13 @@ deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
deleteNode u nodeId = do deleteNode u nodeId = do
node' <- N.getNode nodeId node' <- N.getNode nodeId
case (view node_typename node') of case (view node_typename node') of
nt | nt == hasDBid NodeUser -> panic "Not allowed to delete NodeUser (yet)" nt | nt == toDBid NodeUser -> panic "Not allowed to delete NodeUser (yet)"
nt | nt == hasDBid NodeTeam -> do nt | nt == toDBid NodeTeam -> do
uId <- getUserId u uId <- getUserId u
if _node_userId node' == uId if _node_userId node' == uId
then N.deleteNode nodeId then N.deleteNode nodeId
else delFolderTeam u nodeId else delFolderTeam u nodeId
nt | nt == hasDBid NodeFile -> do nt | nt == toDBid NodeFile -> do
node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile) node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
GPU.removeFile $ unpack path GPU.removeFile $ unpack path
......
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @ 77c37772
...@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId) ...@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
selectQuery :: NodeType -> NodeId -> Query (Column PGInt4) selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
selectQuery nt' nId' = proc () -> do selectQuery nt' nId' = proc () -> do
(node, node_node) <- queryJoin -< () (node, node_node) <- queryJoin -< ()
restrict -< (node^.node_typename) .== (pgInt4 $ hasDBid nt') restrict -< (node^.node_typename) .== (pgInt4 $ toDBid nt')
restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId') restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
returnA -< node^.node_id returnA -< node^.node_id
......
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @ 77c37772
...@@ -73,7 +73,7 @@ getNodesByNgramsUser cId nt = ...@@ -73,7 +73,7 @@ getNodesByNgramsUser cId nt =
selectNgramsByNodeUser cId' nt' = selectNgramsByNodeUser cId' nt' =
runPGSQuery queryNgramsByNodeUser runPGSQuery queryNgramsByNodeUser
( cId' ( cId'
, hasDBid NodeDocument , toDBid NodeDocument
, ngramsTypeId nt' , ngramsTypeId nt'
-- , 100 :: Int -- limit -- , 100 :: Int -- limit
-- , 0 :: Int -- offset -- , 0 :: Int -- offset
...@@ -86,7 +86,7 @@ getNodesByNgramsUser cId nt = ...@@ -86,7 +86,7 @@ getNodesByNgramsUser cId nt =
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- hasDBid AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0 AND nn.category > 0
GROUP BY nng.node2_id, ng.terms GROUP BY nng.node2_id, ng.terms
...@@ -184,7 +184,7 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms = ...@@ -184,7 +184,7 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
runPGSQuery queryNgramsOccurrencesOnlyByNodeUser runPGSQuery queryNgramsOccurrencesOnlyByNodeUser
( Values fields ((DPS.Only . unNgramsTerm) <$> tms) ( Values fields ((DPS.Only . unNgramsTerm) <$> tms)
, cId , cId
, hasDBid NodeDocument , toDBid NodeDocument
, ngramsTypeId nt , ngramsTypeId nt
) )
where where
...@@ -202,7 +202,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql| ...@@ -202,7 +202,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- hasDBid AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0 AND nn.category > 0
GROUP BY nng.node2_id, ng.terms GROUP BY nng.node2_id, ng.terms
...@@ -217,7 +217,7 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql| ...@@ -217,7 +217,7 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- hasDBid AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0 AND nn.category > 0
GROUP BY nng.node2_id, ng.terms GROUP BY nng.node2_id, ng.terms
...@@ -267,7 +267,7 @@ selectNgramsOnlyByNodeUser cId ls nt tms = ...@@ -267,7 +267,7 @@ selectNgramsOnlyByNodeUser cId ls nt tms =
, Values [QualifiedIdentifier Nothing "int4"] , Values [QualifiedIdentifier Nothing "int4"]
(DPS.Only <$> (map (\(NodeId n) -> n) ls)) (DPS.Only <$> (map (\(NodeId n) -> n) ls))
, cId , cId
, hasDBid NodeDocument , toDBid NodeDocument
, ngramsTypeId nt , ngramsTypeId nt
) )
where where
...@@ -284,7 +284,7 @@ queryNgramsOnlyByNodeUser = [sql| ...@@ -284,7 +284,7 @@ queryNgramsOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- hasDBid AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0 AND nn.category > 0
GROUP BY ng.terms, nng.node2_id GROUP BY ng.terms, nng.node2_id
...@@ -303,7 +303,7 @@ selectNgramsOnlyByNodeUser' cId ls nt tms = ...@@ -303,7 +303,7 @@ selectNgramsOnlyByNodeUser' cId ls nt tms =
, Values [QualifiedIdentifier Nothing "int4"] , Values [QualifiedIdentifier Nothing "int4"]
(DPS.Only <$> (map (\(NodeId n) -> n) ls)) (DPS.Only <$> (map (\(NodeId n) -> n) ls))
, cId , cId
, hasDBid NodeDocument , toDBid NodeDocument
, ngramsTypeId nt , ngramsTypeId nt
) )
where where
...@@ -386,13 +386,13 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery ...@@ -386,13 +386,13 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
queryNgramsByNodeMaster' queryNgramsByNodeMaster'
( ucId ( ucId
, ngramsTypeId NgramsTerms , ngramsTypeId NgramsTerms
, hasDBid NodeDocument , toDBid NodeDocument
, p , p
, hasDBid NodeDocument , toDBid NodeDocument
, p , p
, n , n
, mcId , mcId
, hasDBid NodeDocument , toDBid NodeDocument
, ngramsTypeId NgramsTerms , ngramsTypeId NgramsTerms
) )
...@@ -406,7 +406,7 @@ queryNgramsByNodeMaster' = [sql| ...@@ -406,7 +406,7 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON nng.node2_id = n.id JOIN node_node_ngrams nng ON nng.node2_id = n.id
JOIN ngrams ng ON nng.ngrams_id = ng.id JOIN ngrams ng ON nng.ngrams_id = ng.id
WHERE nn.node1_id = ? -- UserCorpusId WHERE nn.node1_id = ? -- UserCorpusId
-- AND n.typename = ? -- hasDBid -- AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0 AND nn.category > 0
AND node_pos(n.id,?) >= ? AND node_pos(n.id,?) >= ?
...@@ -421,8 +421,8 @@ queryNgramsByNodeMaster' = [sql| ...@@ -421,8 +421,8 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON n.id = nng.node2_id JOIN node_node_ngrams nng ON n.id = nng.node2_id
JOIN ngrams ng ON ng.id = nng.ngrams_id JOIN ngrams ng ON ng.id = nng.ngrams_id
WHERE n.parent_id = ? -- Master Corpus hasDBid WHERE n.parent_id = ? -- Master Corpus toDBid
AND n.typename = ? -- hasDBid AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId AND nng.ngrams_type = ? -- NgramsTypeId
GROUP BY n.id, ng.terms GROUP BY n.id, ng.terms
) )
......
src/Gargantext/Database/Action/Search.hs
View file @ 77c37772
...@@ -50,7 +50,7 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t) ...@@ -50,7 +50,7 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
queryDocInDatabase _ q = proc () -> do queryDocInDatabase _ q = proc () -> do
row <- queryNodeSearchTable -< () row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q)) restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ hasDBid NodeDocument) restrict -< (_ns_typename row) .== (pgInt4 $ toDBid NodeDocument)
returnA -< (_ns_id row, _ns_hyperdata row) returnA -< (_ns_id row, _ns_hyperdata row)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -91,7 +91,7 @@ queryInCorpus cId t q = proc () -> do ...@@ -91,7 +91,7 @@ queryInCorpus cId t q = proc () -> do
then (nn^.nn_category) .== (toNullable $ pgInt4 0) then (nn^.nn_category) .== (toNullable $ pgInt4 0)
else (nn^.nn_category) .>= (toNullable $ pgInt4 1) else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q)) restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q))
restrict -< (n ^. ns_typename ) .== (pgInt4 $ hasDBid NodeDocument) restrict -< (n ^. ns_typename ) .== (pgInt4 $ toDBid NodeDocument)
returnA -< FacetDoc (n^.ns_id ) returnA -< FacetDoc (n^.ns_id )
(n^.ns_date ) (n^.ns_date )
(n^.ns_name ) (n^.ns_name )
...@@ -138,10 +138,10 @@ selectContactViaDoc ...@@ -138,10 +138,10 @@ selectContactViaDoc
selectContactViaDoc cId aId q = proc () -> do selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< () (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q ) restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (pgInt4 $ hasDBid NodeDocument) restrict -< (doc^.ns_typename) .== (pgInt4 $ toDBid NodeDocument)
restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId) restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId) restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ hasDBid NodeContact) restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ toDBid NodeContact)
returnA -< ( contact^.node_id returnA -< ( contact^.node_id
, contact^.node_date , contact^.node_date
, contact^.node_hyperdata , contact^.node_hyperdata
...@@ -273,6 +273,6 @@ textSearch :: HasDBid NodeType ...@@ -273,6 +273,6 @@ textSearch :: HasDBid NodeType
-> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)] -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l) textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
where where
typeId = hasDBid NodeDocument typeId = toDBid NodeDocument
src/Gargantext/Database/Admin/Config.hs
View file @ 77c37772
...@@ -40,7 +40,7 @@ userArbitrary :: Text ...@@ -40,7 +40,7 @@ userArbitrary :: Text
userArbitrary = "user1" userArbitrary = "user1"
instance HasDBid NodeType where instance HasDBid NodeType where
hasDBid = nodeTypeId toDBid = nodeTypeId
fromDBid = fromNodeTypeId fromDBid = fromNodeTypeId
...@@ -96,10 +96,10 @@ nodeTypeId n = ...@@ -96,10 +96,10 @@ nodeTypeId n =
-- NodeFavorites -> 15 -- NodeFavorites -> 15
hasNodeType :: forall a. Node a -> NodeType -> Bool hasNodeType :: forall a. Node a -> NodeType -> Bool
hasNodeType n nt = (view node_typename n) == (hasDBid nt) hasNodeType n nt = (view node_typename n) == (toDBid nt)
isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool
isInNodeTypes n ts = elem (view node_typename n) (map hasDBid ts) isInNodeTypes n ts = elem (view node_typename n) (map toDBid ts)
-- | Nodes are typed in the database according to a specific ID -- | Nodes are typed in the database according to a specific ID
-- --
...@@ -107,7 +107,7 @@ nodeTypeInv :: [(NodeTypeId, NodeType)] ...@@ -107,7 +107,7 @@ nodeTypeInv :: [(NodeTypeId, NodeType)]
nodeTypeInv = map swap nodeTypes nodeTypeInv = map swap nodeTypes
nodeTypes :: [(NodeType, NodeTypeId)] nodeTypes :: [(NodeType, NodeTypeId)]
nodeTypes = [ (n, hasDBid n) | n <- allNodeTypes ] nodeTypes = [ (n, toDBid n) | n <- allNodeTypes ]
fromNodeTypeId :: NodeTypeId -> NodeType fromNodeTypeId :: NodeTypeId -> NodeType
fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist") fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")
......
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs
View file @ 77c37772
...@@ -25,7 +25,7 @@ import Gargantext.Prelude ...@@ -25,7 +25,7 @@ import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as DPS import qualified Database.PostgreSQL.Simple as DPS
triggerCountInsert :: HasDBid NodeType => Cmd err Int64 triggerCountInsert :: HasDBid NodeType => Cmd err Int64
triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList) triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
where where
query :: DPS.Query query :: DPS.Query
query = [sql| query = [sql|
...@@ -61,9 +61,9 @@ triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList) ...@@ -61,9 +61,9 @@ triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList)
|] |]
triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64 triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64
triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
, hasDBid NodeDocument , toDBid NodeDocument
, hasDBid NodeList , toDBid NodeList
) )
where where
query :: DPS.Query query :: DPS.Query
...@@ -105,9 +105,9 @@ triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus ...@@ -105,9 +105,9 @@ triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus
-- TODO add the groups -- TODO add the groups
triggerCoocInsert :: HasDBid NodeType => Cmd err Int64 triggerCoocInsert :: HasDBid NodeType => Cmd err Int64
triggerCoocInsert = execPGSQuery query ( hasDBid NodeCorpus triggerCoocInsert = execPGSQuery query ( toDBid NodeCorpus
, hasDBid NodeDocument , toDBid NodeDocument
, hasDBid NodeList , toDBid NodeList
, listTypeId CandidateTerm , listTypeId CandidateTerm
, listTypeId CandidateTerm , listTypeId CandidateTerm
) )
......
src/Gargantext/Database/Admin/Trigger/Nodes.hs
View file @ 77c37772
...@@ -26,9 +26,9 @@ import qualified Database.PostgreSQL.Simple as DPS ...@@ -26,9 +26,9 @@ import qualified Database.PostgreSQL.Simple as DPS
triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64 triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64
triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
, hasDBid NodeDocument , toDBid NodeDocument
, hasDBid NodeContact , toDBid NodeContact
) )
where where
query :: DPS.Query query :: DPS.Query
...@@ -70,12 +70,12 @@ triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument ...@@ -70,12 +70,12 @@ triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument
type Secret = Text type Secret = Text
triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64 triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64
triggerUpdateHash secret = execPGSQuery query ( hasDBid NodeDocument triggerUpdateHash secret = execPGSQuery query ( toDBid NodeDocument
, hasDBid NodeContact , toDBid NodeContact
, secret , secret
, secret , secret
, hasDBid NodeDocument , toDBid NodeDocument
, hasDBid NodeContact , toDBid NodeContact
, secret , secret
, secret , secret
) )
......
src/Gargantext/Database/Admin/Trigger/NodesNodes.hs
View file @ 77c37772
...@@ -29,7 +29,7 @@ import qualified Database.PostgreSQL.Simple as DPS ...@@ -29,7 +29,7 @@ import qualified Database.PostgreSQL.Simple as DPS
type MasterListId = ListId type MasterListId = ListId
triggerDeleteCount :: MasterListId -> Cmd err Int64 triggerDeleteCount :: MasterListId -> Cmd err Int64
triggerDeleteCount lId = execPGSQuery query (lId, hasDBid NodeList) triggerDeleteCount lId = execPGSQuery query (lId, toDBid NodeList)
where where
query :: DPS.Query query :: DPS.Query
query = [sql| query = [sql|
......
src/Gargantext/Database/Admin/Types/Node.hs
View file @ 77c37772
...@@ -99,11 +99,11 @@ instance (Typeable hyperdata, ToSchema hyperdata) => ...@@ -99,11 +99,11 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
instance (Arbitrary nodeId instance (Arbitrary nodeId
,Arbitrary hashId ,Arbitrary hashId
,Arbitrary hasDBid ,Arbitrary toDBid
,Arbitrary userId ,Arbitrary userId
,Arbitrary nodeParentId ,Arbitrary nodeParentId
, Arbitrary hyperdata , Arbitrary hyperdata
) => Arbitrary (NodePoly nodeId hashId hasDBid userId nodeParentId ) => Arbitrary (NodePoly nodeId hashId toDBid userId nodeParentId
NodeName UTCTime hyperdata) where NodeName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "") --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
...@@ -112,10 +112,10 @@ instance (Arbitrary nodeId ...@@ -112,10 +112,10 @@ instance (Arbitrary nodeId
instance (Arbitrary hyperdata instance (Arbitrary hyperdata
,Arbitrary nodeId ,Arbitrary nodeId
,Arbitrary hasDBid ,Arbitrary toDBid
,Arbitrary userId ,Arbitrary userId
,Arbitrary nodeParentId ,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId hasDBid userId nodeParentId ) => Arbitrary (NodePolySearch nodeId toDBid userId nodeParentId
NodeName UTCTime hyperdata (Maybe TSVector)) where NodeName UTCTime hyperdata (Maybe TSVector)) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "") --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
......
src/Gargantext/Database/Query/Facet.hs
View file @ 77c37772
...@@ -248,7 +248,7 @@ viewAuthorsDoc cId _ nt = proc () -> do ...@@ -248,7 +248,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
-} -}
restrict -< _node_id contact' .== (toNullable $ pgNodeId cId) restrict -< _node_id contact' .== (toNullable $ pgNodeId cId)
restrict -< _node_typename doc .== (pgInt4 $ hasDBid nt) restrict -< _node_typename doc .== (pgInt4 $ toDBid nt)
returnA -< FacetDoc (_node_id doc) returnA -< FacetDoc (_node_id doc)
(_node_date doc) (_node_date doc)
...@@ -290,14 +290,14 @@ runViewDocuments :: HasDBid NodeType ...@@ -290,14 +290,14 @@ runViewDocuments :: HasDBid NodeType
runViewDocuments cId t o l order query = do runViewDocuments cId t o l order query = do
runOpaQuery $ filterWith o l order sqlQuery runOpaQuery $ filterWith o l order sqlQuery
where where
ntId = hasDBid NodeDocument ntId = toDBid NodeDocument
sqlQuery = viewDocuments cId t ntId query sqlQuery = viewDocuments cId t ntId query
runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
runCountDocuments cId t mQuery = do runCountDocuments cId t mQuery = do
runCountOpaQuery sqlQuery runCountOpaQuery sqlQuery
where where
sqlQuery = viewDocuments cId t (hasDBid NodeDocument) mQuery sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery
viewDocuments :: CorpusId viewDocuments :: CorpusId
......
src/Gargantext/Database/Query/Table/Node.hs
View file @ 77c37772
...@@ -75,7 +75,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do ...@@ -75,7 +75,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< () row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
restrict -< parentId' .== (pgNodeId parentId) restrict -< parentId' .== (pgNodeId parentId)
let typeId' = maybe 0 hasDBid maybeNodeType let typeId' = maybe 0 toDBid maybeNodeType
restrict -< if typeId' > 0 restrict -< if typeId' > 0
then typeId .== (pgInt4 (typeId' :: Int)) then typeId .== (pgInt4 (typeId' :: Int))
...@@ -122,7 +122,7 @@ getClosestParentIdByType nId nType = do ...@@ -122,7 +122,7 @@ getClosestParentIdByType nId nType = do
result <- runPGSQuery query (nId, 0 :: Int) result <- runPGSQuery query (nId, 0 :: Int)
case result of case result of
[DPS.Only parentId, DPS.Only pTypename] -> do [DPS.Only parentId, DPS.Only pTypename] -> do
if hasDBid nType == pTypename then if toDBid nType == pTypename then
pure $ Just $ NodeId parentId pure $ Just $ NodeId parentId
else else
getClosestParentIdByType (NodeId parentId) nType getClosestParentIdByType (NodeId parentId) nType
...@@ -168,7 +168,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt ...@@ -168,7 +168,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
=> NodeType -> Query NodeRead => NodeType -> Query NodeRead
selectNodesWithType nt' = proc () -> do selectNodesWithType nt' = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ hasDBid nt') restrict -< tn .== (pgInt4 $ toDBid nt')
returnA -< row returnA -< row
getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId] getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
...@@ -180,7 +180,7 @@ selectNodesIdWithType :: HasDBid NodeType ...@@ -180,7 +180,7 @@ selectNodesIdWithType :: HasDBid NodeType
=> NodeType -> Query (Column PGInt4) => NodeType -> Query (Column PGInt4)
selectNodesIdWithType nt = proc () -> do selectNodesIdWithType nt = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ hasDBid nt) restrict -< tn .== (pgInt4 $ toDBid nt)
returnA -< _node_id row returnA -< _node_id row
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -236,7 +236,7 @@ node nodeType name hyperData parentId userId = ...@@ -236,7 +236,7 @@ node nodeType name hyperData parentId userId =
Nothing Nothing
(pgJSONB $ cs $ encode hyperData) (pgJSONB $ cs $ encode hyperData)
where where
typeId = hasDBid nodeType typeId = toDBid nodeType
------------------------------- -------------------------------
insertNodes :: [NodeWrite] -> Cmd err Int64 insertNodes :: [NodeWrite] -> Cmd err Int64
...@@ -250,7 +250,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn ...@@ -250,7 +250,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite] ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h) ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i) -> Node (pgNodeId <$> i)
(pgInt4 $ hasDBid t) (pgInt4 $ toDBid t)
(pgInt4 u) (pgInt4 u)
(pgNodeId <$> p) (pgNodeId <$> p)
(pgStrictText n) (pgStrictText n)
...@@ -275,7 +275,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi ...@@ -275,7 +275,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
node2table :: HasDBid NodeType node2table :: HasDBid NodeType
=> UserId -> Maybe ParentId -> Node' -> NodeWrite => UserId -> Maybe ParentId -> Node' -> NodeWrite
node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ hasDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v) node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ toDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet" node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
......
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @ 77c37772
...@@ -74,7 +74,7 @@ selectChildren parentId maybeNodeType = proc () -> do ...@@ -74,7 +74,7 @@ selectChildren parentId maybeNodeType = proc () -> do
row@(Node nId _ typeName _ parent_id _ _ _) <- queryNodeTable -< () row@(Node nId _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode n1id n2id _ _) <- queryNodeNodeTable -< () (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 hasDBid maybeNodeType let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId)) restrict -< (.||) (parent_id .== (pgNodeId parentId))
......
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @ 77c37772
...@@ -69,7 +69,7 @@ import Database.PostgreSQL.Simple.SqlQQ ...@@ -69,7 +69,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-}) import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core (HasDBid(hasDBid)) import Gargantext.Core (HasDBid(toDBid))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-}) import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
...@@ -104,7 +104,7 @@ class InsertDb a ...@@ -104,7 +104,7 @@ class InsertDb a
instance InsertDb HyperdataDocument instance InsertDb HyperdataDocument
where where
insertDb' u p h = [ toField ("" :: Text) insertDb' u p h = [ toField ("" :: Text)
, toField $ hasDBid NodeDocument , toField $ toDBid NodeDocument
, toField u , toField u
, toField p , toField p
, toField $ maybe "No Title" (DT.take 255) (_hd_title h) , toField $ maybe "No Title" (DT.take 255) (_hd_title h)
...@@ -115,7 +115,7 @@ instance InsertDb HyperdataDocument ...@@ -115,7 +115,7 @@ instance InsertDb HyperdataDocument
instance InsertDb HyperdataContact instance InsertDb HyperdataContact
where where
insertDb' u p h = [ toField ("" :: Text) insertDb' u p h = [ toField ("" :: Text)
, toField $ hasDBid NodeContact , toField $ toDBid NodeContact
, toField u , toField u
, toField p , toField p
, toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h) , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
...@@ -223,7 +223,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a) ...@@ -223,7 +223,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where where
hashId = Just $ "\\x" <> (hash $ DT.concat params) hashId = Just $ "\\x" <> (hash $ DT.concat params)
params = [ secret params = [ secret
, cs $ show $ hasDBid NodeDocument , cs $ show $ toDBid NodeDocument
, n , n
, cs $ show p , cs $ show p
, cs $ encode h , cs $ encode h
...@@ -235,7 +235,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a) ...@@ -235,7 +235,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where where
hashId = "\\x" <> (hash $ DT.concat params) hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret params = [ secret
, cs $ show $ hasDBid NodeDocument , cs $ show $ toDBid NodeDocument
, n , n
, cs $ show p , cs $ show p
, cs $ encode h , cs $ encode h
...@@ -275,7 +275,7 @@ class ToNode a ...@@ -275,7 +275,7 @@ class ToNode a
toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a
instance ToNode HyperdataDocument where instance ToNode HyperdataDocument where
toNode u p h = Node 0 Nothing (hasDBid NodeDocument) u (Just p) n date h toNode u p h = Node 0 Nothing (toDBid NodeDocument) u (Just p) n date h
where where
n = maybe "No Title" (DT.take 255) (_hd_title h) n = maybe "No Title" (DT.take 255) (_hd_title h)
date = jour y m d date = jour y m d
...@@ -285,7 +285,7 @@ instance ToNode HyperdataDocument where ...@@ -285,7 +285,7 @@ instance ToNode HyperdataDocument where
-- TODO better Node -- TODO better Node
instance ToNode HyperdataContact where instance ToNode HyperdataContact where
toNode u p h = Node 0 Nothing (hasDBid NodeContact) u (Just p) "Contact" date h toNode u p h = Node 0 Nothing (toDBid NodeContact) u (Just p) "Contact" date h
where where
date = jour 2020 01 01 date = jour 2020 01 01
......
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @ 77c37772
...@@ -32,7 +32,7 @@ selectNodesWithUsername nt u = runOpaQuery (q u) ...@@ -32,7 +32,7 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
q u' = proc () -> do q u' = proc () -> do
(n,usrs) <- join' -< () (n,usrs) <- join' -< ()
restrict -< user_username usrs .== (toNullable $ pgStrictText u') restrict -< user_username usrs .== (toNullable $ pgStrictText u')
restrict -< _node_typename n .== (pgInt4 $ hasDBid nt) restrict -< _node_typename n .== (pgInt4 $ toDBid nt)
returnA -< _node_id n returnA -< _node_id n
join' :: Query (NodeRead, UserReadNull) join' :: Query (NodeRead, UserReadNull)
......
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @ 77c37772
...@@ -85,7 +85,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query ...@@ -85,7 +85,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< () row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< () (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 hasDBid maybeNodeType let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId)) restrict -< (.||) (parent_id .== (pgNodeId parentId))
...@@ -152,7 +152,7 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId) ...@@ -152,7 +152,7 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId') restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId')
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument) restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
returnA -< n returnA -< n
...@@ -173,7 +173,7 @@ queryDocs cId = proc () -> do ...@@ -173,7 +173,7 @@ queryDocs cId = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId) restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument) restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
returnA -< view (node_hyperdata) n returnA -< view (node_hyperdata) n
selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument] selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
...@@ -184,7 +184,7 @@ queryDocNodes cId = proc () -> do ...@@ -184,7 +184,7 @@ queryDocNodes cId = proc () -> do
(n, nn) <- joinInCorpus -< () (n, nn) <- joinInCorpus -< ()
restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId) restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId)
restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1) restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument) restrict -< n^.node_typename .== (pgInt4 $ toDBid NodeDocument)
returnA -< n returnA -< n
joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull) joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
...@@ -208,6 +208,6 @@ selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic) ...@@ -208,6 +208,6 @@ selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4)) queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
queryWithType nt = proc () -> do queryWithType nt = proc () -> do
(n, nn) <- joinOn1 -< () (n, nn) <- joinOn1 -< ()
restrict -< n^.node_typename .== (pgInt4 $ hasDBid nt) restrict -< n^.node_typename .== (pgInt4 $ toDBid nt)
returnA -< (n, nn^.nn_node2_id) returnA -< (n, nn^.nn_node2_id)
src/Gargantext/Database/Query/Tree/Root.hs
View file @ 77c37772
...@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead ...@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot (UserName username) = proc () -> do selectRoot (UserName username) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
users <- queryUserTable -< () users <- queryUserTable -< ()
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser) restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
restrict -< user_username users .== (pgStrictText username) restrict -< user_username users .== (pgStrictText username)
restrict -< _node_userId row .== (user_id users) restrict -< _node_userId row .== (user_id users)
returnA -< row returnA -< row
selectRoot (UserDBId uid) = proc () -> do selectRoot (UserDBId uid) = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser) restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
restrict -< _node_userId row .== (pgInt4 uid) restrict -< _node_userId row .== (pgInt4 uid)
returnA -< row returnA -< row
selectRoot (RootId nid) = selectRoot (RootId nid) =
proc () -> do proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser) restrict -< _node_typename row .== (pgInt4 $ toDBid NodeUser)
restrict -< _node_id row .== (pgNodeId nid) restrict -< _node_id row .== (pgNodeId nid)
returnA -< row returnA -< row
selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public" selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public"
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