Skip to content

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

[NodeNodeNgrams] NodeNgrams removed.

parent 5d74f5b4
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 341 additions and 639 deletions
src/Gargantext/API/Ngrams.hs
View file @ 98d4d099
......@@ -46,6 +46,7 @@ import Data.Monoid
import Data.Foldable
--import Data.Semigroup
import Data.Set (Set)
import qualified Data.Set as S
-- import qualified Data.List as List
import Data.Maybe (fromMaybe)
-- import Data.Tuple.Extra (first)
......@@ -69,10 +70,13 @@ import Data.Validity
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
-- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..))
--import Gargantext.Database.Config (userMaster)
import Gargantext.Database.Config (userMaster)
import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlySafe)
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Database.Types.Node (NodeType(..))
import Gargantext.Database.Utils (fromField', HasConnection)
import Gargantext.Database.Node.Select
import Gargantext.Database.Ngrams
--import Gargantext.Database.Lists (listsWith)
import Gargantext.Database.Schema.Node (HasNodeError)
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
......@@ -80,7 +84,7 @@ import qualified Gargantext.Database.Schema.Ngrams as Ngrams
-- import Gargantext.Database.Schema.NodeNgram hiding (Action)
import Gargantext.Prelude
-- import Gargantext.Core.Types (ListTypeId, listTypeId)
import Gargantext.Core.Types (ListType(..), NodeId, ListId, CorpusId, Limit, Offset, HasInvalidError, assertValid)
import Gargantext.Core.Types (ListType(..), NodeId, ListId, CorpusId, DocId, Limit, Offset, HasInvalidError, assertValid)
import Servant hiding (Patch)
import System.FileLock (FileLock)
import Test.QuickCheck (elements)
......@@ -628,6 +632,9 @@ type TableNgramsApi = Summary " Table Ngrams API Change"
:> ReqBody '[JSON] (Versioned NgramsTablePatch)
:> Put '[JSON] (Versioned NgramsTablePatch)
{-
-- TODO: Replace.old is ignored which means that if the current list
-- `GraphTerm` and that the patch is `Replace CandidateTerm StopTerm` then
......@@ -866,7 +873,7 @@ mergeNgramsElement _neOld neNew = neNew
getNgramsTableMap :: RepoCmdM env err m
=> NodeId -> NgramsType -> m (Versioned NgramsTableMap)
getNgramsTableMap nodeId ngramsType = do
v <- view repoVar
v <- view repoVar
repo <- liftIO $ readMVar v
pure $ Versioned (repo ^. r_version)
(repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
......@@ -878,27 +885,59 @@ type MaxSize = Int
-- TODO: polymorphic for Annuaire or Corpus or ...
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId
getTableNgrams :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
=> CorpusId -> TabType
getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
=> NodeId -> TabType
-> ListId -> Limit -> Maybe Offset
-> Maybe ListType
-> Maybe MinSize -> Maybe MaxSize
-> Maybe Text -- full text search
-> m (Versioned NgramsTable)
getTableNgrams cId tabType listId limit_ moffset
mlistType mminSize mmaxSize msearchQuery = do
getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize mt =
getTableNgrams nId tabType listId limit_ offset listType minSize maxSize searchQuery
where
searchQuery = maybe (const True) isInfixOf mt
-- | Text search is deactivated for now for ngrams by doc only
getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
=> CorpusId -> DocId -> TabType
-> ListId -> Limit -> Maybe Offset
-> Maybe ListType
-> Maybe MinSize -> Maybe MaxSize
-> Maybe Text -- full text search
-> m (Versioned NgramsTable)
getTableNgramsDoc cId dId tabType listId limit_ offset listType minSize maxSize _mt = do
ns <- selectNodesWithUsername NodeCorpus userMaster
let ngramsType = ngramsTypeFromTabType tabType
ngs <- selectNgramsByDoc (ns <> [cId]) dId ngramsType
let searchQuery = flip S.member (S.fromList ngs)
getTableNgrams cId tabType listId limit_ offset listType minSize maxSize searchQuery
getTableNgrams :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
=> NodeId -> TabType
-> ListId -> Limit -> Maybe Offset
-> Maybe ListType
-> Maybe MinSize -> Maybe MaxSize
-> (NgramsTerm -> Bool)
-> m (Versioned NgramsTable)
getTableNgrams nId tabType listId limit_ offset
listType minSize maxSize searchQuery = do
let
offset_ = maybe 0 identity moffset
listType = maybe (const True) (==) mlistType
minSize = maybe (const True) (<=) mminSize
maxSize = maybe (const True) (>=) mmaxSize
searchQuery = maybe (const True) isInfixOf msearchQuery
selected_node n = minSize s
&& maxSize s
&& searchQuery (n ^. ne_ngrams)
&& listType (n ^. ne_list)
ngramsType = ngramsTypeFromTabType tabType
offset' = maybe 0 identity offset
listType' = maybe (const True) (==) listType
minSize' = maybe (const True) (<=) minSize
maxSize' = maybe (const True) (>=) maxSize
selected_node n = minSize' s
&& maxSize' s
&& searchQuery (n ^. ne_ngrams)
&& listType' (n ^. ne_list)
where
s = n ^. ne_size
......@@ -909,7 +948,7 @@ getTableNgrams cId tabType listId limit_ moffset
rootOf ne = maybe ne (\r -> ngramsElementFromRepo (r, fromMaybe (panic "getTableNgrams: invalid root") (tableMap ^. at r)))
(ne ^. ne_root)
list = ngramsElementFromRepo <$> Map.toList tableMap
selected_nodes = list & take limit_ . drop offset_ . filter selected_node
selected_nodes = list & take limit_ . drop offset' . filter selected_node
roots = rootOf <$> selected_nodes
rootsSet = Set.fromList (_ne_ngrams <$> roots)
inners = list & filter (selected_inner rootsSet)
......@@ -919,7 +958,7 @@ getTableNgrams cId tabType listId limit_ moffset
-- getNgramsTableMap ({-lists <>-} listIds) ngramsType
table <- getNgramsTableMap listId ngramsType & mapped . v_data %~ finalize
occurrences <- getOccByNgramsOnlySafe cId ngramsType (table ^.. v_data . _NgramsTable . each . ne_ngrams)
occurrences <- getOccByNgramsOnlySafe nId ngramsType (table ^.. v_data . _NgramsTable . each . ne_ngrams)
let
setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
......@@ -927,4 +966,3 @@ getTableNgrams cId tabType listId limit_ moffset
pure $ table & v_data . _NgramsTable . each %~ setOcc
src/Gargantext/API/Node.hs
View file @ 98d4d099
......@@ -45,7 +45,7 @@ import Data.Text (Text())
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgrams, QueryParamR)
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, tableNgramsPatch, getTableNgramsCorpus, QueryParamR)
import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
import Gargantext.API.Types
import Gargantext.Core.Types (Offset, Limit)
......@@ -125,7 +125,7 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "list" :> TableNgramsApi
:<|> "listGet" :> TableNgramsApiGet
:<|> "pairing" :> PairingApi
-- :<|> "document" :> Capture "docId" :> "list" :> TableNgramsApiGet
:<|> "favorites" :> FavApi
:<|> "documents" :> DocsApi
......@@ -172,8 +172,9 @@ nodeAPI p uId id
-- TODO gather it
:<|> getTable id
:<|> tableNgramsPatch id
:<|> getTableNgrams id
:<|> getTableNgramsCorpus id
:<|> getPairing id
-- :<|> getTableNgramsDoc id
:<|> favApi id
:<|> delDocs id
......
src/Gargantext/Database/Bashql.hs
View file @ 98d4d099
......@@ -148,38 +148,3 @@ put = U.update
-- type Name = Text
--mkCorpus :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd err NewNode
--mkCorpus name title ns = do
-- pid <- home
--
-- let pid' = case lastMay pid of
-- Nothing -> printDebug "No home for" name
-- Just p -> p
--
-- let uid = 1
-- postNode uid (Just pid') ( Node' NodeCorpus name emptyObject
-- (map (\n -> Node' Document (title n) (toJSON n) []) ns)
-- )
--
---- |
---- import IMTClient as C
---- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
--mkAnnuaire :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd err NewNode
--mkAnnuaire name title ns = do
-- pid <- lastMay <$> home
-- let pid' = case lastMay pid of
-- Nothing -> printDebug "No home for" name
-- Just p -> p
-- let uid = 1
-- postNode uid (Just pid') ( Node' Annuaire name emptyObject
-- (map (\n -> Node' UserPage (title n) (toJSON n) []) ns)
-- )
--------------------------------------------------------------
-- |
-- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
-- There is an error in the CSV parsing...
-- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
-- corporaOf :: Username -> IO [Corpus]
src/Gargantext/Database/Flow.hs
View file @ 98d4d099
......@@ -44,7 +44,7 @@ import Gargantext.Core.Types (NodePoly(..), Terms(..))
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Core.Types.Main
import Gargantext.Database.Config (userMaster, corpusMasterName)
import Gargantext.Database.Flow.Utils (insertToNodeNgrams)
import Gargantext.Database.Flow.Utils (insertDocNgrams)
import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Root (getRoot)
......@@ -183,7 +183,7 @@ insertMasterDocs c lang hs = do
terms2id <- insertNgrams $ DM.keys maps
let indexedNgrams = DM.mapKeys (indexNgrams terms2id) maps
_ <- insertToNodeNgrams indexedNgrams
_ <- insertDocNgrams masterCorpusId indexedNgrams
pure $ map reId ids
......
src/Gargantext/Database/Flow/Utils.hs
View file @ 98d4d099
......@@ -23,6 +23,8 @@ import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
import Gargantext.Database.Utils (Cmd)
import Gargantext.Database.Schema.NodeNgram
import Gargantext.Database.Schema.NodeNodeNgrams
import Gargantext.Database.Types.Node
import Gargantext.Core.Types.Main (ListType(..), listTypeId)
toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
......@@ -56,6 +58,7 @@ data DocumentIdWithNgrams a =
-- | TODO for now, list Type is CandidateTerm because Graph Terms
-- have to be detected in next step in the flow
-- TODO remvoe this
insertToNodeNgrams :: Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err Int
insertToNodeNgrams m = insertNodeNgrams [ NodeNgram n (_ngramsId ng) Nothing (ngramsTypeId t) (listTypeId CandidateTerm) (fromIntegral i)
| (ng, t2n2i) <- DM.toList m
......@@ -63,3 +66,23 @@ insertToNodeNgrams m = insertNodeNgrams [ NodeNgram n (_ngramsId ng) Nothing (ng
, (n, i) <- DM.toList n2i
]
docNgrams2nodeNodeNgrams :: CorpusId -> DocNgrams -> NodeNodeNgrams
docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) = NodeNodeNgrams Nothing cId d n nt w
data DocNgrams = DocNgrams { dn_doc_id :: DocId
, dn_ngrams_id :: Int
, dn_ngrams_type :: NgramsTypeId
, dn_weight :: Double
}
insertDocNgramsOn :: CorpusId -> [DocNgrams] -> Cmd err Int
insertDocNgramsOn cId dn = insertNodeNodeNgrams $ (map (docNgrams2nodeNodeNgrams cId) dn)
insertDocNgrams :: CorpusId -> Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err Int
insertDocNgrams cId m = insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
| (ng, t2n2i) <- DM.toList m
, (t, n2i) <- DM.toList t2n2i
, (n, i) <- DM.toList n2i
]
src/Gargantext/Database/Metrics/Count.hs
View file @ 98d4d099
......@@ -20,6 +20,8 @@ Count Ngrams by Context
module Gargantext.Database.Metrics.Count where
{-
import Control.Arrow (returnA)
import Control.Lens (view)
import Data.Map.Strict (Map, fromListWith, elems)
......@@ -30,14 +32,14 @@ import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement)
import Gargantext.Core.Types.Main (listTypeId, ListType(..))
import Gargantext.Database.Access
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Queries.Join (leftJoin4, leftJoin5, leftJoin3)
import Gargantext.Database.Queries.Join (leftJoin4, leftJoin3)
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Ngrams (NgramsId, NgramsType(..), ngramsTypeId, Ngrams(..), NgramsIndexed(..), ngrams, ngramsTerms, fromNgramsTypeId)
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Node (HasNodeError(..))
import Gargantext.Database.Schema.NodeNgram
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Schema.NodeNodeNgrams
--import Gargantext.Database.Schema.NodeNodeNgrams
import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Utils
import Gargantext.Database.Utils (Cmd, runPGSQuery)
......@@ -47,40 +49,6 @@ import Opaleye
import Safe (headMay)
import qualified Database.PostgreSQL.Simple as PGS
getCoocByDocDev :: HasNodeError err => CorpusId -> ListId -> Cmd err (Map ([Text], [Text]) Int)
getCoocByDocDev cId lId = coocOn (\n-> [ view ( ngrams . ngramsTerms) n]) <$> getNgramsByDoc cId lId
getCoocByDoc :: CorpusId -> ListId -> Cmd err (Map (NgramsIndexed, NgramsIndexed) Coocs)
getCoocByDoc cId lId = coocOn identity <$> getNgramsByDoc cId lId
getNgramsByDoc :: CorpusId -> ListId -> Cmd err [[NgramsIndexed]]
getNgramsByDoc cId lId =
elems
<$> fromListWith (<>)
<$> map (\(nId, ngId, nt, n) -> (nId, [NgramsIndexed (Ngrams nt n) ngId]))
<$> getNgramsByDocDb cId lId
getNgramsByDocDb :: CorpusId -> ListId -> Cmd err [(NodeId, NgramsId, Text, Int)]
getNgramsByDocDb cId lId = runPGSQuery query params
where
params = (cId, lId, listTypeId GraphTerm, ngramsTypeId NgramsTerms)
query = [sql|
-- TODO add CTE
SELECT n.id, ng.id, ng.terms, ng.n -- , list.parent_id
FROM nodes n
JOIN nodes_nodes nn ON nn.node2_id = n.id
JOIN nodes_ngrams nng ON nng.node_id = nn.node2_id
JOIN nodes_ngrams list ON list.ngrams_id = nng.ngrams_id
JOIN ngrams ng ON ng.id = nng.ngrams_id
WHERE nn.node1_id = ? -- CorpusId
AND list.node_id = ? -- ListId
AND list.list_type = ? -- GraphListId
AND list.ngrams_type = ? -- NgramsTypeId
|]
getNgramsByNode :: NodeId -> NgramsType -> Cmd err [[Text]]
......@@ -91,34 +59,16 @@ getNgramsByNode nId nt = elems
-- | TODO add join with nodeNodeNgram (if it exists)
getNgramsByNodeNodeIndexed :: NodeId -> NgramsType -> Cmd err [(NodeId, Text)]
getNgramsByNodeNodeIndexed nId nt = runOpaQuery (select' nId)
getNgramsByNodeNodeIndexed nId nt = runOpaQuery (select' nId nt)
where
select' nId' = proc () -> do
select' nId' nt' = proc () -> do
(ng,(nng,(nn,n))) <- getNgramsByNodeNodeIndexedJoin -< ()
restrict -< _node_id n .== toNullable (pgNodeId nId')
restrict -< nng_ngramsType nng .== toNullable (pgNgramsTypeId $ ngramsTypeId nt)
restrict -< nng_ngramsType nng .== toNullable (pgNgramsTypeId $ ngramsTypeId nt')
restrict -< nn_delete nn ./= (toNullable . pgBool) True
returnA -< (nng_node_id nng, ngrams_terms ng)
{-
getNgramsByNodeIndexed' :: NodeId -> NgramsType -> Cmd err [(NodeId, Maybe Text)]
getNgramsByNodeIndexed' nId nt = runOpaQuery (select' nId)
where
select' nId' = proc () -> do
(nnng,(ng,(nng,(_,n)))) <- getNgramsByNodeIndexedJoin5 -< ()
restrict -< _node_id n .== toNullable (pgNodeId nId')
restrict -< nng_ngramsType nng .== toNullable (pgNgramsTypeId $ ngramsTypeId nt)
let node_id' = ifThenElse (isNull $ toNullable $ nnng_node1_id nnng)
(nng_node_id nng)
(nnng_node2_id nng)
let t1 = ifThenElse (isNull $ toNullable $ nnng_node1_id nnng)
(ngrams_terms ng)
(nnng_terms nng)
returnA -< (n1, t1)
--}
getNgramsByNodeNodeIndexedJoin :: Query ( NgramsRead
, (NodeNgramReadNull
, (NodeNodeReadNull
......@@ -151,8 +101,8 @@ getNgramsByNodeNodeIndexedJoin = leftJoin4 queryNodeTable
) -> Column PGBool
c3 (ng,(nng',(_,_))) = (ngrams_id ng) .== nng_ngrams_id nng'
getNgramsByNodeNodeIndexedJoin5 :: Query ( NodeNodeNgramsRead
{-
getNgramsByNodeNodeIndexedJoin5 :: Query ( NodeNodesNgramsRead
, (NgramsReadNull
, (NodeNgramReadNull
, (NodeNodeReadNull
......@@ -252,4 +202,4 @@ countCorpusDocuments r cId = maybe 0 identity
(cId', nodeTypeId NodeDocument)
-}
src/Gargantext/Database/Metrics/NgramsByNode.hs
View file @ 98d4d099
......@@ -141,16 +141,16 @@ selectNgramsByNodeUser cId nt =
queryNgramsByNodeUser :: DPS.Query
queryNgramsByNodeUser = [sql|
SELECT nng.node_id, ng.terms FROM nodes_ngrams nng
SELECT nng.node2_id, ng.terms FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
JOIN nodes_nodes nn ON nn.node2_id = nng.node_id
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 nng.ngrams_type = ? -- NgramsTypeId
AND nn.delete = False
GROUP BY nng.node_id, ng.terms
ORDER BY (nng.node_id, ng.terms) DESC
GROUP BY nng.node2_id, ng.terms
ORDER BY (nng.node2_id, ng.terms) DESC
LIMIT ?
OFFSET ?
|]
......@@ -197,16 +197,16 @@ queryNgramsOccurrencesOnlyByNodeUser :: DPS.Query
queryNgramsOccurrencesOnlyByNodeUser = [sql|
WITH input_rows(terms) AS (?)
SELECT ng.terms, COUNT(nng.node_id) FROM nodes_ngrams nng
SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN nodes_nodes nn ON nn.node2_id = nng.node_id
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 nng.ngrams_type = ? -- NgramsTypeId
AND nn.delete = False
GROUP BY nng.node_id, ng.terms
GROUP BY nng.node2_id, ng.terms
|]
getNodesByNgramsOnlyUser :: CorpusId -> NgramsType -> [Text]
......@@ -231,16 +231,16 @@ queryNgramsOnlyByNodeUser :: DPS.Query
queryNgramsOnlyByNodeUser = [sql|
WITH input_rows(terms) AS (?)
SELECT ng.terms, nng.node_id FROM nodes_ngrams nng
SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN nodes_nodes nn ON nn.node2_id = nng.node_id
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 nng.ngrams_type = ? -- NgramsTypeId
AND nn.delete = False
GROUP BY nng.node_id, ng.terms
GROUP BY ng.terms, nng.node2_id
|]
------------------------------------------------------------------------
......@@ -272,6 +272,7 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
, ngramsTypeId NgramsTerms
)
-- | TODO fix node_node_ngrams relation
queryNgramsByNodeMaster' :: DPS.Query
queryNgramsByNodeMaster' = [sql|
......@@ -279,7 +280,7 @@ WITH nodesByNgramsUser AS (
SELECT n.id, ng.terms FROM nodes n
JOIN nodes_nodes nn ON n.id = nn.node2_id
JOIN nodes_ngrams nng ON nn.node2_id = n.id
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
......@@ -294,7 +295,7 @@ SELECT n.id, ng.terms FROM nodes n
nodesByNgramsMaster AS (
SELECT n.id, ng.terms FROM nodes n TABLESAMPLE SYSTEM_ROWS(?)
JOIN nodes_ngrams nng ON n.id = nng.node_id
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
......
src/Gargantext/Database/Ngrams.hs 0 → 100644
View file @ 98d4d099
{-|
Module : Gargantext.Database.Ngrams
Description : Deal with in Gargantext Database.
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Ngrams
where
import Data.Text (Text)
import Gargantext.Core.Types
import Gargantext.Database.Utils (runOpaQuery, Cmd)
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.NodeNodeNgrams
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Opaleye
import Control.Arrow (returnA)
selectNgramsByDoc :: [CorpusId] -> DocumentId -> NgramsType -> Cmd err [Text]
selectNgramsByDoc cIds dId nt = runOpaQuery (query cIds dId nt)
where
join :: Query (NgramsRead, NodeNodeNgramsReadNull)
join = leftJoin queryNgramsTable queryNodeNodeNgramsTable on1
where
on1 (ng,nnng) = ngrams_id ng .== nnng_ngrams_id nnng
query cIds' dId' nt' = proc () -> do
(ng,nnng) <- join -< ()
restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng_node1_id nnng) .|| b) (pgBool True) cIds'
restrict -< (toNullable $ pgNodeId dId') .== nnng_node2_id nnng
restrict -< (toNullable $ pgNgramsType nt') .== nnng_ngramsType nnng
returnA -< ngrams_terms ng
postNgrams :: CorpusId -> DocumentId -> [Text] -> Cmd err Int
postNgrams = undefined
src/Gargantext/Database/Node/Select.hs 0 → 100644
View file @ 98d4d099
{-|
Module : Gargantext.Database.Node.Select
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Gargantext.Database.Node.Select where
import Opaleye
import Gargantext.Core.Types
import Gargantext.Database.Schema.Node
import Gargantext.Database.Utils
import Gargantext.Database.Config
import Gargantext.Database.Schema.User
import Gargantext.Core.Types.Individu (Username)
import Control.Arrow (returnA)
--{-
selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
selectNodesWithUsername nt u = runOpaQuery (q u)
where
join :: Query (NodeRead, UserReadNull)
join = leftJoin queryNodeTable queryUserTable on1
where
on1 (n,us) = _node_userId n .== user_id us
q u' = proc () -> do
(n,usrs) <- join -< ()
restrict -< user_username usrs .== (toNullable $ pgStrictText u')
restrict -< _node_typename n .== (pgInt4 $ nodeTypeId nt)
returnA -< _node_id n
src/Gargantext/Database/Schema/Ngrams.hs
View file @ 98d4d099
This diff is collapsed.
src/Gargantext/Database/Schema/Node.hs
View file @ 98d4d099
......@@ -276,6 +276,8 @@ selectNode id = proc () -> do
restrict -< _node_id row .== id
returnA -< row
runGetNodes :: Query NodeRead -> Cmd err [NodeAny]
runGetNodes = runOpaQuery
......@@ -306,7 +308,6 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
returnA -< row ) -< ()
returnA -< node
deleteNode :: NodeId -> Cmd err Int
deleteNode n = mkCmd $ \conn ->
fromIntegral <$> runDelete conn nodeTable
......@@ -593,7 +594,6 @@ defaultList cId =
mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
mkList p u = insertNodesR [nodeListW Nothing Nothing p u]
mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
......
src/Gargantext/Database/Schema/NodeNgram.hs
View file @ 98d4d099
......@@ -116,6 +116,7 @@ nodeNgramTable = Table "nodes_ngrams"
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = queryTable nodeNgramTable
--{-
insertNodeNgrams :: [NodeNgram] -> Cmd err Int
insertNodeNgrams = insertNodeNgramW
. map (\(NodeNgram n g p ngt lt w) ->
......@@ -126,7 +127,6 @@ insertNodeNgrams = insertNodeNgramW
(pgInt4 lt)
(pgDouble w)
)
insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
insertNodeNgramW nns =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
......@@ -136,7 +136,7 @@ insertNodeNgramW nns =
, iReturning = rCount
, iOnConflict = (Just DoNothing)
})
--}
type NgramsText = Text
updateNodeNgrams' :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
......@@ -166,138 +166,3 @@ ON CONFLICT (node_id, ngrams_id, ngrams_type) DO
UPDATE SET list_type = excluded.list_type
;
|]
data Action = Del | Add
type NgramsParent = Text
type NgramsChild = Text
{-
ngramsGroup :: Action -> ListId -> [(NgramsTypeId, NgramsParent, NgramsChild)] -> Cmd err ()
ngramsGroup _ _ [] = pure ()
ngramsGroup a lid input = void $ trace (show input) $ execPGSQuery (ngramsGroupQuery a) (DPS.Only $ Values fields input')
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4","text","text"]
input' = map (\(ntpid,p,c) -> (lid, nodeTypeId NodeList, userMaster, ntpid, p,c)) input
-}
ngramsGroupQuery :: Action -> DPS.Query
ngramsGroupQuery a = case a of
Add -> [sql|
WITH input(lid,listTypeId,masterUsername,ntype,parent_terms,child_terms)
AS (?),
-- (VALUES (15::"int4",5::"int4",'gargantua'::"text",4::"int4",'input'::"text",'designer'::"text"))),
list_master AS (
SELECT n.id from nodes n
JOIN auth_user u ON n.user_id = u.id
JOIN input ON n.typename = input.listTypeId
WHERE u.username = input.masterUsername
LIMIT 1
),
list_user AS(
-- FIRST import parent from master to user list
INSERT INTO nodes_ngrams (node_id,ngrams_id,parent_id,ngrams_type,list_type,weight)
SELECT input.lid,nn.ngrams_id,nn.parent_id,nn.ngrams_type,nn.list_type, nn.weight
FROM INPUT
JOIN ngrams ng ON ng.terms = input.parent_terms
JOIN nodes_ngrams nn ON nn.ngrams_id = ng.id
JOIN list_master ON nn.node_id = list_master.id
WHERE
nn.ngrams_id = ng.id
ON CONFLICT (node_id,ngrams_id,ngrams_type) DO NOTHING
)
INSERT INTO nodes_ngrams (node_id,ngrams_id,parent_id,ngrams_type,list_type,weight)
SELECT input.lid, nc.id, nnpu.id, input.ntype, nnmaster.list_type, nnmaster.weight
FROM input
JOIN ngrams np ON np.terms = input.parent_terms
JOIN ngrams nc ON nc.terms = input.child_terms
JOIN nodes_ngrams nnpu ON nnpu.ngrams_id = np.id
JOIN nodes_ngrams nnmaster ON nnmaster.ngrams_id = nc.id
JOIN list_master ON nnmaster.node_id = list_master.id
WHERE
nnpu.node_id = input.lid
AND nnpu.ngrams_type = input.ntype
AND nnmaster.ngrams_id = nc.id
AND nnmaster.ngrams_type = ntype
ON CONFLICT (node_id,ngrams_id,ngrams_type) DO
UPDATE SET parent_id = excluded.parent_id
|]
Del -> [sql|
WITH input(lid,listTypeId,masterUsername,ntype,parent_terms,child_terms)
AS (?),
-- (VALUES (15::"int4",5::"int4",'gargantua'::"text",4::"int4",'input'::"text",'designer'::"text"))),
list_master AS (
SELECT n.id from nodes n
JOIN auth_user u ON n.user_id = u.id
JOIN input ON n.typename = input.listTypeId
WHERE u.username = input.masterUsername
LIMIT 1
),
list_user AS(
-- FIRST import parent from master to user list
INSERT INTO nodes_ngrams (node_id,ngrams_id,parent_id,ngrams_type,list_type,weight)
SELECT input.lid,nn.ngrams_id,nn.parent_id,nn.ngrams_type,nn.list_type, nn.weight
FROM INPUT
JOIN ngrams ng ON ng.terms = input.parent_terms
JOIN nodes_ngrams nn ON nn.ngrams_id = ng.id
JOIN list_master ON nn.node_id = list_master.id
WHERE
nn.ngrams_id = ng.id
ON CONFLICT (node_id,ngrams_id,ngrams_type) DO NOTHING
)
INSERT INTO nodes_ngrams (node_id,ngrams_id,parent_id,ngrams_type,list_type,weight)
SELECT input.lid, nc.id, NULL, input.ntype, nnmaster.list_type, nnmaster.weight
FROM input
JOIN ngrams np ON np.terms = input.parent_terms
JOIN ngrams nc ON nc.terms = input.child_terms
JOIN nodes_ngrams nnmaster ON nnmaster.ngrams_id = nc.id
JOIN list_master ON nnmaster.node_id = list_master.id
WHERE
nnmaster.ngrams_id = nc.id
AND nnmaster.ngrams_type = ntype
ON CONFLICT (node_id,ngrams_id,ngrams_type) DO
UPDATE SET parent_id = NULL
|]
data NodeNgramsUpdate = NodeNgramsUpdate
{ _nnu_user_list_id :: ListId
, _nnu_lists_update :: [(NgramsTypeId, NgramsText, ListTypeId)]
, _nnu_add_children :: [(NgramsTypeId, NgramsParent, NgramsChild)]
, _nnu_rem_children :: [(NgramsTypeId, NgramsParent, NgramsChild)]
}
-- TODO wrap these updates in a transaction.
-- TODO-ACCESS:
-- * check userId CanUpdateNgrams userListId
{-
updateNodeNgrams :: NodeNgramsUpdate -> Cmd err ()
updateNodeNgrams nnu = do
updateNodeNgrams' userListId $ _nnu_lists_update nnu
ngramsGroup Del userListId $ _nnu_rem_children nnu
ngramsGroup Add userListId $ _nnu_add_children nnu
-- TODO remove duplicate line (fix SQL query)
ngramsGroup Add userListId $ _nnu_add_children nnu
where
userListId = _nnu_user_list_id nnu
-}
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
View file @ 98d4d099
......@@ -9,14 +9,15 @@ Portability : POSIX
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.NodeNodeNgrams
where
......@@ -24,61 +25,92 @@ module Gargantext.Database.Schema.NodeNodeNgrams
import Prelude
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Gargantext.Database.Utils (Cmd, runOpaQuery)
--import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import Gargantext.Database.Utils (Cmd, mkCmd)
import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId)
import Gargantext.Database.Schema.Node (pgNodeId)
import Gargantext.Database.Types.Node
import Opaleye
data NodeNodeNgramsPoly node1_id node2_id ngram_id score
= NodeNodeNgrams { nnng_node1_id :: node1_id
, nnng_node2_id :: node2_id
, nnng_ngrams_id :: ngram_id
, nnng_score :: score
} deriving (Show)
type NodeNodeNgramsWrite = NodeNodeNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type NodeNodeNgramsRead = NodeNodeNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramsReadNull = NodeNodeNgramsPoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgrams = NodeNodeNgramsPoly Int
Int
Int
(Maybe Double)
data NodeNodeNgramsPoly id' n1 n2 ngrams_id ngt w
= NodeNodeNgrams { nnng_id :: id'
, nnng_node1_id :: n1
, nnng_node2_id :: n2
, nnng_ngrams_id :: ngrams_id
, nnng_ngramsType :: ngt
, nnng_weight :: w
} deriving (Show)
type NodeNodeNgramsWrite =
NodeNodeNgramsPoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramsRead =
NodeNodeNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramsReadNull =
NodeNodeNgramsPoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgrams =
NodeNodeNgramsPoly (Maybe Int) CorpusId DocId NgramsId NgramsTypeId Double
--{-
$(makeAdaptorAndInstance "pNodeNodeNgrams" ''NodeNodeNgramsPoly)
$(makeLensesWith abbreviatedFields ''NodeNodeNgramsPoly)
-- $(makeLensesWith abbreviatedFields ''NodeNodeNgramsPoly)
nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
nodeNodeNgramsTable = Table "nodes_nodes_ngrams"
nodeNodeNgramsTable = Table "node_node_ngrams"
( pNodeNodeNgrams NodeNodeNgrams
{ nnng_node1_id = required "node1_id"
, nnng_node2_id = required "node2_id"
, nnng_ngrams_id = required "ngram_id"
, nnng_score = optional "score"
{ nnng_id = optional "id"
, nnng_node1_id = required "node1_id"
, nnng_node2_id = required "node2_id"
, nnng_ngrams_id = required "ngrams_id"
, nnng_ngramsType = required "ngrams_type"
, nnng_weight = required "weight"
}
)
queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
-- | not optimized (get all ngrams without filters)
nodeNodeNgrams :: Cmd err [NodeNodeNgrams]
nodeNodeNgrams = runOpaQuery queryNodeNodeNgramsTable
instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
-- | Insert utils
insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
insertNodeNodeNgrams = insertNodeNodeNgramsW
. map (\(NodeNodeNgrams id'' n1 n2 ng nt w) ->
NodeNodeNgrams (pgInt4 <$> id'')
(pgNodeId n1)
(pgNodeId n2)
(pgInt4 ng)
(pgNgramsTypeId nt)
(pgDouble w)
)
insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> Cmd err Int
insertNodeNodeNgramsW nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
insertNothing = (Insert { iTable = nodeNodeNgramsTable
, iRows = nnnw
, iReturning = rCount
, iOnConflict = (Just DoNothing)
})
src/Gargantext/Database/Schema/User.hs
View file @ 98d4d099
......@@ -43,7 +43,6 @@ import Opaleye
------------------------------------------------------------------------
type UserId = Int
data UserLight = UserLight { userLight_id :: Int
, userLight_username :: Text
, userLight_email :: Text
......@@ -83,6 +82,16 @@ type UserRead = UserPoly (Column PGInt4) (Column PGText)
(Column PGBool) (Column PGBool)
(Column PGTimestamptz)
type UserReadNull = UserPoly (Column (Nullable PGInt4)) (Column (Nullable PGText))
(Column (Nullable PGTimestamptz)) (Column (Nullable PGBool))
(Column (Nullable PGText)) (Column (Nullable PGText))
(Column (Nullable PGText)) (Column (Nullable PGText))
(Column (Nullable PGBool)) (Column (Nullable PGBool))
(Column (Nullable PGTimestamptz))
type User = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
$(makeAdaptorAndInstance "pUser" ''UserPoly)
......
src/Gargantext/Database/Schema/schema.sql
View file @ 98d4d099
......@@ -49,36 +49,26 @@ CREATE TABLE public.ngrams (
);
ALTER TABLE public.ngrams OWNER TO gargantua;
--------------------------------------------------------------
--------------------------------------------------------------
-- TODO: delete delete this table
CREATE TABLE public.nodes_ngrams (
id SERIAL,
node_id integer NOT NULL,
ngrams_id integer NOT NULL,
parent_id integer REFERENCES public.nodes_ngrams(id) ON DELETE SET NULL,
ngrams_type integer,
list_type integer,
weight double precision,
FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE,
PRIMARY KEY (id)
-- PRIMARY KEY (node_id,ngrams_id)
);
ALTER TABLE public.nodes_ngrams OWNER TO gargantua;
--CREATE TABLE public.nodes_ngrams (
-- id SERIAL,
-- node_id integer NOT NULL,
-- ngrams_id integer NOT NULL,
-- parent_id integer REFERENCES public.nodes_ngrams(id) ON DELETE SET NULL,
-- ngrams_type integer,
-- list_type integer,
-- weight double precision,
-- FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
-- FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE,
-- PRIMARY KEY (id)
--);
--ALTER TABLE public.nodes_ngrams OWNER TO gargantua;
--------------------------------------------------------------
CREATE TABLE public.nodes_ngrams_repo (
version integer NOT NULL,
patches jsonb DEFAULT '{}'::jsonb NOT NULL,
PRIMARY KEY (version)
);
ALTER TABLE public.nodes_ngrams_repo OWNER TO gargantua;
--------------------------------------------------------------
--
--
-- TODO: delete delete this table
--CREATE TABLE public.nodes_ngrams_ngrams (
-- node_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
-- ngram1_id integer NOT NULL REFERENCES public.ngrams(id) ON DELETE CASCADE,
......@@ -89,16 +79,38 @@ ALTER TABLE public.nodes_ngrams_repo OWNER TO gargantua;
--
--ALTER TABLE public.nodes_ngrams_ngrams OWNER TO gargantua;
---------------------------------------------------------
---------------------------------------------------------------
CREATE TABLE public.nodes_nodes (
node1_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
node2_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
score real,
favorite boolean,
delete boolean,
PRIMARY KEY (node1_id, node2_id)
PRIMARY KEY (node1_id,node2_id)
);
ALTER TABLE public.nodes_nodes OWNER TO gargantua;
---------------------------------------------------------------
-- TODO should reference "id" of nodes_nodes (instead of node1_id, node2_id)
CREATE TABLE public.node_node_ngrams (
id SERIAL,
node1_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
node2_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
ngrams_id INTEGER NOT NULL REFERENCES public.ngrams (id) ON DELETE CASCADE,
ngrams_type INTEGER,
weight double precision,
PRIMARY KEY (id)
);
ALTER TABLE public.node_node_ngrams OWNER TO gargantua;
--------------------------------------------------------------
--CREATE TABLE public.nodes_ngrams_repo (
-- version integer NOT NULL,
-- patches jsonb DEFAULT '{}'::jsonb NOT NULL,
-- PRIMARY KEY (version)
--);
--ALTER TABLE public.nodes_ngrams_repo OWNER TO gargantua;
---------------------------------------------------------
-- If needed for rights management at row level
......@@ -113,7 +125,6 @@ CREATE TABLE public.rights (
ALTER TABLE public.rights OWNER TO gargantua;
------------------------------------------------------------
-- INDEXES
......@@ -130,14 +141,10 @@ CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdat
CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN
CREATE INDEX ON public.nodes_ngrams USING btree (ngrams_id);
CREATE UNIQUE INDEX ON public.nodes_ngrams USING btree (node_id,ngrams_id);
CREATE UNIQUE INDEX ON public.nodes_ngrams USING btree (node_id,ngrams_id,ngrams_type);
CREATE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id, delete);
CREATE UNIQUE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id);
--CREATE INDEX ON public.nodes_nodes_ngrams USING btree (node1_id,nod2_id);
CREATE UNIQUE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id, ngrams_id, ngrams_type);
-- TRIGGERS
-- TODO user haskell-postgresql-simple to create this function
......
src/Gargantext/Database/TextSearch.hs
View file @ 98d4d099
......@@ -129,23 +129,6 @@ joinInCorpusWithContacts = leftJoin6 queryNodeTable queryNodeNgramTable queryNgr
cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nn_node2_id nn
{-
queryGraphCorpusAuthors' :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgramReadNull, NgramsReadNull)))
queryGraphCorpusAuthors' = leftJoin4 queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34
where
cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
cond23 (ng2, (nng2, _)) = nodeNgram_ngrams_id nng2 .== ngrams_id ng2
cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nodeNgram_ngrams_id nng
cond45 :: (NodeNodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
cond45 (nn, (nng, (_,(_,_)))) = nodeNgram_node_id nng .== nodeNode_node2_id nn
cond56 :: (NodeSearchRead, (NodeNodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))) -> Column PGBool
cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nodeNode_node2_id nn
-}
newtype TSQuery = UnsafeTSQuery [Text]
......
src/Gargantext/Text.hs
View file @ 98d4d099
......@@ -18,16 +18,11 @@ Text gathers terms in unit of contexts.
module Gargantext.Text
where
import Data.Functor
import Data.Traversable (Traversable)
import Data.Text (Text, split)
import Gargantext.Prelude hiding (filter)
import NLP.FullStop (segment)
import qualified Data.Text as DT
import NLP.FullStop (segment)
-----------------------------------------------------------------
import Gargantext.Core
import Gargantext.Prelude hiding (filter)
-----------------------------------------------------------------
-- | Why not use data ?
data Niveau = NiveauTexte Texte
......@@ -92,10 +87,11 @@ instance Collage MultiTerme Mot where
-- | We could use Type Classes but we lose the Sum Type classification
toMultiTerme :: Niveau -> [MultiTerme]
toMultiTerme (NiveauTexte (Texte t)) = undefined
toMultiTerme (NiveauTexte (Texte _t)) = undefined
toMultiTerme (NiveauPhrase p) = dec p
toMultiTerme (NiveauMultiTerme mt) = [mt]
toMultiTerme (NiveauMot m) = undefined
toMultiTerme (NiveauMot _m) = undefined
toMultiTerme _ = undefined
-------------------------------------------------------------------
-- Contexts of text
......
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