Skip to content

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

[REFACT] HasDBid

parent bb4b74f6
Pipeline #1317 failed with stage
    Show 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
    ......@@ -48,3 +49,28 @@ instance FromHttpApiData Lang
    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
    ......@@ -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