Skip to content

H
haskell-gargantext
Commit 254e5d36 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FEAT] Annuaire <-> Corpus pairing (WIP)

parent d435ae39
Expand all Show whitespace changes
Inline Side-by-side
Showing with 374 additions and 219 deletions
devops/postgres/schema.sql
View file @ 254e5d36
......@@ -135,16 +135,27 @@ CREATE TABLE public.nodes_nodes (
ALTER TABLE public.nodes_nodes OWNER TO gargantua;
-- To attach contexts to a Corpus
CREATE TABLE public.nodes_contexts (
id SERIAL ,
node_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
context_id INTEGER NOT NULL REFERENCES public.contexts(id) ON DELETE CASCADE,
score REAL ,
category INTEGER ,
PRIMARY KEY (node_id, context_id)
PRIMARY KEY (id)
);
ALTER TABLE public.nodes_contexts OWNER TO gargantua;
CREATE TABLE public.nodescontexts_nodescontexts (
nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
PRIMARY KEY (nodescontexts1, nodescontexts2)
);
ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
---------------------------------------------------------------
CREATE TABLE public.context_node_ngrams (
context_id INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
......@@ -185,8 +196,6 @@ PRIMARY KEY (node_id, nodengrams_id)
ALTER TABLE public.node_node_ngrams2 OWNER TO gargantua;
--------------------------------------------------------------
--CREATE TABLE public.nodes_ngrams_repo (
......@@ -230,7 +239,7 @@ CREATE INDEX ON public.contexts USING btree (id, typename, date DESC);
CREATE INDEX ON public.contexts USING btree (typename, id);
CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2);
-- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text)));
-- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text)));
-- CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text)));
......@@ -249,6 +258,7 @@ CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngr
CREATE UNIQUE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id);
CREATE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id, category);
-- To make the links between Corpus Node and its contexts
CREATE UNIQUE INDEX ON public.nodes_contexts USING btree (node_id, context_id);
CREATE INDEX ON public.nodes_contexts USING btree (node_id, context_id, category);
......
devops/postgres/upgrade/0.0.5.7.5.sql 0 → 100644
View file @ 254e5d36
ALTER TABLE nodes_contexts DROP CONSTRAINT nodes_contexts_pkey;
ALTER TABLE nodes_contexts ADD COLUMN id SERIAL PRIMARY KEY ;
CREATE TABLE public.nodescontexts_nodescontexts (
nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
PRIMARY KEY (nodescontexts1, nodescontexts2)
);
ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2)
src/Gargantext/API/Client.hs
View file @ 254e5d36
......@@ -116,7 +116,7 @@ postNodeSearch :: Token -> NodeId -> SearchQuery -> Maybe Int -> Maybe Int -> Ma
postNodeShare :: Token -> NodeId -> ShareNodeParams -> ClientM Int
postNodePairCorpusAnnuaire :: Token -> NodeId -> AnnuaireId -> Maybe ListId -> ClientM Int
postNodePairCorpusAnnuaire :: Token -> NodeId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
getNodePairs :: Token -> NodeId -> ClientM [AnnuaireId]
getNodePairings :: Token -> NodeId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
......@@ -205,7 +205,7 @@ postCorpusSearch :: Token -> CorpusId -> SearchQuery -> Maybe Int -> Maybe Int -
postCorpusShare :: Token -> CorpusId -> ShareNodeParams -> ClientM Int
postCorpusPairCorpusAnnuaire :: Token -> CorpusId -> AnnuaireId -> Maybe ListId -> ClientM Int
postCorpusPairCorpusAnnuaire :: Token -> CorpusId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
getCorpusPairs :: Token -> CorpusId -> ClientM [AnnuaireId]
getCorpusPairings :: Token -> CorpusId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
......@@ -299,7 +299,7 @@ putAnnuaireScore :: Token -> AnnuaireId -> NodesToScore -> ClientM [Int]
postAnnuaireSearch :: Token -> AnnuaireId -> SearchQuery -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM SearchResult
postAnnuaireShare :: Token -> AnnuaireId -> ShareNodeParams -> ClientM Int
postAnnuairePairCorpusAnnuaire :: Token -> AnnuaireId -> AnnuaireId -> Maybe ListId -> ClientM Int
postAnnuairePairCorpusAnnuaire :: Token -> AnnuaireId -> AnnuaireId -> Maybe ListId -> ClientM [Int]
getAnnuairePairs :: Token -> AnnuaireId -> ClientM [AnnuaireId]
getAnnuairePairings :: Token -> AnnuaireId -> Maybe TabType -> Maybe Int -> Maybe Int -> Maybe Facet.OrderBy -> ClientM [FacetDoc]
......
src/Gargantext/API/Ngrams/Tools.hs
View file @ 254e5d36
......@@ -135,16 +135,16 @@ filterListWithRootHashMap lt m = snd <$> HM.filter isMapTerm m
Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
Just (l',_) -> l' == lt
filterListWithRoot :: ListType
filterListWithRoot :: [ListType]
-> HashMap NgramsTerm (ListType, Maybe NgramsTerm)
-> HashMap NgramsTerm (Maybe RootTerm)
filterListWithRoot lt m = snd <$> HM.filter isMapTerm m
where
isMapTerm (l, maybeRoot) = case maybeRoot of
Nothing -> l == lt
Nothing -> elem l lt
Just r -> case HM.lookup r m of
Nothing -> panic $ "[Garg.API.Ngrams.Tools] filterWithRoot, unknown key: " <> unNgramsTerm r
Just (l',_) -> l' == lt
Just (l',_) -> elem l' lt
groupNodesByNgrams :: ( At root_map
, Index root_map ~ NgramsTerm
......
src/Gargantext/API/Node.hs
View file @ 254e5d36
......@@ -312,7 +312,7 @@ pairs cId = do
type PairWith = Summary "Pair a Corpus with an Annuaire"
:> "annuaire" :> Capture "annuaire_id" AnnuaireId
:> QueryParam "list_id" ListId
:> Post '[JSON] Int
:> Post '[JSON] [Int]
pairWith :: CorpusId -> GargServer PairWith
pairWith cId aId lId = do
......
src/Gargantext/API/Node/Corpus/Export.hs
View file @ 254e5d36
......@@ -95,7 +95,7 @@ getContextNgrams cId lId listType nt repo = do
-- Just l -> pure l
lIds <- selectNodesWithUsername NodeList userMaster
let ngs = filterListWithRoot listType $ mapTermListRoot [lId] nt repo
let ngs = filterListWithRoot [listType] $ mapTermListRoot [lId] nt repo
-- TODO HashMap
r <- getNgramsByContextOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
pure r
......
src/Gargantext/Core/Viz/Chart.hs
View file @ 254e5d36
......@@ -61,7 +61,7 @@ chartData cId nt lt = do
ls <- map (_node_id) <$> getListsWithParentId cId
ts <- mapTermListRoot ls nt <$> getRepo' ls
let
dico = filterListWithRoot lt ts
dico = filterListWithRoot [lt] ts
terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
group dico' x = case HashMap.lookup x dico' of
Nothing -> x
......@@ -86,7 +86,7 @@ treeData cId nt lt = do
ts <- mapTermListRoot ls nt <$> getRepo' ls
let
dico = filterListWithRoot lt ts
dico = filterListWithRoot [lt] ts
terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ HashMap.toList dico
cs' <- getContextsByNgramsOnlyUser cId (ls' <> ls) nt terms
......
src/Gargantext/Core/Viz/Graph/API.hs
View file @ 254e5d36
......@@ -174,7 +174,7 @@ computeGraph cId method d nt repo = do
lId <- defaultList cId
lIds <- selectNodesWithUsername NodeList userMaster
let ngs = filterListWithRoot MapTerm
let ngs = filterListWithRoot [MapTerm]
$ mapTermListRoot [lId] nt repo
myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
......
src/Gargantext/Database/Action/Metrics.hs
View file @ 254e5d36
......@@ -234,8 +234,9 @@ getNgrams :: (HasMail env, HasNodeStory env err m)
getNgrams lId tabType = do
lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo' [lId]
-- TODO filterListWithRoot [MapTerm, StopTerm, CandidateTerm] lists
let maybeSyn = HM.unions $ map (\t -> filterListWithRoot t lists)
[MapTerm, StopTerm, CandidateTerm]
[[MapTerm], [StopTerm], [CandidateTerm]]
pure (lists, maybeSyn)
-- Some useful Tools
......
src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
View file @ 254e5d36
......@@ -172,7 +172,7 @@ selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt tms =
queryNgramsOccurrencesOnlyByContextUser_withSample :: DPS.Query
queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
WITH nodes_sample AS (SELECT id FROM contexts n TABLESAMPLE SYSTEM_ROWS (?)
WITH nodes_sample AS (SELECT n.id FROM contexts n TABLESAMPLE SYSTEM_ROWS (?)
JOIN nodes_contexts nn ON n.id = nn.context_id
WHERE n.typename = ?
AND nn.node_id = ?),
......
src/Gargantext/Database/Action/Search.hs
View file @ 254e5d36
......@@ -26,8 +26,8 @@ import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Join (leftJoin5)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Context
import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.NodeContext
import Gargantext.Database.Query.Table.NodeContext_NodeContext
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Context
import Gargantext.Prelude
......@@ -41,11 +41,11 @@ searchDocInDatabase :: HasDBid NodeType
=> ParentId
-> Text
-> Cmd err [(NodeId, HyperdataDocument)]
searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
where
-- | Global search query where ParentId is Master Node Corpus Id
queryDocInDatabase :: Text -> O.Select (Column SqlInt4, Column SqlJsonb)
queryDocInDatabase q = proc () -> do
queryDocInDatabase :: ParentId -> Text -> O.Select (Column SqlInt4, Column SqlJsonb)
queryDocInDatabase _p q = proc () -> do
row <- queryNodeSearchTable -< ()
restrict -< (_ns_search row) @@ (sqlTSQuery (unpack q))
restrict -< (_ns_typename row) .== (sqlInt4 $ toDBid NodeDocument)
......@@ -118,11 +118,22 @@ searchInCorpusWithContacts
searchInCorpusWithContacts cId aId q o l _order =
runOpaQuery $ limit' l
$ offset' o
$ orderBy ( desc _fp_score)
$ orderBy (desc _fp_score)
$ selectGroup cId aId
$ intercalate " | "
$ map stemIt q
selectGroup :: HasDBid NodeType
=> CorpusId
-> AnnuaireId
-> Text
-> Select FacetPairedReadNull
selectGroup cId aId q = proc () -> do
(a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
(selectContactViaDoc cId aId q) -< ()
returnA -< FacetPaired a b c d
selectContactViaDoc
:: HasDBid NodeType
=> CorpusId
......@@ -134,81 +145,68 @@ selectContactViaDoc
, Column (Nullable SqlJsonb)
, Column (Nullable SqlInt4)
)
selectContactViaDoc cId aId q = proc () -> do
(doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.ns_search) @@ (sqlTSQuery $ unpack q )
restrict -< (doc^.ns_typename) .== (sqlInt4 $ toDBid NodeDocument)
restrict -< (corpus_doc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
restrict -< (contact^.node_typename) .== (toNullable $ sqlInt4 $ toDBid NodeContact)
returnA -< ( contact^.node_id
, contact^.node_date
, contact^.node_hyperdata
selectContactViaDoc cId aId query = proc () -> do
(doc, (corpus, (_nodeContext_nodeContext, (annuaire, contact)))) <- queryContactViaDoc -< ()
restrict -< (doc^.cs_search) @@ (sqlTSQuery $ unpack query )
restrict -< (doc^.cs_typename) .== (sqlInt4 $ toDBid NodeDocument )
restrict -< (corpus^.nc_node_id) .== (toNullable $ pgNodeId cId )
restrict -< (annuaire^.nc_node_id) .== (toNullable $ pgNodeId aId )
restrict -< (contact^.context_typename) .== (toNullable $ sqlInt4 $ toDBid NodeContact)
returnA -< ( contact^.context_id
, contact^.context_date
, contact^.context_hyperdata
, toNullable $ sqlInt4 1
)
selectGroup :: HasDBid NodeType
=> NodeId
-> NodeId
-> Text
-> Select FacetPairedReadNull
selectGroup cId aId q = proc () -> do
(a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
(selectContactViaDoc cId aId q) -< ()
returnA -< FacetPaired a b c d
queryContactViaDoc :: O.Select ( NodeSearchRead
, ( NodeNodeReadNull
, ( NodeNodeReadNull
, ( NodeNodeReadNull
, NodeReadNull
queryContactViaDoc :: O.Select ( ContextSearchRead
, ( NodeContextReadNull
, ( NodeContext_NodeContextReadNull
, ( NodeContextReadNull
, ContextReadNull
)
)
)
)
queryContactViaDoc =
leftJoin5
queryNodeTable
queryNodeNodeTable
queryNodeNodeTable
queryNodeNodeTable
queryNodeSearchTable
queryContextTable
queryNodeContextTable
queryNodeContext_NodeContextTable
queryNodeContextTable
queryContextSearchTable
cond12
cond23
cond34
cond45
where
cond12 :: (NodeNodeRead, NodeRead) -> Column SqlBool
cond12 (annuaire_contact, contact) = contact^.node_id .== annuaire_contact^.nn_node2_id
cond12 :: (NodeContextRead, ContextRead) -> Column SqlBool
cond12 (annuaire, contact) = contact^.context_id .== annuaire^.nc_context_id
cond23 :: ( NodeNodeRead
, ( NodeNodeRead
, NodeReadNull
cond23 :: ( NodeContext_NodeContextRead
, ( NodeContextRead
, ContextReadNull
)
) -> Column SqlBool
cond23 (contact_doc, (annuaire_contact, _)) = contact_doc^.nn_node1_id .== annuaire_contact^.nn_node2_id
cond23 (nodeContext_nodeContext, (annuaire, _)) = nodeContext_nodeContext^.ncnc_nodecontext2 .== annuaire^.nc_id
cond34 :: ( NodeNodeRead
, ( NodeNodeRead
, ( NodeNodeReadNull
, NodeReadNull
cond34 :: ( NodeContextRead
, ( NodeContext_NodeContextRead
, ( NodeContextReadNull
, ContextReadNull
)
)
) -> Column SqlBool
cond34 (corpus_doc, (contact_doc, (_,_))) = corpus_doc^.nn_node2_id .== contact_doc^.nn_node2_id
cond34 (corpus, (nodeContext_nodeContext, (_,_))) = nodeContext_nodeContext^.ncnc_nodecontext1 .== corpus^.nc_id
cond45 :: ( NodeSearchRead
, ( NodeNodeRead
, ( NodeNodeReadNull
, ( NodeNodeReadNull
, NodeReadNull
cond45 :: ( ContextSearchRead
, ( NodeContextRead
, ( NodeContext_NodeContextReadNull
, ( NodeContextReadNull
, ContextReadNull
)
)
)
) -> Column SqlBool
cond45 (doc, (corpus_doc, (_,(_,_)))) = doc^.ns_id .== corpus_doc^.nn_node2_id
cond45 (doc, (corpus, (_,(_,_)))) = doc^.cs_id .== corpus^.nc_context_id
------------------------------------------------------------------------
src/Gargantext/Database/Admin/Types/Node.hs
View file @ 254e5d36
......@@ -212,10 +212,13 @@ pgContextId = pgNodeId
newtype NodeId = NodeId Int
deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
-- TODO make another type?
-- TODO make another type
type ContextId = NodeId
newtype NodeContextId = NodeContextId Int
deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
instance GQLType NodeId
instance Show NodeId where
show (NodeId n) = "nodeId-" <> show n
......
src/Gargantext/Database/Query/Table/Context.hs
View file @ 254e5d36
{-|
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
Module : Gargantext.Database.Query.Table.Node
Description : Main Tools of Node to the database
Copyright : (c) CNRS, 2017-Present
......@@ -9,7 +8,6 @@ Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
......
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @ 254e5d36
......@@ -122,7 +122,7 @@ selectChildren' :: HasDBid NodeType
-> Select ContextRead
selectChildren' parentId maybeNodeType = proc () -> do
row@(Context cid _ typeName _ _ _ _ _) <- queryContextTable -< ()
(NodeContext nid cid' _ _) <- queryNodeContextTable -< ()
(NodeContext _ nid cid' _ _) <- queryNodeContextTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== sqlInt4 nodeType
......
src/Gargantext/Database/Query/Table/NodeContext.hs
View file @ 254e5d36
......@@ -77,8 +77,9 @@ insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
$ Insert nodeContextTable ns' rCount (Just DoNothing))
where
ns' :: [NodeContextWrite]
ns' = map (\(NodeContext n c x y)
-> NodeContext (pgNodeId n)
ns' = map (\(NodeContext i n c x y)
-> NodeContext (sqlInt4 <$> i)
(pgNodeId n)
(pgNodeId c)
(sqlDouble <$> x)
(sqlInt4 <$> y)
......@@ -93,7 +94,7 @@ deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
deleteNodeContext n c = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn
(Delete nodeContextTable
(\(NodeContext n_id c_id _ _) -> n_id .== pgNodeId n
(\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
.&& c_id .== pgNodeId c
)
rCount
......
src/Gargantext/Database/Query/Table/NodeContext_NodeContext.hs 0 → 100644
View file @ 254e5d36
{-|
Module : Gargantext.Database.Select.Table.NodeContext_NodeContext
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeContext_NodeContext
( module Gargantext.Database.Schema.NodeContext_NodeContext
-- , query_NodeContext_NodeContext_Table
, insertNodeContext_NodeContext
)
where
import Data.Text (Text)
import Gargantext.Core.Types
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.NodeContext_NodeContext
import Gargantext.Database.Schema.Prelude hiding (sum)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
{-
queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
queryNodeContext_NodeContextTable = selectTable nodeContext_NodeContextTable
-}
insertNodeContext_NodeContext :: [(CorpusId, DocId, AnnuaireId, ContactId)] -> Cmd err [Int]
insertNodeContext_NodeContext contexts = do
let
fields = map (\t -> QualifiedIdentifier Nothing t) $ snd fields_name
fields_name :: ( [Text], [Text])
fields_name = ( ["corpus_id", "doc_id", "annuaire_id", "contact_id"]
, ["int4" , "int4" , "int4" , "int4" ]
)
result <- map (\(PGS.Only a) -> a) <$> runPGSQuery queryInsert (PGS.Only $ Values fields contexts)
pure [sum result]
queryInsert :: PGS.Query
queryInsert = [sql|
WITH input(corpus_id, doc_id, annuaire_id, contact_id) AS (?)
INSERT into nodescontexts_nodescontexts (nodescontexts1, nodescontexts2)
SELECT context1.id, context2.id FROM input
INNER JOIN nodes_contexts context1 ON context1.node_id = input.corpus_id
INNER JOIN nodes_contexts context2 ON context2.node_id = input.annuaire_id
WHERE context1.context_id = input.doc_id
AND context2.context_id = input.contact_id
ON CONFLICT (nodescontexts1, nodescontexts2) DO Nothing
RETURNING 1
|]
src/Gargantext/Database/Schema/NodeContext.hs
View file @ 254e5d36
......@@ -26,29 +26,33 @@ import Gargantext.Database.Schema.NodeNode () -- Just importing some instances
import Gargantext.Prelude
data NodeContextPoly node_id context_id score cat
= NodeContext { _nc_node_id :: !node_id
data NodeContextPoly id node_id context_id score cat
= NodeContext { _nc_id :: !id
, _nc_node_id :: !node_id
, _nc_context_id :: !context_id
, _nc_score :: !score
, _nc_category :: !cat
} deriving (Show)
type NodeContextWrite = NodeContextPoly (Column (SqlInt4))
type NodeContextWrite = NodeContextPoly (Maybe (Column (SqlInt4)))
(Column (SqlInt4))
(Column (SqlInt4))
(Maybe (Column (SqlFloat8)))
(Maybe (Column (SqlInt4)))
type NodeContextRead = NodeContextPoly (Column (SqlInt4))
(Column (SqlInt4))
(Column (SqlInt4))
(Column (SqlFloat8))
(Column (SqlInt4))
type NodeContextReadNull = NodeContextPoly (Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlFloat8))
(Column (Nullable SqlInt4))
type NodeContext = NodeContextPoly NodeId NodeId (Maybe Double) (Maybe Int)
type NodeContext = NodeContextPoly (Maybe Int) NodeId NodeId (Maybe Double) (Maybe Int)
$(makeAdaptorAndInstance "pNodeContext" ''NodeContextPoly)
makeLenses ''NodeContextPoly
......@@ -57,7 +61,8 @@ nodeContextTable :: Table NodeContextWrite NodeContextRead
nodeContextTable =
Table "nodes_contexts"
( pNodeContext
NodeContext { _nc_node_id = requiredTableField "node_id"
NodeContext { _nc_id = optionalTableField "id"
, _nc_node_id = requiredTableField "node_id"
, _nc_context_id = requiredTableField "context_id"
, _nc_score = optionalTableField "score"
, _nc_category = optionalTableField "category"
......
src/Gargantext/Database/Schema/NodeContext_NodeContext.hs 0 → 100644
View file @ 254e5d36
{-|
Module : Gargantext.Database.Schema.ContextContext
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.NodeContext_NodeContext where
import Gargantext.Core.Types
import Gargantext.Database.Schema.Prelude
import Gargantext.Prelude
data NodeContext_NodeContextPoly nodecontext1 nodecontext2
= NodeContext_NodeContext { _ncnc_nodecontext1 :: !nodecontext1
, _ncnc_nodecontext2 :: !nodecontext2
} deriving (Show)
type NodeContext_NodeContextWrite = NodeContext_NodeContextPoly (Column (SqlInt4))
(Column (SqlInt4))
type NodeContext_NodeContextRead = NodeContext_NodeContextPoly (Column (SqlInt4))
(Column (SqlInt4))
type NodeContext_NodeContextReadNull = NodeContext_NodeContextPoly (Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
type NodeContext_NodeContext = NodeContext_NodeContextPoly NodeContextId NodeContextId
$(makeAdaptorAndInstance "pNodeContext_NodeContext" ''NodeContext_NodeContextPoly)
makeLenses ''NodeContext_NodeContextPoly
nodeContext_NodeContextTable :: Table NodeContext_NodeContextWrite NodeContext_NodeContextRead
nodeContext_NodeContextTable =
Table "nodescontexts_nodescontexts"
( pNodeContext_NodeContext
NodeContext_NodeContext { _ncnc_nodecontext1 = requiredTableField "nodescontexts1"
, _ncnc_nodecontext2 = requiredTableField "nodescontexts2"
}
)
queryNodeContext_NodeContextTable :: Query NodeContext_NodeContextRead
queryNodeContext_NodeContextTable = selectTable nodeContext_NodeContextTable
src/Gargantext/Database/Schema/NodeNode.hs
View file @ 254e5d36
......@@ -11,8 +11,6 @@ Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
......@@ -63,18 +61,3 @@ nodeNodeTable =
}
)
instance DefaultFromField (Nullable SqlInt4) Int where
defaultFromField = fromPGSFromField
instance DefaultFromField (Nullable SqlFloat8) Int where
defaultFromField = fromPGSFromField
instance DefaultFromField (Nullable SqlFloat8) Double where
defaultFromField = fromPGSFromField
instance DefaultFromField SqlFloat8 (Maybe Double) where
defaultFromField = fromPGSFromField
instance DefaultFromField SqlInt4 (Maybe Int) where
defaultFromField = fromPGSFromField
src/Gargantext/Database/Types.hs
View file @ 254e5d36
......@@ -9,6 +9,7 @@ Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Types
......@@ -40,3 +41,19 @@ instance HasText a => HasText (Indexed i a)
hasText (Indexed _ a) = hasText a
instance (Hashable a, Hashable b) => Hashable (Indexed a b)
instance DefaultFromField (Nullable SqlInt4) Int where
defaultFromField = fromPGSFromField
instance DefaultFromField (Nullable SqlFloat8) Int where
defaultFromField = fromPGSFromField
instance DefaultFromField (Nullable SqlFloat8) Double where
defaultFromField = fromPGSFromField
instance DefaultFromField SqlFloat8 (Maybe Double) where
defaultFromField = fromPGSFromField
instance DefaultFromField SqlInt4 (Maybe Int) where
defaultFromField = fromPGSFromField
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