Skip to content

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

[REFACT] HasDBid

parent bb4b74f6
Hide whitespace changes
Inline Side-by-side
Showing with 219 additions and 146 deletions
src/Gargantext/Core.hs
View file @ b5c9a011
......@@ -18,6 +18,7 @@ import Data.Aeson
import Data.Either(Either(Left))
import Data.Swagger
import Servant.API
------------------------------------------------------------------------
-- | Language of a Text
-- For simplicity, we suppose text has an homogenous language
......@@ -42,9 +43,34 @@ instance FromJSON Lang
instance ToSchema Lang
instance FromHttpApiData Lang
where
parseUrlPiece "EN" = pure EN
parseUrlPiece "FR" = pure FR
parseUrlPiece "EN" = pure EN
parseUrlPiece "FR" = pure FR
parseUrlPiece "All" = pure All
parseUrlPiece _ = Left "Unexpected value of OrderBy"
parseUrlPiece _ = Left "Unexpected value of OrderBy"
allLangs :: [Lang]
allLangs = [minBound ..]
class HasDBid a where
hasDBid :: a -> Int
fromDBid :: Int -> a
instance HasDBid Lang where
hasDBid All = 0
hasDBid FR = 1
hasDBid EN = 2
fromDBid 0 = All
fromDBid 1 = FR
fromDBid 2 = EN
fromDBid _ = panic "HasDBid lang, not implemented"
------------------------------------------------------------------------
data PostTagAlgo = CoreNLP
deriving (Show, Read)
instance HasDBid PostTagAlgo where
hasDBid CoreNLP = 1
fromDBid 1 = CoreNLP
fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"
src/Gargantext/Core/Text/Terms.hs
View file @ b5c9a011
......@@ -63,7 +63,7 @@ data TermType lang
= Mono { _tt_lang :: !lang }
| Multi { _tt_lang :: !lang }
| MonoMulti { _tt_lang :: !lang }
| Unsupervised { _tt_lang :: !lang
| Unsupervised { _tt_lang :: !lang
, _tt_windowSize :: !Int
, _tt_ngramsSize :: !Int
, _tt_model :: !(Maybe (Tries Token ()))
......@@ -140,6 +140,8 @@ terms (Unsupervised lang n s m) txt = termsUnsupervised (Unsupervised lang n s (
where
m' = maybe (newTries n txt) identity m
-- terms (WithList list) txt = pure . concat $ extractTermsWithList list txt
------------------------------------------------------------------------
text2term :: Lang -> [Text] -> Terms
......
src/Gargantext/Core/Text/Terms/Multi.hs
View file @ b5c9a011
......@@ -28,12 +28,17 @@ import qualified Gargantext.Core.Text.Terms.Multi.Lang.Fr as Fr
import Gargantext.Core.Text.Terms.Multi.RAKE (multiterms_rake)
-------------------------------------------------------------------
-- To be removed
multiterms :: Lang -> Text -> IO [Terms]
multiterms lang txt = concat
<$> map (map tokenTag2terms)
multiterms = multiterms' tokenTag2terms
multiterms' :: (TokenTag -> a) -> Lang -> Text -> IO [a]
multiterms' f lang txt = concat
<$> map (map f)
<$> map (filter (\t -> _my_token_pos t == Just NP))
<$> tokenTags lang txt
-------------------------------------------------------------------
tokenTag2terms :: TokenTag -> Terms
tokenTag2terms (TokenTag ws t _ _) = Terms ws t
......
src/Gargantext/Database/Action/Delete.hs
View file @ b5c9a011
......@@ -24,7 +24,8 @@ import Servant
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Action.Share (delFolderTeam)
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Core
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata.File
import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
......@@ -44,13 +45,13 @@ deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
deleteNode u nodeId = do
node' <- N.getNode nodeId
case (view node_typename node') of
nt | nt == nodeTypeId NodeUser -> panic "Not allowed to delete NodeUser (yet)"
nt | nt == nodeTypeId NodeTeam -> do
nt | nt == hasDBid NodeUser -> panic "Not allowed to delete NodeUser (yet)"
nt | nt == hasDBid NodeTeam -> do
uId <- getUserId u
if _node_userId node' == uId
then N.deleteNode nodeId
else delFolderTeam u nodeId
nt | nt == nodeTypeId NodeFile -> do
nt | nt == hasDBid NodeFile -> do
node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
GPU.removeFile $ unpack path
......
src/Gargantext/Database/Action/Flow.hs
View file @ b5c9a011
......@@ -258,8 +258,7 @@ insertMasterDocs c lang hs = do
-- this will enable global database monitoring
-- maps :: IO Map Ngrams (Map NgramsType (Map NodeId Int))
mapNgramsDocs <- mapNodeIdNgrams
<$> documentIdWithNgrams (extractNgramsT $ withLang lang documentsWithId) documentsWithId
mapNgramsDocs <- mapNodeIdNgrams <$> documentIdWithNgrams (extractNgramsT $ withLang lang documentsWithId) documentsWithId
terms2id <- insertNgrams $ Map.keys mapNgramsDocs
-- to be removed
......
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @ b5c9a011
......@@ -24,6 +24,7 @@ import Data.Set (Set)
import Gargantext.API.Ngrams.Tools
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.API.Prelude (GargNoServer)
import Gargantext.Core
import Gargantext.Core.Types (TableResult(..))
import Gargantext.Core.Types.Main
import Gargantext.Database
......@@ -54,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
selectQuery nt' nId' = proc () -> do
(node, node_node) <- queryJoin -< ()
restrict -< (node^.node_typename) .== (pgInt4 $ nodeTypeId nt')
restrict -< (node^.node_typename) .== (pgInt4 $ hasDBid nt')
restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
returnA -< node^.node_id
......
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @ b5c9a011
......@@ -25,9 +25,9 @@ import Data.Tuple.Extra (first, second, swap)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Debug.Trace (trace)
import Gargantext.Core
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Data.HashMap.Strict.Utils as HM
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
......@@ -57,7 +57,8 @@ groupNodesByNgramsWith f m =
$ HM.toList m
------------------------------------------------------------------------
getNodesByNgramsUser :: CorpusId
getNodesByNgramsUser :: HasDBid NodeType
=> CorpusId
-> NgramsType
-> Cmd err (HashMap NgramsTerm (Set NodeId))
getNodesByNgramsUser cId nt =
......@@ -65,13 +66,14 @@ getNodesByNgramsUser cId nt =
<$> selectNgramsByNodeUser cId nt
where
selectNgramsByNodeUser :: CorpusId
selectNgramsByNodeUser :: HasDBid NodeType
=> CorpusId
-> NgramsType
-> Cmd err [(NodeId, Text)]
selectNgramsByNodeUser cId' nt' =
runPGSQuery queryNgramsByNodeUser
( cId'
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, ngramsTypeId nt'
-- , 100 :: Int -- limit
-- , 0 :: Int -- offset
......@@ -84,7 +86,7 @@ getNodesByNgramsUser cId nt =
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- NodeTypeId
AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
......@@ -94,7 +96,8 @@ getNodesByNgramsUser cId nt =
|]
------------------------------------------------------------------------
-- TODO add groups
getOccByNgramsOnlyFast :: CorpusId
getOccByNgramsOnlyFast :: HasDBid NodeType
=> CorpusId
-> NgramsType
-> [NgramsTerm]
-> Cmd err (HashMap NgramsTerm Int)
......@@ -140,7 +143,8 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
-- just slower than getOccByNgramsOnlyFast
getOccByNgramsOnlySlow :: NodeType
getOccByNgramsOnlySlow :: HasDBid NodeType
=> NodeType
-> CorpusId
-> [ListId]
-> NgramsType
......@@ -153,7 +157,8 @@ getOccByNgramsOnlySlow t cId ls nt ngs =
getScore' NodeDocument = getNgramsByDocOnlyUser
getScore' _ = getNodesByNgramsOnlyUser
getOccByNgramsOnlySafe :: CorpusId
getOccByNgramsOnlySafe :: HasDBid NodeType
=> CorpusId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
......@@ -169,7 +174,8 @@ getOccByNgramsOnlySafe cId ls nt ngs = do
pure slow
selectNgramsOccurrencesOnlyByNodeUser :: CorpusId
selectNgramsOccurrencesOnlyByNodeUser :: HasDBid NodeType
=> CorpusId
-> NgramsType
-> [NgramsTerm]
-> Cmd err [(NgramsTerm, Int)]
......@@ -178,7 +184,7 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
runPGSQuery queryNgramsOccurrencesOnlyByNodeUser
( Values fields ((DPS.Only . unNgramsTerm) <$> tms)
, cId
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, ngramsTypeId nt
)
where
......@@ -196,7 +202,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- NodeTypeId
AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
......@@ -211,14 +217,15 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- NodeTypeId
AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
|]
------------------------------------------------------------------------
getNodesByNgramsOnlyUser :: CorpusId
getNodesByNgramsOnlyUser :: HasDBid NodeType
=> CorpusId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
......@@ -231,7 +238,8 @@ getNodesByNgramsOnlyUser cId ls nt ngs =
(splitEvery 1000 ngs)
getNgramsByNodeOnlyUser :: NodeId
getNgramsByNodeOnlyUser :: HasDBid NodeType
=> NodeId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
......@@ -246,7 +254,8 @@ getNgramsByNodeOnlyUser cId ls nt ngs =
(splitEvery 1000 ngs)
------------------------------------------------------------------------
selectNgramsOnlyByNodeUser :: CorpusId
selectNgramsOnlyByNodeUser :: HasDBid NodeType
=> CorpusId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
......@@ -258,7 +267,7 @@ selectNgramsOnlyByNodeUser cId ls nt tms =
, Values [QualifiedIdentifier Nothing "int4"]
(DPS.Only <$> (map (\(NodeId n) -> n) ls))
, cId
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, ngramsTypeId nt
)
where
......@@ -275,14 +284,15 @@ queryNgramsOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- NodeTypeId
AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY ng.terms, nng.node2_id
|]
selectNgramsOnlyByNodeUser' :: CorpusId
selectNgramsOnlyByNodeUser' :: HasDBid NodeType
=> CorpusId
-> [ListId]
-> NgramsType
-> [Text]
......@@ -293,7 +303,7 @@ selectNgramsOnlyByNodeUser' cId ls nt tms =
, Values [QualifiedIdentifier Nothing "int4"]
(DPS.Only <$> (map (\(NodeId n) -> n) ls))
, cId
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, ngramsTypeId nt
)
where
......@@ -358,14 +368,16 @@ queryNgramsOnlyByDocUser = [sql|
------------------------------------------------------------------------
-- | TODO filter by language, database, any social field
getNodesByNgramsMaster :: UserCorpusId -> MasterCorpusId -> Cmd err (HashMap Text (Set NodeId))
getNodesByNgramsMaster :: HasDBid NodeType
=> UserCorpusId -> MasterCorpusId -> Cmd err (HashMap Text (Set NodeId))
getNodesByNgramsMaster ucId mcId = unionsWith (<>)
. map (HM.fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
-- . takeWhile (not . List.null)
-- . takeWhile (\l -> List.length l > 3)
<$> mapM (selectNgramsByNodeMaster 1000 ucId mcId) [0,500..10000]
selectNgramsByNodeMaster :: Int
selectNgramsByNodeMaster :: HasDBid NodeType
=> Int
-> UserCorpusId
-> MasterCorpusId
-> Int
......@@ -374,13 +386,13 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
queryNgramsByNodeMaster'
( ucId
, ngramsTypeId NgramsTerms
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, p
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, p
, n
, mcId
, nodeTypeId NodeDocument
, hasDBid NodeDocument
, ngramsTypeId NgramsTerms
)
......@@ -394,7 +406,7 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON nng.node2_id = n.id
JOIN ngrams ng ON nng.ngrams_id = ng.id
WHERE nn.node1_id = ? -- UserCorpusId
-- AND n.typename = ? -- NodeTypeId
-- AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
AND node_pos(n.id,?) >= ?
......@@ -409,8 +421,8 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON n.id = nng.node2_id
JOIN ngrams ng ON ng.id = nng.ngrams_id
WHERE n.parent_id = ? -- Master Corpus NodeTypeId
AND n.typename = ? -- NodeTypeId
WHERE n.parent_id = ? -- Master Corpus hasDBid
AND n.typename = ? -- hasDBid
AND nng.ngrams_type = ? -- NgramsTypeId
GROUP BY n.id, ng.terms
)
......
src/Gargantext/Database/Action/Metrics/TFICF.hs
View file @ b5c9a011
......@@ -19,6 +19,7 @@ module Gargantext.Database.Action.Metrics.TFICF
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)
import Gargantext.Core
import Gargantext.Core.Text.Metrics.TFICF
import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getOccByNgramsOnlyFast)
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
......@@ -29,7 +30,8 @@ import Gargantext.API.Ngrams.Types
import Gargantext.Prelude
import qualified Data.Set as Set
getTficf :: UserCorpusId
getTficf :: HasDBid NodeType
=> UserCorpusId
-> MasterCorpusId
-> NgramsType
-> Cmd err (HashMap NgramsTerm Double)
......
src/Gargantext/Database/Action/Search.hs
View file @ b5c9a011
......@@ -22,8 +22,9 @@ import Data.Text (Text, words, unpack, intercalate)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
import Gargantext.Database.Query.Facet
......@@ -49,7 +50,7 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
queryDocInDatabase _ q = proc () -> do
row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (pgTSQuery (unpack q))
restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (_ns_typename row) .== (pgInt4 $ hasDBid NodeDocument)
returnA -< (_ns_id row, _ns_hyperdata row)
------------------------------------------------------------------------
......@@ -87,7 +88,7 @@ queryInCorpus cId t q = proc () -> do
then (nn^.nn_category) .== (toNullable $ pgInt4 0)
else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q))
restrict -< (n ^. ns_typename ) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (n ^. ns_typename ) .== (pgInt4 $ hasDBid NodeDocument)
returnA -< FacetDoc (n^.ns_id )
(n^.ns_date )
(n^.ns_name )
......@@ -132,10 +133,10 @@ selectContactViaDoc
selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (doc^.ns_typename) .== (pgInt4 $ hasDBid NodeDocument)
restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
restrict -< (contact^.node_typename) .== (toNullable $ pgInt4 $ hasDBid NodeContact)
returnA -< ( contact^.node_id
, contact^.node_date
, contact^.node_hyperdata
......@@ -265,6 +266,6 @@ textSearch :: TSQuery -> ParentId
-> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
where
typeId = nodeTypeId NodeDocument
typeId = hasDBid NodeDocument
src/Gargantext/Database/Admin/Config.hs
View file @ b5c9a011
......@@ -14,6 +14,8 @@ TODO: configure nodes table in Haskell (Config typenames etc.)
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Admin.Config
where
......@@ -22,6 +24,7 @@ import Data.List (lookup)
import Data.Maybe (fromMaybe)
import Data.Text (Text,pack)
import Data.Tuple.Extra (swap)
import Gargantext.Core (HasDBid(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
......@@ -36,6 +39,11 @@ userMaster = "gargantua"
userArbitrary :: Text
userArbitrary = "user1"
instance HasDBid NodeType where
hasDBid = nodeTypeId
fromDBid = fromNodeTypeId
nodeTypeId :: NodeType -> NodeTypeId
nodeTypeId n =
case n of
......@@ -88,10 +96,10 @@ nodeTypeId n =
-- NodeFavorites -> 15
hasNodeType :: forall a. Node a -> NodeType -> Bool
hasNodeType n nt = (view node_typename n) == (nodeTypeId nt)
hasNodeType n nt = (view node_typename n) == (hasDBid nt)
isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool
isInNodeTypes n ts = elem (view node_typename n) (map nodeTypeId ts)
isInNodeTypes n ts = elem (view node_typename n) (map hasDBid ts)
-- | Nodes are typed in the database according to a specific ID
--
......@@ -99,7 +107,7 @@ nodeTypeInv :: [(NodeTypeId, NodeType)]
nodeTypeInv = map swap nodeTypes
nodeTypes :: [(NodeType, NodeTypeId)]
nodeTypes = [ (n, nodeTypeId n) | n <- allNodeTypes ]
nodeTypes = [ (n, hasDBid n) | n <- allNodeTypes ]
fromNodeTypeId :: NodeTypeId -> NodeType
fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")
......
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs
View file @ b5c9a011
......@@ -17,16 +17,15 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
where
import Database.PostgreSQL.Simple.SqlQQ (sql)
import qualified Database.PostgreSQL.Simple as DPS
import Gargantext.Core
import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Prelude (Cmd, execPGSQuery)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as DPS
triggerCountInsert :: Cmd err Int64
triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId NodeList)
triggerCountInsert :: HasDBid NodeType => Cmd err Int64
triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList)
where
query :: DPS.Query
query = [sql|
......@@ -61,10 +60,10 @@ triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId Nod
EXECUTE PROCEDURE set_ngrams_global_count();
|]
triggerCountInsert2 :: Cmd err Int64
triggerCountInsert2 = execPGSQuery query ( nodeTypeId NodeCorpus
, nodeTypeId NodeDocument
, nodeTypeId NodeList
triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64
triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus
, hasDBid NodeDocument
, hasDBid NodeList
)
where
query :: DPS.Query
......@@ -105,10 +104,10 @@ triggerCountInsert2 = execPGSQuery query ( nodeTypeId NodeCorpus
|]
-- TODO add the groups
triggerCoocInsert :: Cmd err Int64
triggerCoocInsert = execPGSQuery query ( nodeTypeId NodeCorpus
, nodeTypeId NodeDocument
, nodeTypeId NodeList
triggerCoocInsert :: HasDBid NodeType => Cmd err Int64
triggerCoocInsert = execPGSQuery query ( hasDBid NodeCorpus
, hasDBid NodeDocument
, hasDBid NodeList
, listTypeId CandidateTerm
, listTypeId CandidateTerm
)
......
src/Gargantext/Database/Admin/Trigger/Nodes.hs
View file @ b5c9a011
......@@ -18,18 +18,17 @@ module Gargantext.Database.Admin.Trigger.Nodes
import Data.Text (Text)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import qualified Database.PostgreSQL.Simple as DPS
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Core (HasDBid(..))
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Prelude (Cmd, execPGSQuery)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as DPS
triggerSearchUpdate :: Cmd err Int64
triggerSearchUpdate = execPGSQuery query ( nodeTypeId NodeDocument
, nodeTypeId NodeDocument
, nodeTypeId NodeContact
triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64
triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument
, hasDBid NodeDocument
, hasDBid NodeContact
)
where
query :: DPS.Query
......@@ -70,13 +69,13 @@ triggerSearchUpdate = execPGSQuery query ( nodeTypeId NodeDocument
type Secret = Text
triggerUpdateHash :: Secret -> Cmd err Int64
triggerUpdateHash secret = execPGSQuery query ( nodeTypeId NodeDocument
, nodeTypeId NodeContact
triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64
triggerUpdateHash secret = execPGSQuery query ( hasDBid NodeDocument
, hasDBid NodeContact
, secret
, secret
, nodeTypeId NodeDocument
, nodeTypeId NodeContact
, hasDBid NodeDocument
, hasDBid NodeContact
, secret
, secret
)
......
src/Gargantext/Database/Admin/Trigger/NodesNodes.hs
View file @ b5c9a011
......@@ -18,7 +18,8 @@ module Gargantext.Database.Admin.Trigger.NodesNodes
import Database.PostgreSQL.Simple.SqlQQ (sql)
-- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Core
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
import Gargantext.Database.Prelude (Cmd, execPGSQuery)
......@@ -28,7 +29,7 @@ import qualified Database.PostgreSQL.Simple as DPS
type MasterListId = ListId
triggerDeleteCount :: MasterListId -> Cmd err Int64
triggerDeleteCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
triggerDeleteCount lId = execPGSQuery query (lId, hasDBid NodeList)
where
query :: DPS.Query
query = [sql|
......
src/Gargantext/Database/Admin/Types/Node.hs
View file @ b5c9a011
......@@ -99,11 +99,11 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
instance (Arbitrary nodeId
,Arbitrary hashId
,Arbitrary nodeTypeId
,Arbitrary hasDBid
,Arbitrary userId
,Arbitrary nodeParentId
, Arbitrary hyperdata
) => Arbitrary (NodePoly nodeId hashId nodeTypeId userId nodeParentId
) => Arbitrary (NodePoly nodeId hashId hasDBid userId nodeParentId
NodeName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
......@@ -112,10 +112,10 @@ instance (Arbitrary nodeId
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary nodeTypeId
,Arbitrary hasDBid
,Arbitrary userId
,Arbitrary nodeParentId
) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
) => Arbitrary (NodePolySearch nodeId hasDBid userId nodeParentId
NodeName UTCTime hyperdata (Maybe TSVector)) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary
......
src/Gargantext/Database/Query/Facet.hs
View file @ b5c9a011
......@@ -52,9 +52,9 @@ import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import qualified Opaleye.Internal.Unpackspec()
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5)
......@@ -232,13 +232,13 @@ instance Arbitrary OrderBy
-- TODO-SECURITY check
--{-
runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
where
ntId = NodeDocument
-- TODO add delete ?
viewAuthorsDoc :: ContactId -> IsTrash -> NodeType -> Query FacetDocRead
viewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> NodeType -> Query FacetDocRead
viewAuthorsDoc cId _ nt = proc () -> do
(doc,(_,(_,(_,contact')))) <- queryAuthorsDoc -< ()
......@@ -248,7 +248,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
-}
restrict -< _node_id contact' .== (toNullable $ pgNodeId cId)
restrict -< _node_typename doc .== (pgInt4 $ nodeTypeId nt)
restrict -< _node_typename doc .== (pgInt4 $ hasDBid nt)
returnA -< FacetDoc (_node_id doc)
(_node_date doc)
......@@ -279,7 +279,8 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsT
------------------------------------------------------------------------
-- TODO-SECURITY check
runViewDocuments :: CorpusId
runViewDocuments :: HasDBid NodeType
=> CorpusId
-> IsTrash
-> Maybe Offset
-> Maybe Limit
......@@ -289,14 +290,14 @@ runViewDocuments :: CorpusId
runViewDocuments cId t o l order query = do
runOpaQuery $ filterWith o l order sqlQuery
where
ntId = nodeTypeId NodeDocument
ntId = hasDBid NodeDocument
sqlQuery = viewDocuments cId t ntId query
runCountDocuments :: CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
runCountDocuments cId t mQuery = do
runCountOpaQuery sqlQuery
where
sqlQuery = viewDocuments cId t (nodeTypeId NodeDocument) mQuery
sqlQuery = viewDocuments cId t (hasDBid NodeDocument) mQuery
viewDocuments :: CorpusId
......
src/Gargantext/Database/Query/Table/NgramsPostag.hs
View file @ b5c9a011
......@@ -25,6 +25,8 @@ import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
type NgramsPostagInsert = ( Int
, Int
, Text
......@@ -34,6 +36,7 @@ type NgramsPostagInsert = ( Int
, Int
)
insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [NgramIds]
insertNgramsPostag ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
where
......
src/Gargantext/Database/Query/Table/Node.hs
View file @ b5c9a011
......@@ -32,8 +32,8 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default
import Gargantext.Database.Prelude
......@@ -73,7 +73,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
restrict -< parentId' .== (pgNodeId parentId)
let typeId' = maybe 0 nodeTypeId maybeNodeType
let typeId' = maybe 0 hasDBid maybeNodeType
restrict -< if typeId' > 0
then typeId .== (pgInt4 (typeId' :: Int))
......@@ -119,7 +119,7 @@ getClosestParentIdByType nId nType = do
result <- runPGSQuery query (nId, 0 :: Int)
case result of
[DPS.Only parentId, DPS.Only pTypename] -> do
if nodeTypeId nType == pTypename then
if hasDBid nType == pTypename then
pure $ Just $ NodeId parentId
else
getClosestParentIdByType (NodeId parentId) nType
......@@ -164,7 +164,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
selectNodesWithType :: NodeType -> Query NodeRead
selectNodesWithType nt' = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ nodeTypeId nt')
restrict -< tn .== (pgInt4 $ hasDBid nt')
returnA -< row
getNodesIdWithType :: HasNodeError err => NodeType -> Cmd err [NodeId]
......@@ -175,7 +175,7 @@ getNodesIdWithType nt = do
selectNodesIdWithType :: NodeType -> Query (Column PGInt4)
selectNodesIdWithType nt = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
restrict -< tn .== (pgInt4 $ nodeTypeId nt)
restrict -< tn .== (pgInt4 $ hasDBid nt)
returnA -< _node_id row
------------------------------------------------------------------------
......@@ -228,7 +228,7 @@ node nodeType name hyperData parentId userId =
Nothing
(pgJSONB $ cs $ encode hyperData)
where
typeId = nodeTypeId nodeType
typeId = hasDBid nodeType
-------------------------------
insertNodes :: [NodeWrite] -> Cmd err Int64
......@@ -242,7 +242,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i)
(pgInt4 $ nodeTypeId t)
(pgInt4 $ hasDBid t)
(pgInt4 u)
(pgNodeId <$> p)
(pgStrictText n)
......@@ -266,7 +266,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
-- needs a Temporary type between Node' and NodeWriteT
node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
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 _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
......
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @ b5c9a011
......@@ -18,8 +18,8 @@ module Gargantext.Database.Query.Table.Node.Children
import Control.Arrow (returnA)
import Data.Proxy
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Filter
......@@ -30,23 +30,23 @@ import Protolude
-- TODO getAllTableDocuments
getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
getAllDocuments :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
(Just NodeDocument)
-- TODO getAllTableContacts
getAllContacts :: ParentId -> Cmd err (TableResult (Node HyperdataContact))
getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
(Just NodeContact)
getAllChildren :: JSONB a
getAllChildren :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
-> Cmd err (NodeTableResult a)
getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
getChildren :: JSONB a
getChildren :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
......@@ -66,14 +66,15 @@ getChildren pId _ maybeNodeType maybeOffset maybeLimit = do
where
query = selectChildren pId maybeNodeType
selectChildren :: ParentId
selectChildren :: HasDBid NodeType
=> ParentId
-> Maybe NodeType
-> Query NodeRead
selectChildren parentId maybeNodeType = proc () -> do
row@(Node nId _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 nodeTypeId maybeNodeType
let nodeType = maybe 0 hasDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId))
......
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @ b5c9a011
......@@ -69,7 +69,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import GHC.Generics (Generic)
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Core (HasDBid(hasDBid))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
......@@ -91,20 +91,20 @@ import Database.PostgreSQL.Simple (formatQuery)
-- ParentId : folder ID which is parent of the inserted documents
-- Administrator of the database has to create a uniq index as following SQL command:
-- `create unique index on nodes (typename, parent_id, (hyperdata ->> 'uniqId'));`
insertDb :: InsertDb a => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
class InsertDb a
where
insertDb' :: UserId -> ParentId -> a -> [Action]
insertDb' :: HasDBid NodeType => UserId -> ParentId -> a -> [Action]
instance InsertDb HyperdataDocument
where
insertDb' u p h = [ toField ("" :: Text)
, toField $ nodeTypeId NodeDocument
, toField $ hasDBid NodeDocument
, toField u
, toField p
, toField $ maybe "No Title" (DT.take 255) (_hd_title h)
......@@ -115,7 +115,7 @@ instance InsertDb HyperdataDocument
instance InsertDb HyperdataContact
where
insertDb' u p h = [ toField ("" :: Text)
, toField $ nodeTypeId NodeContact
, toField $ hasDBid NodeContact
, toField u
, toField p
, toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
......@@ -217,13 +217,13 @@ secret :: Text
secret = "Database secret to change"
instance (AddUniqId a, ToJSON a) => AddUniqId (Node a)
instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where
addUniqId (Node nid _ t u p n d h) = Node nid hashId t u p n d h
where
hashId = Just $ "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $ nodeTypeId NodeDocument
, cs $ show $ hasDBid NodeDocument
, n
, cs $ show p
, cs $ encode h
......@@ -235,7 +235,7 @@ instance (AddUniqId a, ToJSON a) => AddUniqId (Node a)
where
hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $ nodeTypeId NodeDocument
, cs $ show $ hasDBid NodeDocument
, n
, cs $ show p
, cs $ encode h
......@@ -272,10 +272,10 @@ maybeText = maybe (DT.pack "") identity
class ToNode a
where
-- TODO Maybe NodeId
toNode :: UserId -> ParentId -> a -> Node a
toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a
instance ToNode HyperdataDocument where
toNode u p h = Node 0 Nothing (nodeTypeId NodeDocument) u (Just p) n date h
toNode u p h = Node 0 Nothing (hasDBid NodeDocument) u (Just p) n date h
where
n = maybe "No Title" (DT.take 255) (_hd_title h)
date = jour y m d
......@@ -285,7 +285,7 @@ instance ToNode HyperdataDocument where
-- TODO better Node
instance ToNode HyperdataContact where
toNode u p h = Node 0 Nothing (nodeTypeId NodeContact) u (Just p) "Contact" date h
toNode u p h = Node 0 Nothing (hasDBid NodeContact) u (Just p) "Contact" date h
where
date = jour 2020 01 01
......
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @ b5c9a011
......@@ -18,21 +18,21 @@ import Control.Arrow (returnA)
import Opaleye
import Protolude
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.User
import Gargantext.Database.Query.Table.User
selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
selectNodesWithUsername :: HasDBid NodeType => NodeType -> Username -> Cmd err [NodeId]
selectNodesWithUsername nt u = runOpaQuery (q u)
where
q u' = proc () -> do
(n,usrs) <- join' -< ()
restrict -< user_username usrs .== (toNullable $ pgStrictText u')
restrict -< _node_typename n .== (pgInt4 $ nodeTypeId nt)
restrict -< _node_typename n .== (pgInt4 $ hasDBid nt)
returnA -< _node_id n
join' :: Query (NodeRead, UserReadNull)
......
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @ b5c9a011
......@@ -43,9 +43,9 @@ import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import qualified Opaleye as O
import Opaleye
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
......@@ -85,7 +85,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 nodeTypeId maybeNodeType
let nodeType = maybe 0 hasDBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId))
......@@ -145,46 +145,46 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
|]
------------------------------------------------------------------------
selectCountDocs :: CorpusId -> Cmd err Int
selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
where
queryCountDocs 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)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
returnA -< n
-- | TODO use UTCTime fast
selectDocsDates :: CorpusId -> Cmd err [Text]
selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
<$> catMaybes
<$> map (view hd_publication_date)
<$> selectDocs cId
selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
selectDocs cId = runOpaQuery (queryDocs cId)
queryDocs :: CorpusId -> O.Query (Column PGJsonb)
queryDocs :: HasDBid NodeType => 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)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
returnA -< view (node_hyperdata) n
selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
selectDocNodes cId = runOpaQuery (queryDocNodes cId)
queryDocNodes :: CorpusId -> O.Query NodeRead
queryDocNodes :: HasDBid NodeType =>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)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
returnA -< n
joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
......@@ -201,13 +201,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
------------------------------------------------------------------------
selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
selectPublicNodes :: HasDBid NodeType => (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
=> Cmd err [(Node a, Maybe Int)]
selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
queryWithType nt = proc () -> do
(n, nn) <- joinOn1 -< ()
restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
restrict -< n^.node_typename .== (pgInt4 $ hasDBid nt)
returnA -< (n, nn^.nn_node2_id)
src/Gargantext/Database/Query/Tree.hs
View file @ b5c9a011
......@@ -46,9 +46,9 @@ import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.SqlQQ
import Gargantext.Prelude
import Gargantext.Core
import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
import Gargantext.Database.Admin.Config hiding (nodeTypes)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
......@@ -153,16 +153,16 @@ updateTree nts fun r = do
sharedTreeUpdate :: HasTreeError err => UpdateTree err
sharedTreeUpdate p nt n = dbTree n nt
<&> map (\n' -> if (view dt_nodeId n') == n
-- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
-- && elem (fromDBid $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
else n')
publicTreeUpdate :: HasTreeError err => UpdateTree err
publicTreeUpdate p nt n = dbTree n nt
<&> map (\n' -> if _dt_nodeId n' == n
-- && (fromNodeTypeId $ _dt_typeId n') /= NodeGraph
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
-- && (fromDBid $ _dt_typeId n') /= NodeGraph
-- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
else n')
......@@ -178,7 +178,7 @@ findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> Cmd err [DbTreeNode]
findNodesWithType root target through =
filter isInTarget <$> dbTree root through
where
isInTarget n = List.elem (fromNodeTypeId $ view dt_typeId n)
isInTarget n = List.elem (fromDBid $ view dt_typeId n)
$ List.nub $ target <> through
------------------------------------------------------------------------
......
src/Gargantext/Database/Query/Tree/Root.hs
View file @ b5c9a011
......@@ -15,11 +15,12 @@ module Gargantext.Database.Query.Tree.Root
import Control.Arrow (returnA)
import Data.Either (Either, fromLeft, fromRight)
import Gargantext.Core
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main (CorpusName)
import Gargantext.Database.Action.Node
import Gargantext.Database.Action.User (getUserId, getUsername)
import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
......@@ -118,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot (UserName username) = proc () -> do
row <- queryNodeTable -< ()
users <- queryUserTable -< ()
restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser)
restrict -< user_username users .== (pgStrictText username)
restrict -< _node_userId row .== (user_id users)
returnA -< row
selectRoot (UserDBId uid) = proc () -> do
row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser)
restrict -< _node_userId row .== (pgInt4 uid)
returnA -< row
selectRoot (RootId nid) =
proc () -> do
row <- queryNodeTable -< ()
restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
restrict -< _node_typename row .== (pgInt4 $ hasDBid NodeUser)
restrict -< _node_id row .== (pgNodeId nid)
returnA -< row
selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public"
src/Gargantext/Database/Schema/NgramsPostag.hs
View file @ b5c9a011
......@@ -22,7 +22,9 @@ module Gargantext.Database.Schema.NgramsPostag
import Control.Lens
import Data.Text (Text)
import Gargantext.Core
import Gargantext.Database.Schema.Prelude
import Gargantext.API.Ngrams.Types
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
......@@ -33,7 +35,7 @@ data NgramsPostagPoly id
ngrams_id
lemm_id
score
= NgramsPostagDB { _ngramsPostag_id :: !id
= NgramsPostagPoly { _ngramsPostag_id :: !id
, _ngramsPostag_lang_id :: !lang_id
, _ngramsPostag_algo_id :: !algo_id
, _ngramsPostag_postag :: !postag
......@@ -43,9 +45,18 @@ data NgramsPostagPoly id
} deriving (Show)
------------------------------------------------------------------------
data PosTag = PosTag { unPosTag :: Text }
| NER { unNER :: Text } -- TODO
------------------------------------------------------------------------
type NgramsPostag = NgramsPostagPoly (Maybe Int) Lang PostTagAlgo (Maybe PosTag) NgramsTerm NgramsTerm (Maybe Int)
type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int Int
------------------------------------------------------------------------
type NgramsPosTagWrite = NgramsPostagPoly (Maybe (Column PGInt4))
(Column PGInt4)
(Column PGInt4)
......@@ -72,7 +83,7 @@ type NgramsPosTagReadNull = NgramsPostagPoly (Column (Nullable PGInt4))
makeLenses ''NgramsPostagPoly
instance PGS.ToRow NgramsPostagDB where
toRow (NgramsPostagDB f0 f1 f2 f3 f4 f5 f6) = [ toField f0
toRow (NgramsPostagPoly f0 f1 f2 f3 f4 f5 f6) = [ toField f0
, toField f1
, toField f2
, toField f3
......
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