[refactor] more refactoring and cleanup of imports

parent ec216edf
Pipeline #5633 canceled with stages
in 2 minutes and 35 seconds
......@@ -356,7 +356,6 @@ library
Gargantext.Database.Action.Metrics.TFICF
Gargantext.Database.Action.Node
Gargantext.Database.Action.Share
Gargantext.Database.Action.TSQuery
Gargantext.Database.Admin.Access
Gargantext.Database.Admin.Bashql
Gargantext.Database.Admin.Trigger.ContextNodeNgrams
......
......@@ -26,19 +26,14 @@ import Conduit
import Data.Aeson
import Data.Either (Either(Right))
import Data.Maybe (Maybe(..))
import Data.Swagger
import Data.Text (Text)
import Data.Swagger (ToSchema)
import GHC.Generics (Generic)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types
import Gargantext.API.Node
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Node (NodeNodeAPI, nodeNodeAPI)
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms (TermType(..))
......@@ -47,10 +42,13 @@ import Gargantext.Database.Action.Flow (flow)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), {-printDebug,-})
import Gargantext.Database.Admin.Types.Node (CorpusId, NodeId)
import Gargantext.Prelude (($), Proxy(..), Text)
import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import qualified Gargantext.Utils.Aeson as GUA
import Servant ((:>), (:<|>)(..), Capture, JSON, ServerT, Summary)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint"
......
......@@ -17,22 +17,22 @@ module Gargantext.API.Node.Share
import Data.Aeson
import Data.List qualified as List
import Data.Swagger
import Data.Swagger (ToSchema)
import Data.Text qualified as Text
import Gargantext.API.Prelude
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
import Gargantext.Database.Action.Share (ShareNodeWith(..))
import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
import Gargantext.Database.Action.User
import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Action.User (getUserId', getUsername)
import Gargantext.Database.Action.User.New (guessUserName, newUser)
import Gargantext.Database.Admin.Types.Node (NodeId(UnsafeMkNodeId), NodeType(..), UserId(UnsafeMkUserId))
import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (findNodesWithType)
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Servant
import Servant ((:>), Capture, JSON, Post, Put, ReqBody, Summary)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
......
......@@ -23,7 +23,6 @@ please follow the types.
module Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), clean, parseFile, cleanText, parseFormatC, splitOn, etale)
where
-- import Gargantext.Core.Text.Learn (detectLangDefault)
import "zip" Codec.Archive.Zip (EntrySelector, withArchive, getEntry, getEntries, unEntrySelector)
import Conduit
import Control.Concurrent.Async as CCA (mapConcurrently)
......
......@@ -12,23 +12,21 @@ CSV parser for Gargantext corpus files.
-}
module Gargantext.Core.Text.Corpus.Parsers.CSV where
module Gargantext.Core.Text.Corpus.Parsers.CSV
where
import Conduit
import Control.Applicative
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Csv
import Data.Text (pack)
import Data.Csv (DecodeOptions(..), EncodeOptions(..), FromField, FromNamedRecord(..), Header, Parser, ToField(..), ToNamedRecord(..), (.:), (.=), decodeByNameWith, defaultDecodeOptions, defaultEncodeOptions, encodeByNameWith, header, namedRecord, parseField, parseNamedRecord, runParser)
import Data.Text qualified as T
import Data.Time.Segment (jour)
import Data.Vector (Vector)
import Data.Vector qualified as V
import Gargantext.Core.Text
import Gargantext.Core.Text.Context
import Gargantext.Core.Text (sentences, unsentences)
import Gargantext.Core.Text.Context (SplitContext(..), splitBy)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Gargantext.Prelude hiding (length, show)
import Protolude
import Gargantext.Prelude
---------------------------------------------------------------
headerCsvGargV3 :: Header
......@@ -58,7 +56,7 @@ data CsvGargV3 = CsvGargV3
toDoc :: CsvGargV3 -> HyperdataDocument
toDoc (CsvGargV3 did dt _ dpy dpm dpd dab dau) =
HyperdataDocument { _hd_bdd = Just "CSV"
, _hd_doi = Just . pack . show $ did
, _hd_doi = Just . T.pack . show $ did
, _hd_url = Nothing
, _hd_uniqId = Nothing
, _hd_uniqIdBdd = Nothing
......@@ -246,7 +244,7 @@ readByteStringLazy :: (FromNamedRecord a)
-> Delimiter
-> BL.ByteString
-> Either Text (Header, Vector a)
readByteStringLazy _f d bs = first pack $ decodeByNameWith (csvDecodeOptions d) bs
readByteStringLazy _f d bs = first T.pack $ decodeByNameWith (csvDecodeOptions d) bs
readByteStringStrict :: (FromNamedRecord a)
=> proxy a
......@@ -270,7 +268,7 @@ readCSVFile fp = do
readCsvLazyBS :: Delimiter
-> BL.ByteString
-> Either Text (Header, Vector CsvDoc)
readCsvLazyBS d bs = first pack $ decodeByNameWith (csvDecodeOptions d) bs
readCsvLazyBS d bs = first T.pack $ decodeByNameWith (csvDecodeOptions d) bs
------------------------------------------------------------------------
-- | TODO use readFileLazy
......@@ -281,7 +279,7 @@ readCsvHal fp = do
-- | TODO use readByteStringLazy
readCsvHalLazyBS :: BL.ByteString -> Either Text (Header, Vector CsvHal)
readCsvHalLazyBS bs = first pack $ decodeByNameWith (csvDecodeOptions Tab) bs
readCsvHalLazyBS bs = first T.pack $ decodeByNameWith (csvDecodeOptions Tab) bs
readCsvHalBSStrict :: BS.ByteString -> Either Text (Header, Vector CsvHal)
readCsvHalBSStrict bs = readCsvHalLazyBS $ BL.fromStrict bs
......@@ -390,7 +388,7 @@ csvHal2doc (CsvHal { .. }) =
, _hd_institutes = Just csvHal_instStructId_i
, _hd_source = Just csvHal_source
, _hd_abstract = Just csvHal_abstract
, _hd_publication_date = Just $ pack . show $ jour csvHal_publication_year
, _hd_publication_date = Just $ T.pack . show $ jour csvHal_publication_year
csvHal_publication_month
csvHal_publication_day
, _hd_publication_year = Just $ fromIntegral csvHal_publication_year
......@@ -415,7 +413,7 @@ csv2doc (CsvDoc { .. })
, _hd_institutes = Nothing
, _hd_source = Just csv_source
, _hd_abstract = Just csv_abstract
, _hd_publication_date = Just $ pack . show $ jour (fromIntegral pubYear)
, _hd_publication_date = Just $ T.pack . show $ jour (fromIntegral pubYear)
pubMonth
pubDay
, _hd_publication_year = Just pubYear
......@@ -496,6 +494,6 @@ readWeightedCsv :: FilePath -> IO (Header, Vector Csv')
readWeightedCsv fp =
fmap (\bs ->
case decodeByNameWith (csvDecodeOptions Tab) bs of
Left e -> panicTrace (pack e)
Left e -> panicTrace (T.pack e)
Right corpus -> corpus
) $ BL.readFile fp
{-|
Module : Gargantext.Core.Text.Corpus.Query
Description : Query parsing functionality
Copyright : (c) CNRS, 2017 - present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingStrategies #-}
module Gargantext.Core.Text.Corpus.Query (
......@@ -16,21 +27,22 @@ module Gargantext.Core.Text.Corpus.Query (
, unsafeMkQuery
) where
import Data.Bifunctor
import Data.String
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.Core.Types
import Prelude
import Text.ParserCombinators.Parsec
import Test.QuickCheck
import qualified Data.Aeson as Aeson
import Data.BoolExpr as BoolExpr
import Data.BoolExpr.Parser as BoolExpr
import Data.BoolExpr.Printer as BoolExpr
import qualified Data.Swagger as Swagger
import qualified Data.Text as T
import qualified Servant.API as Servant
import qualified Text.Parsec as P
import Data.Aeson qualified as Aeson
import Data.BoolExpr (BoolExpr(..), Signed(..))
import Data.BoolExpr qualified as BoolExpr
import Data.BoolExpr.Parser qualified as BoolExpr
import Data.BoolExpr.Printer qualified as BoolExpr
import Data.String
import Data.Swagger qualified as Swagger
import Data.Text qualified as T
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.Core.Types
import Gargantext.Prelude hiding ((<|>), try)
import Servant.API qualified as Servant
import Test.QuickCheck
import Text.Parsec qualified as P
import Text.ParserCombinators.Parsec
import Text.Show (showsPrec)
-- | A raw query, as typed by the user from the frontend.
newtype RawQuery = RawQuery { getRawQuery :: T.Text }
......
......@@ -40,10 +40,21 @@ Notes for current implementation:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.Core.Text.Terms.Eleve where
module Gargantext.Core.Text.Terms.Eleve
( Token
, Tries
-- import Debug.Trace (trace)
-- import Debug.SimpleReflect
, buildTries
, mainEleveWith
, toToken
-- tests
, runTestsEleve
-- debug
, mainEleve
, mainEleve'' )
where
import Control.Lens hiding (levels, children)
import Data.List qualified as L
......@@ -55,22 +66,23 @@ import Data.Tree qualified as Tree
import Gargantext.Prelude hiding (cs)
import Prelude qualified as P
nan :: Floating e => e
nan = 0 / 0
noNaNs :: P.RealFloat e => [e] -> [e]
noNaNs = filter (not . P.isNaN)
updateIfDefined :: P.RealFloat e => e -> e -> e
updateIfDefined e0 e | P.isNaN e = e0
| otherwise = e
-- updateIfDefined :: P.RealFloat e => e -> e -> e
-- updateIfDefined e0 e | P.isNaN e = e0
-- | otherwise = e
sim :: Entropy e => e -> e -> Bool
sim x y = x == y || (P.isNaN x && P.isNaN y)
subst :: Entropy e => (e, e) -> e -> e
subst (src, dst) x | sim src x = dst
| otherwise = x
-- subst :: Entropy e => (e, e) -> e -> e
-- subst (src, dst) x | sim src x = dst
-- | otherwise = x
------------------------------------------------------------------------
-- | TODO: Show Instance only used for debugging
......@@ -139,7 +151,7 @@ data Trie k e
| Leaf { _node_count :: Int }
deriving (Show)
makeLenses ''Trie
-- makeLenses ''Trie
insertTrie :: Ord k => [k] -> Trie k () -> Trie k ()
insertTrie [] n = n { _node_count = _node_count n +1}
......@@ -278,7 +290,7 @@ data Tries k e = Tries
, _bwd :: Trie k e
}
makeLenses ''Tries
-- makeLenses ''Tries
deriving instance (Show k, Show e) => Show (Tries k e)
......
......@@ -15,7 +15,9 @@ Portability : POSIX
{-# LANGUAGE InstanceSigs #-}
module Gargantext.Database.Action.Flow.List
where
( flowList_DbRepo
, toNodeNgramsW' )
where
import Control.Lens ((^.), (+~), (%~), at, (.~))
import Control.Monad.Reader
......
......@@ -11,12 +11,13 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Action.Flow.Pairing
-- (pairing)
where
( isPairedWith
, pairing )
where
import Control.Lens (_Just, (^.), view)
import Data.HashMap.Strict (HashMap)
......@@ -25,30 +26,30 @@ import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Set qualified as Set
import Data.Text qualified as Text
import Gargantext.API.Ngrams.Tools
import Gargantext.API.Ngrams.Tools (filterListWithRoot, getRepo, groupNodesByNgrams, mapTermListRoot)
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core
import Gargantext.Core (toDBid)
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Metrics.CharByChar (levenshtein)
import Gargantext.Core.Types (TableResult(..))
import Gargantext.Core.Types.Main
import Gargantext.Database
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata -- (HyperdataContact(..))
import Gargantext.Database.Admin.Types.Node -- (AnnuaireId, CorpusId, ListId, DocId, ContactId, NodeId)
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), cw_firstName, cw_lastName, hc_who)
import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, DocId, ContactId, Node, NodeId, NodeType(NodeList), contextId2NodeId, pgNodeId)
import Gargantext.Database.Prelude (Cmd, DBCmd, runOpaQuery)
import Gargantext.Database.Query.Prelude (returnA, queryNodeNodeTable)
import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Database.Query.Table.NodeContext_NodeContext (insertNodeContext_NodeContext)
import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (sum)
import Opaleye
import Gargantext.Database.Query.Table.NodeNode (NodeNodePoly(..), insertNodeNode, nn_node1_id, nn_node2_id)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Schema.Node (node_hyperdata, node_id, node_typename, queryNodeTable)
import Gargantext.Prelude
import Opaleye ((.==), (.===), Column, Select, SqlInt4, justFields, optionalRestrict, restrict, sqlInt4)
-- | isPairedWith
-- All NodeAnnuaire paired with a Corpus of NodeId nId:
......@@ -107,7 +108,6 @@ prepareInsert corpusId annuaireId mapContactDocs =
------------------------------------------------------------------------
type ContactName = NgramsTerm
type DocAuthor = NgramsTerm
type Projected = NgramsTerm
fusion :: HashMap ContactName (Set ContactId)
-> HashMap DocAuthor (Set DocId)
......@@ -124,35 +124,6 @@ fusion mc md = HM.fromListWith (<>)
)
$ HM.toList md
fusion'' :: HashMap ContactName (Set ContactId)
-> HashMap DocAuthor (Set DocId)
-> HashMap ContactId (Set DocId)
fusion'' mc md = hashmapReverse $ fusion' mc (hashmapReverse md)
fusion' :: HashMap ContactName (Set ContactId)
-> HashMap DocId (Set DocAuthor)
-> HashMap DocId (Set ContactId)
fusion' mc md = HM.fromListWith (<>)
$ map (\(docId, setAuthors) -> (docId, getContactIds mc $ getClosest' setAuthors (HM.keys mc)))
$ HM.toList md
getContactIds :: HashMap ContactName (Set ContactId) -> Set ContactName -> Set ContactId
getContactIds mapContactNames contactNames =
if Set.null contactNames
then Set.empty
else Set.unions $ catMaybes $ map (\contactName -> HM.lookup contactName mapContactNames) $ Set.toList contactNames
getClosest' :: Set DocAuthor -> [ContactName] -> Set ContactName
getClosest' setAuthors contactNames = trace (show (setAuthors, setContactNames) :: Text) $ setContactNames
where
setContactNames = if Set.null xs then ys else xs
xs = Set.fromList $ catMaybes $ map (\author -> getClosest Text.toLower author contactNames) $ Set.toList setAuthors
ys = Set.fromList $ catMaybes $ map (\(NgramsTerm author) -> case ((lastMay . (Text.splitOn " ")) author) of
Nothing -> Nothing
Just authorReduced -> getClosest Text.toLower (NgramsTerm authorReduced) contactNames)
$ Set.toList setAuthors
getClosest :: (Text -> Text) -> NgramsTerm -> [NgramsTerm] -> Maybe NgramsTerm
getClosest f (NgramsTerm from') candidates = fst <$> head scored
......@@ -195,9 +166,46 @@ getNgramsDocId cId lId nt = do
-- FIXME(adinapoli) we should audit this, we are converting from 'ContextId' to 'NodeId'.
HM.map (Set.map contextId2NodeId) . groupNodesByNgrams ngs <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
hashmapReverse :: (Ord a, Eq b, Hashable b)
=> HashMap a (Set b) -> HashMap b (Set a)
hashmapReverse m = HM.fromListWith (<>)
$ List.concat
$ map (\(k,vs) -> [ (v, Set.singleton k) | v <- Set.toList vs])
$ HM.toList m
---------------------------------
-- Unused functions
-- type Projected = NgramsTerm
-- fusion' :: HashMap ContactName (Set ContactId)
-- -> HashMap DocId (Set DocAuthor)
-- -> HashMap DocId (Set ContactId)
-- fusion' mc md = HM.fromListWith (<>)
-- $ map (\(docId, setAuthors) -> (docId, getContactIds mc $ getClosest' setAuthors (HM.keys mc)))
-- $ HM.toList md
-- fusion'' :: HashMap ContactName (Set ContactId)
-- -> HashMap DocAuthor (Set DocId)
-- -> HashMap ContactId (Set DocId)
-- fusion'' mc md = hashmapReverse $ fusion' mc (hashmapReverse md)
-- hashmapReverse :: (Ord a, Eq b, Hashable b)
-- => HashMap a (Set b) -> HashMap b (Set a)
-- hashmapReverse m = HM.fromListWith (<>)
-- $ List.concat
-- $ map (\(k,vs) -> [ (v, Set.singleton k) | v <- Set.toList vs])
-- $ HM.toList m
-- getContactIds :: HashMap ContactName (Set ContactId) -> Set ContactName -> Set ContactId
-- getContactIds mapContactNames contactNames =
-- if Set.null contactNames
-- then Set.empty
-- else Set.unions $ catMaybes $ map (\contactName -> HM.lookup contactName mapContactNames) $ Set.toList contactNames
-- getClosest' :: Set DocAuthor -> [ContactName] -> Set ContactName
-- getClosest' setAuthors contactNames = trace (show (setAuthors, setContactNames) :: Text) $ setContactNames
-- where
-- setContactNames = if Set.null xs then ys else xs
-- xs = Set.fromList $ catMaybes $ map (\author -> getClosest Text.toLower author contactNames) $ Set.toList setAuthors
-- ys = Set.fromList $ catMaybes $ map (\(NgramsTerm author) -> case ((lastMay . (Text.splitOn " ")) author) of
-- Nothing -> Nothing
-- Just authorReduced -> getClosest Text.toLower (NgramsTerm authorReduced) contactNames)
-- $ Set.toList setAuthors
......@@ -9,25 +9,29 @@ Portability : POSIX
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Action.Learn
where
( FavOrTrash(..)
, moreLike )
where
import Control.Lens ((^.))
import Data.List qualified as List
import Data.Maybe
import Data.Text qualified as Text
import Gargantext.Core
import Gargantext.Core.Text.Learn
import Gargantext.Core (HasDBid)
import Gargantext.Core.Text.Learn (Events, detectDefaultWithPriors, priorEventsWith)
import Gargantext.Core.Types.Query (Offset, Limit(..))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Types.Hyperdata (hd_abstract, hd_title)
import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Facet
import Gargantext.Database.Query.Facet (Facet(..), FacetDoc, OrderBy, runViewDocuments)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Prelude
data FavOrTrash = IsFav | IsTrash
deriving (Eq)
......@@ -40,6 +44,8 @@ moreLike cId o _l order ft = do
moreLikeWith cId o (Just 3) order ft priors
---------------------------------------------------------------------------
-- Helper functions
getPriors :: (HasDBid NodeType, HasNodeError err)
=> FavOrTrash -> CorpusId -> DBCmd err (Events Bool)
getPriors ft cId = do
......@@ -79,8 +85,8 @@ fav2bool ft = if (==) ft IsFav then True else False
text :: FacetDoc -> Text
text (FacetDoc _ _ _ h _ _ _) = title <> "" <> Text.take 100 abstr
where
title = maybe "" identity (_hd_title h)
abstr = maybe "" identity (_hd_abstract h)
title = maybe "" identity (h ^. hd_title)
abstr = maybe "" identity (h ^. hd_abstract)
---------------------------------------------------------------------------
......
......@@ -14,27 +14,32 @@ Portability : POSIX
{-# LANGUAGE ViewPatterns #-}
module Gargantext.Database.Action.Share
where
( ShareNodeWith(..)
, delFolderTeam
, deleteMemberShip
, membersOf
, shareNodeWith
, unPublish )
where
import Control.Arrow (returnA)
import Control.Lens (view, (^.))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database
import Gargantext.Database (insertDB)
import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Types.Node (_NodeId, NodeId, NodeType(..), ParentId)
import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode, queryNodeNodeTable)
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Table.NodeNode (NodeNode, NodeNodePoly(..), NodeNodeRead, deleteNodeNode, nn_node1_id, nn_node2_id, queryNodeNodeTable)
import Gargantext.Database.Query.Table.User (UserRead, queryUserTable, user_id, user_username)
import Gargantext.Database.Query.Tree.Root (getRootId)
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Node (NodeRead, node_id, node_user_id, queryNodeTable)
import Gargantext.Prelude
import Gargantext.Utils.Tuple (uncurryMaybe)
import Opaleye hiding (not)
import Opaleye qualified as O
import Opaleye ((.==), (.===), Field, MaybeFields, Select, SelectArr, SqlInt4, SqlText, justFields, optionalRestrict, restrict, sqlInt4)
-- | TODO move in PhyloConfig of Gargantext
publicNodeTypes :: [NodeType]
......@@ -75,9 +80,9 @@ membersOfQuery (_NodeId -> teamId) = proc () -> do
, view node_id <$> n )
nodeNode_node_User :: O.Select ( NodeNodeRead
, MaybeFields NodeRead
, MaybeFields UserRead )
nodeNode_node_User :: Select ( NodeNodeRead
, MaybeFields NodeRead
, MaybeFields UserRead )
nodeNode_node_User = proc () -> do
nn <- queryNodeNodeTable -< ()
n <- optionalRestrict queryNodeTable -<
......@@ -132,7 +137,7 @@ getFolderId u nt = do
s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
case head s of
Nothing -> errorWith "[G.D.A.S.getFolderId] No folder shared found"
Just f -> pure (_node_id f)
Just f -> pure (f ^. node_id)
------------------------------------------------------------------------
type TeamId = NodeId
......
{-|
Module : Gargantext.Database.Action.TSQuery
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
module Gargantext.Database.Action.TSQuery where
import Data.Aeson
import Data.Maybe
import Data.String (IsString(..))
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Prelude
newtype TSQuery = UnsafeTSQuery [Text]
-- | TODO [""] -> panic "error"
toTSQuery :: [Text] -> TSQuery
toTSQuery txt = UnsafeTSQuery $ map stemIt txt
instance IsString TSQuery
where
fromString = UnsafeTSQuery . words . cs
instance ToField TSQuery
where
toField (UnsafeTSQuery xs)
= Many $ intersperse (Plain " && ")
$ map (\q -> Many [ Plain "plainto_tsquery("
, Escape (cs q)
, Plain ")"
]
) xs
data Order = Asc | Desc
instance ToField Order
where
toField Asc = Plain "ASC"
toField Desc = Plain "DESC"
-- TODO
-- FIX fav
-- ADD ngrams count
-- TESTS
textSearchQuery :: Query
textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
\ , n.hyperdata->'title' \
\ , n.hyperdata->'source' \
\ , n.hyperdata->'authors' \
\ , COALESCE(nn.score,null) \
\ FROM nodes n \
\ LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id \
\ WHERE \
\ n.search @@ (?::tsquery) \
\ AND (n.parent_id = ? OR nn.node1_id = ?) \
\ AND n.typename = ? \
\ ORDER BY n.hyperdata -> 'publication_date' ? \
\ offset ? limit ?;"
-- | Text Search Function for Master Corpus
-- TODO : text search for user corpus
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch :: HasDBid NodeType
=> TSQuery -> ParentId
-> Limit -> Offset -> Order
-> DBCmd 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 = toDBid NodeDocument
......@@ -11,15 +11,20 @@ Portability : POSIX
module Gargantext.Database.Action.User
where
( getUserId
, getUserId'
, getUserLightDB
, getUsername )
where
import Control.Lens ((^.))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Admin.Types.Node (UserId)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Node
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(NodeLookupFailed), NodeLookupError(UserDoesNotExist, UserNameDoesNotExist), errorWith, nodeError)
import Gargantext.Database.Query.Table.User (UserLight, getUser, getUsersWithId, userLight_id, userLight_username)
import Gargantext.Database.Schema.Node (node_user_id)
import Gargantext.Prelude
------------------------------------------------------------------------
......@@ -52,7 +57,7 @@ getUserId' :: HasNodeError err
getUserId' (UserDBId uid) = pure (Right uid)
getUserId' (RootId rid) = do
n <- getNode rid
pure $ Right $ _node_user_id n
pure $ Right $ n ^. node_user_id
getUserId' (UserName u ) = do
muser <- getUser u
case muser of
......@@ -75,7 +80,7 @@ getUsername user@(UserDBId _) = do
Nothing -> errorWith "G.D.A.U.getUserName: User not found with that id"
getUsername (RootId rid) = do
n <- getNode rid
getUsername (UserDBId $ _node_user_id n)
getUsername (UserDBId $ n ^. node_user_id)
--------------------------------------------------------------------------
-- getRootId is in Gargantext.Database.Query.Tree.Root
......@@ -25,7 +25,7 @@ import Gargantext.API.Ngrams.Types (MSet(..), NgramsPatch(..), NgramsRepoElement
import Gargantext.API.Ngrams.Tools (getNodeStory)
import Gargantext.Core.NodeStory (ArchiveList, a_state, a_version, currentVersion, initArchive)
import Gargantext.Core.NodeStory.Utils (saveNodeStory)
import Gargantext.Core.Types.Individu ()
import Gargantext.Core.Types.Individu (User(UserName))
import Gargantext.Core.Types (ListType(..), ListId, NodeId, UserId)
import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (userMaster)
......
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