Skip to content

haskell-gargantext
haskell-gargantext
Commit 51513857 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into dev-getting-started-readme

parents 7826213e 6d58acdd
Pipeline #729 failed with stage
    Show whitespace changes
    Inline Side-by-side
    Showing with 413 additions and 143 deletions
    devops/postgres/schema.sql
    View file @ 51513857
    ......@@ -166,7 +166,7 @@ CREATE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id, cate
    CREATE UNIQUE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id, ngrams_id, ngrams_type);
    CREATE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id);
    CREATE INDEX ON public.node_node_ngrams USING btree (ngrams_id, node2_id);
    CREATE INDEX ON public.node_node_ngrams USING btree (ngrams_type);
    CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_id, node_ngrams1_id, node_ngrams2_id);
    CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams1_id);
    CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams2_id);
    ......
    src/Gargantext/API.hs
    View file @ 51513857
    ......@@ -15,12 +15,14 @@ This API is indeed typed in order to be able to derive both the server
    and the client sides.
    The Garg-API-Monad enables:
    - Features
    - Security (WIP)
    - Features (WIP)
    - Database connection (long term)
    - In Memory stack management (short term)
    - Logs
    - Logs (WIP)
    Thanks to @yannEsposito (at the start) and @np (after).
    Thanks to Yann Esposito for our discussions at the start and to Nicolas
    Pouillard (who mainly made it).
    -}
    ......@@ -92,6 +94,7 @@ import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgra
    import Gargantext.API.Node
    import Gargantext.API.Search (SearchPairsAPI, searchPairs)
    import Gargantext.API.Types
    import qualified Gargantext.API.Export as Export
    import qualified Gargantext.API.Corpus.New as New
    import Gargantext.Database.Types.Node
    import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
    ......@@ -260,6 +263,9 @@ type GargPrivateAPI' =
    :> Capture "node2_id" NodeId
    :> NodeNodeAPI HyperdataAny
    :<|> "corpus" :> Capture "node_id" CorpusId
    :> Export.API
    -- Annuaire endpoint
    :<|> "annuaire":> Summary "Annuaire endpoint"
    :> Capture "annuaire_id" AnnuaireId
    ......@@ -310,9 +316,11 @@ type GargPrivateAPI' =
    -- :<|> "ngrams" :> Capture "node_id" Int :> NodeAPI
    -- :<|> "auth" :> Capture "node_id" Int :> NodeAPI
    ---------------------------------------------------------------------
    type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
    type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
    type API = SwaggerAPI
    :<|> FrontEndAPI
    :<|> GargAPI
    :<|> Get '[HTML] Html
    -- This is the concrete monad. It needs to be used as little as possible,
    -- instead, prefer GargServer, GargServerT, GargServerC.
    ......@@ -331,7 +339,8 @@ type EnvC env =
    server :: forall env. EnvC env => env -> IO (Server API)
    server env = do
    -- orchestrator <- scrapyOrchestrator env
    pure $ swaggerFront
    pure $ schemaUiServer swaggerDoc
    :<|> frontEndServer
    :<|> hoistServerWithContext (Proxy :: Proxy GargAPI) (Proxy :: Proxy AuthContext) transform serverGargAPI
    :<|> serverStatic
    where
    ......@@ -361,6 +370,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
    :<|> nodeAPI (Proxy :: Proxy HyperdataAny) uid
    :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid
    :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid
    :<|> Export.getCorpus -- uid
    :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid
    :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid
    ......@@ -414,13 +424,8 @@ serverStatic = $(do
    )
    ---------------------------------------------------------------------
    swaggerFront :: Server SwaggerFrontAPI
    swaggerFront = schemaUiServer swaggerDoc
    :<|> frontEndServer
    --gargMock :: Server GargAPI
    --gargMock = mock apiGarg Proxy
    ---------------------------------------------------------------------
    makeApp :: EnvC env => env -> IO Application
    makeApp env = serveWithContext api cfg <$> server env
    ......@@ -433,7 +438,6 @@ makeApp env = serveWithContext api cfg <$> server env
    --appMock :: Application
    --appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
    ---------------------------------------------------------------------
    api :: Proxy API
    api = Proxy
    ......@@ -441,12 +445,10 @@ api = Proxy
    apiGarg :: Proxy GargAPI
    apiGarg = Proxy
    ---------------------------------------------------------------------
    schemaUiServer :: (Server api ~ Handler Swagger)
    => Swagger -> Server (SwaggerSchemaUI' dir api)
    schemaUiServer = swaggerSchemaUIServer
    -- Type Family for the Documentation
    type family TypeName (x :: *) :: Symbol where
    TypeName Int = "Int"
    ......
    src/Gargantext/API/Export.hs 0 → 100644
    View file @ 51513857
    {-|
    Module : Gargantext.API.Export
    Description : Get Metrics from Storage (Database like)
    Copyright : (c) CNRS, 2017-Present
    License : AGPL + CECILL v3
    Maintainer : team@gargantext.org
    Stability : experimental
    Portability : POSIX
    Main exports of Gargantext:
    - corpus
    - document and ngrams
    - lists
    -}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeOperators #-}
    module Gargantext.API.Export
    where
    import Data.Aeson.TH (deriveJSON)
    import Data.Map (Map)
    import Data.Set (Set)
    import Data.Maybe (fromMaybe)
    import Data.Swagger
    import Data.Text (Text)
    import GHC.Generics (Generic)
    import Gargantext.API.Ngrams
    import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
    import Gargantext.API.Types (GargNoServer)
    import Gargantext.Core.Types --
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
    import Gargantext.Database.Config (userMaster)
    import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
    import Gargantext.Database.Node.Select (selectNodesWithUsername)
    import Gargantext.Database.Schema.Ngrams (NgramsType(..))
    import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
    import Gargantext.Database.Schema.NodeNode (selectDocNodes)
    import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
    import Gargantext.Database.Utils (Cmd)
    import Gargantext.Prelude
    import Gargantext.Prelude.Utils (sha)
    import Servant
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    import qualified Data.List as List
    -- Corpus Export
    data Corpus =
    Corpus { _c_corpus :: [Document]
    , _c_hash :: Hash
    } deriving (Generic)
    -- | Document Export
    data Document =
    Document { _d_document :: Node HyperdataDocument
    , _d_ngrams :: Ngrams
    , _d_hash :: Hash
    } deriving (Generic)
    data Ngrams =
    Ngrams { _ng_ngrams :: [Text]
    , _ng_hash :: Hash
    } deriving (Generic)
    type Hash = Text
    -------
    instance ToSchema Corpus where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
    instance ToSchema Document where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
    instance ToSchema Ngrams where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ng_")
    -------
    instance ToParamSchema Corpus where
    toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
    instance ToParamSchema Document where
    toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
    instance ToParamSchema Ngrams where
    toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
    --------------------------------------------------
    type API = Summary "Corpus Export"
    :> "export"
    :> QueryParam "listId" ListId
    :> QueryParam "ngramsType" NgramsType
    :> Get '[JSON] Corpus
    --------------------------------------------------
    getCorpus :: CorpusId
    -> Maybe ListId
    -> Maybe NgramsType
    -> GargNoServer Corpus
    getCorpus cId lId nt' = do
    let
    nt = case nt' of
    Nothing -> NgramsTerms
    Just t -> t
    ns <- Map.fromList
    <$> map (\n -> (_node_id n, n))
    <$> selectDocNodes cId
    repo <- getRepo
    ngs <- getNodeNgrams cId lId nt repo
    let -- uniqId is hash computed already for each document imported in database
    r = Map.intersectionWith (\a b -> Document a (Ngrams (Set.toList b) (ng_hash b)) (d_hash a b)
    ) ns ngs
    where
    ng_hash b = sha $ List.foldl (\x y -> x<>y) "" $ List.sort $ Set.toList b
    d_hash a b = sha $ (fromMaybe "" (_hyperdataDocument_uniqId $ _node_hyperdata a))
    <> (ng_hash b)
    pure $ Corpus (Map.elems r) (sha $ List.foldl (\a b -> a<>b) ""
    $ List.map _d_hash $ Map.elems r
    )
    getNodeNgrams :: HasNodeError err
    => CorpusId
    -> Maybe ListId
    -> NgramsType
    -> NgramsRepo
    -> Cmd err (Map NodeId (Set Text))
    getNodeNgrams cId lId' nt repo = do
    lId <- case lId' of
    Nothing -> defaultList cId
    Just l -> pure l
    lIds <- selectNodesWithUsername NodeList userMaster
    let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo
    r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
    pure r
    $(deriveJSON (unPrefix "_c_") ''Corpus)
    $(deriveJSON (unPrefix "_d_") ''Document)
    $(deriveJSON (unPrefix "_ng_") ''Ngrams)
    -- TODO
    -- Exports List
    -- Version number of the list
    src/Gargantext/API/Ngrams.hs
    View file @ 51513857
    ......@@ -78,7 +78,7 @@ module Gargantext.API.Ngrams
    , HasRepo(..)
    , RepoCmdM
    , QueryParamR
    , TODO(..)
    , TODO
    -- Internals
    , getNgramsTableMap
    ......@@ -143,7 +143,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
    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 (TODO)
    import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid)
    import Servant hiding (Patch)
    import System.Clock (getTime, TimeSpec, Clock(..))
    ......@@ -152,12 +152,6 @@ import System.IO (stderr)
    import Test.QuickCheck (elements)
    import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
    data TODO = TODO
    deriving (Generic)
    instance ToSchema TODO where
    instance ToParamSchema TODO where
    ------------------------------------------------------------------------
    --data FacetFormat = Table | Chart
    data TabType = Docs | Trash | MoreFav | MoreTrash
    ......@@ -1044,14 +1038,14 @@ getTableNgrams _nType nId tabType listId limit_ offset
    -- trace (show lists) $
    -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
    let nSco = needsScores orderBy
    let scoresNeeded = needsScores orderBy
    tableMap1 <- getNgramsTableMap listId ngramsType
    t1 <- getTime'
    tableMap2 <- tableMap1 & v_data %%~ setScores nSco
    tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
    . Map.mapWithKey ngramsElementFromRepo
    t2 <- getTime'
    tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
    . setScores (not nSco)
    . setScores (not scoresNeeded)
    . selectAndPaginate
    t3 <- getTime'
    liftIO $ hprint stderr
    ......@@ -1059,7 +1053,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
    % " map1=" % timeSpecs
    % " map2=" % timeSpecs
    % " map3=" % timeSpecs
    % " sql=" % (if nSco then "map2" else "map3")
    % " sql=" % (if scoresNeeded then "map2" else "map3")
    % "\n"
    ) t0 t3 t0 t1 t1 t2 t2 t3
    pure tableMap3
    ......
    src/Gargantext/API/Node.hs
    View file @ 51513857
    ......@@ -12,7 +12,6 @@ Portability : POSIX
    -- TODO-ACCESS: CanGetNode
    -- TODO-EVENTS: No events as this is a read only query.
    Node API
    -------------------------------------------------------------------
    -- TODO-ACCESS: access by admin only.
    -- At first let's just have an isAdmin check.
    ......@@ -51,16 +50,17 @@ import Gargantext.API.Auth (withAccess, PathId(..))
    import Gargantext.API.Metrics
    import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
    import Gargantext.API.Ngrams.NTree (MyTree)
    import Gargantext.API.Search (SearchDocsAPI, searchDocs)
    import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
    import Gargantext.API.Table
    import Gargantext.API.Types
    import Gargantext.Core.Types (NodeTableResult)
    import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
    import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Database.Flow.Pairing (pairing)
    import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
    import Gargantext.Database.Node.Children (getChildren)
    import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
    import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
    import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
    import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
    import Gargantext.Database.Tree (treeDB)
    import Gargantext.Database.Types.Node
    ......@@ -78,7 +78,6 @@ import qualified Gargantext.Text.List.Learn as Learn
    import qualified Data.Vector as Vec
    --}
    type NodesAPI = Delete '[JSON] Int
    -- | Delete Nodes
    ......@@ -128,11 +127,16 @@ type NodeAPI a = Get '[JSON] (Node a)
    -- TODO gather it
    :<|> "table" :> TableApi
    :<|> "ngrams" :> TableNgramsApi
    -- :<|> "pairing" :> PairingApi
    :<|> "category" :> CatApi
    :<|> "search" :> SearchDocsAPI
    -- Pairing utilities
    :<|> "pairwith" :> PairWith
    :<|> "pairs" :> Pairs
    :<|> "pairing" :> PairingApi
    :<|> "searchPair" :> SearchPairsAPI
    -- VIZ
    :<|> "metrics" :> ScatterAPI
    :<|> "chart" :> ChartApi
    ......@@ -188,12 +192,15 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
    -- TODO gather it
    :<|> tableApi id
    :<|> apiNgramsTableCorpus id
    -- :<|> getPairing id
    -- :<|> getTableNgramsDoc id
    :<|> catApi id
    :<|> searchDocs id
    -- Pairing Tools
    :<|> pairWith id
    :<|> pairs id
    :<|> getPair id
    :<|> searchPairs id
    :<|> getScatter id
    :<|> getChart id
    ......@@ -254,6 +261,7 @@ catApi = putCat
    ------------------------------------------------------------------------
    -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
    -- Pairing utilities to move elsewhere
    type PairingApi = Summary " Pairing API"
    :> QueryParam "view" TabType
    -- TODO change TabType -> DocType (CorpusId for pairing)
    ......@@ -262,6 +270,25 @@ type PairingApi = Summary " Pairing API"
    :> QueryParam "order" OrderBy
    :> Get '[JSON] [FacetDoc]
    ----------
    type Pairs = Summary "List of Pairs"
    :> Get '[JSON] [AnnuaireId]
    pairs :: CorpusId -> GargServer Pairs
    pairs cId = do
    ns <- getNodeNode cId
    pure $ map _nn_node2_id ns
    type PairWith = Summary "Pair a Corpus with an Annuaire"
    :> "annuaire" :> Capture "annuaire_id" AnnuaireId
    :> "list" :> Capture "list_id" ListId
    :> Post '[JSON] Int
    pairWith :: CorpusId -> GargServer PairWith
    pairWith cId aId lId = do
    r <- pairing cId aId lId
    _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
    pure r
    ------------------------------------------------------------------------
    type ChartApi = Summary " Chart API"
    :> QueryParam "from" UTCTime
    ......@@ -343,3 +370,4 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
    -> Cmd err Int
    putNode n h = fromIntegral <$> updateHyperdata n h
    -------------------------------------------------------------
    src/Gargantext/API/Orchestrator/Types.hs
    View file @ 51513857
    ......@@ -22,7 +22,7 @@ import Servant.Job.Types
    import Servant.Job.Utils (jsonOptions)
    import Test.QuickCheck (elements)
    import Test.QuickCheck.Arbitrary
    import Gargantext.API.Ngrams (TODO(..))
    import Gargantext.Core.Types (TODO(..))
    instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
    arbitrary = panic "TODO"
    ......
    src/Gargantext/API/Search.hs
    View file @ 51513857
    ......@@ -79,8 +79,7 @@ instance ToSchema SearchPairedResults where
    -----------------------------------------------------------------------
    -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
    -- TODO-EVENTS: No event, this is a read-only query.
    type SearchAPI results
    = Summary "Search endpoint"
    type SearchAPI results = Summary "Search endpoint"
    :> ReqBody '[JSON] SearchQuery
    :> QueryParam "offset" Int
    :> QueryParam "limit" Int
    ......@@ -88,18 +87,20 @@ type SearchAPI results
    :> Post '[JSON] results
    type SearchDocsAPI = SearchAPI SearchDocResults
    type SearchPairsAPI =
    Summary "" :> "list" :> Capture "list" ListId
    :> SearchAPI SearchPairedResults
    -----------------------------------------------------------------------
    searchPairs :: NodeId -> GargServer SearchPairsAPI
    searchPairs pId lId (SearchQuery q) o l order =
    SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
    searchDocs :: NodeId -> GargServer SearchDocsAPI
    searchDocs nId (SearchQuery q) o l order =
    SearchDocResults <$> searchInCorpus nId False q o l order
    --SearchResults <$> searchInCorpusWithContacts nId q o l order
    -----------------------------------------------------------------------
    type SearchPairsAPI = Summary ""
    :> "list"
    :> Capture "list" ListId
    :> SearchAPI SearchPairedResults
    searchPairs :: NodeId -> GargServer SearchPairsAPI
    searchPairs pId lId (SearchQuery q) o l order =
    SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
    -----------------------------------------------------------------------
    src/Gargantext/API/Table.hs
    View file @ 51513857
    ......@@ -46,7 +46,7 @@ import GHC.Generics (Generic)
    import Gargantext.API.Ngrams (TabType(..))
    import Gargantext.Core.Types (Offset, Limit, TableResult(..))
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
    import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..))
    import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc)
    import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
    import Gargantext.Database.TextSearch
    import Gargantext.Database.Types.Node
    ......@@ -121,14 +121,13 @@ getTable' cId ft o l order =
    (Just MoreTrash) -> moreLike cId o l order IsTrash
    x -> panic $ "not implemented in getTable: " <> (cs $ show x)
    {-
    getPairing :: ContactId -> Maybe TabType
    getPair :: ContactId -> Maybe TabType
    -> Maybe Offset -> Maybe Limit
    -> Maybe OrderBy -> Cmd err [FacetDoc]
    getPairing cId ft o l order =
    getPair cId ft o l order =
    case ft of
    (Just Docs) -> runViewAuthorsDoc cId False o l order
    (Just Trash) -> runViewAuthorsDoc cId True o l order
    _ -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
    -}
    src/Gargantext/API/Types.hs
    View file @ 51513857
    ......@@ -94,6 +94,19 @@ type GargServerT env err m api = GargServerC env err m => ServerT api m
    type GargServer api =
    forall env err m. GargServerT env err m api
    -------------------------------------------------------------------
    -- | This Type is needed to prepare the function before the GargServer
    type GargNoServer' env err m =
    ( CmdM env err m
    , HasRepo env
    , HasSettings env
    , HasNodeError err
    )
    type GargNoServer t =
    forall env err m. GargNoServer' env err m => m t
    -------------------------------------------------------------------
    data GargError
    = GargNodeError NodeError
    | GargTreeError TreeError
    ......
    src/Gargantext/Core/Types.hs
    View file @ 51513857
    ......@@ -25,32 +25,29 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main
    , Name
    , TableResult(..)
    , NodeTableResult
    , TODO(..)
    ) where
    --import qualified Data.Set as S
    import Control.Lens (Prism', (#))
    import Control.Monad.Error.Class (MonadError, throwError)
    import Data.Aeson
    import Data.Aeson.TH (deriveJSON)
    import Data.Monoid
    import Data.Semigroup
    import Data.Set (Set, empty)
    import Data.Swagger (ToParamSchema)
    import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
    --import qualified Data.Set as S
    import Data.Text (Text, unpack)
    import Data.Validity
    import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
    import GHC.Generics
    import Gargantext.Core.Types.Main
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
    import Gargantext.Database.Types.Node
    import Gargantext.Prelude
    import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
    import GHC.Generics
    ------------------------------------------------------------------------
    type Name = Text
    type Term = Text
    type Stems = Set Text
    ......@@ -158,3 +155,13 @@ instance Arbitrary a => Arbitrary (TableResult a) where
    arbitrary = TableResult <$> arbitrary <*> arbitrary
    type NodeTableResult a = TableResult (Node a)
    -- TO BE removed
    data TODO = TODO
    deriving (Generic)
    instance ToSchema TODO where
    instance ToParamSchema TODO where
    src/Gargantext/Core/Types/Main.hs
    View file @ 51513857
    ......@@ -52,8 +52,6 @@ instance ToSchema NodeTree where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nt_")
    ------------------------------------------------------------------------
    --data Classification = Favorites | MyClassifcation
    type HashId = Text
    ......
    src/Gargantext/Database/Facet.hs
    View file @ 51513857
    ......@@ -26,8 +26,8 @@ Portability : POSIX
    {-# LANGUAGE TypeFamilies #-}
    ------------------------------------------------------------------------
    module Gargantext.Database.Facet
    ( -- runViewAuthorsDoc
    runViewDocuments
    ( runViewAuthorsDoc
    , runViewDocuments
    , filterWith
    , Pair(..)
    ......@@ -57,9 +57,13 @@ import Gargantext.Core.Types
    import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
    import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Database.Schema.Node
    import Gargantext.Database.Schema.Ngrams
    import Gargantext.Database.Schema.NodeNode
    import Gargantext.Database.Schema.NodeNodeNgrams
    -- import Gargantext.Database.Schema.NodeNodeNgrams2
    import Gargantext.Database.Utils
    import Gargantext.Database.Queries.Filter
    import Gargantext.Database.Queries.Join (leftJoin5)
    import Opaleye
    import Prelude hiding (null, id, map, sum, not, read)
    import Servant.API
    ......@@ -208,7 +212,7 @@ instance Arbitrary OrderBy
    -- TODO-SECURITY check
    {-
    --{-
    runViewAuthorsDoc :: 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
    ......@@ -227,26 +231,31 @@ viewAuthorsDoc cId _ nt = proc () -> do
    restrict -< _node_id contact .== (toNullable $ pgNodeId cId)
    restrict -< _node_typename doc .== (pgInt4 $ nodeTypeId nt)
    returnA -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (toNullable $ pgInt4 1) (toNullable $ pgDouble 1)
    returnA -< FacetDoc (_node_id doc)
    (_node_date doc)
    (_node_name doc)
    (_node_hyperdata doc)
    (toNullable $ pgInt4 1)
    (toNullable $ pgDouble 1)
    queryAuthorsDoc :: Query (NodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))
    queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34 cond45
    queryAuthorsDoc :: Query (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))
    queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45
    where
    cond12 :: (NodeNgramRead, NodeRead) -> Column PGBool
    cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
    cond12 (nodeNgram, doc) = _node_id doc
    .== nng_node_id nodeNgram
    .== _nnng_node1_id nodeNgram
    cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
    cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
    cond23 (ngrams, (nodeNgram, _)) = ngrams^.ngrams_id
    .== nng_ngrams_id nodeNgram
    .== _nnng_ngrams_id nodeNgram
    cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
    cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== nng_ngrams_id nodeNgram2
    cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column PGBool
    cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== _nnng_ngrams_id nodeNgram2
    cond45 :: (NodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
    cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id contact .== nng_node_id nodeNgram2
    cond45 :: (NodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column PGBool
    cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id contact .== _nnng_node1_id nodeNgram2
    -}
    --}
    ------------------------------------------------------------------------
    -- TODO-SECURITY check
    ......@@ -265,8 +274,12 @@ viewDocuments cId t ntId = proc () -> do
    restrict -< n^.node_typename .== (pgInt4 ntId)
    restrict -< if t then nn^.nn_category .== (pgInt4 0)
    else nn^.nn_category .>= (pgInt4 1)
    returnA -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (toNullable $ nn^.nn_category) (toNullable $ nn^.nn_score)
    returnA -< FacetDoc (_node_id n)
    (_node_date n)
    (_node_name n)
    (_node_hyperdata n)
    (toNullable $ nn^.nn_category)
    (toNullable $ nn^.nn_score)
    ------------------------------------------------------------------------
    filterWith :: (PGOrd date, PGOrd title, PGOrd score, hyperdata ~ Column SqlJsonb) =>
    ......
    src/Gargantext/Database/Flow/Pairing.hs
    View file @ 51513857
    ......@@ -52,11 +52,11 @@ pairing' = undefined
    -}
    -- | TODO : add paring policy as parameter
    pairing :: AnnuaireId
    -> CorpusId
    pairing :: CorpusId -- (CorpusId, ListId) -- Pair (Either CorpusId AnnuaireId) ListId
    -> AnnuaireId -- (AnnuaireId, ListId) -- Pair (Either CorpusId AnnuaireId) ListId
    -> ListId
    -> Cmd err Int
    pairing aId cId lId = do
    pairing cId aId lId = do
    contacts' <- getAllContacts aId
    let contactsMap = pairingPolicyToMap toLower
    $ toMaps extractNgramsT (tr_docs contacts')
    ......@@ -120,6 +120,7 @@ getNgramsTindexed corpusId ngramsType' = fromList
    where
    selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
    JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
    -- JOIN node_node_ngrams2 occ ON occ.ngrams_id = n.id
    JOIN nodes_nodes nn ON nn.node2_id = occ.node2_id
    WHERE nn.node1_id = ?
    ......
    src/Gargantext/Database/Metrics/NgramsByNode.hs
    View file @ 51513857
    ......@@ -180,11 +180,11 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
    -> NgramsType
    -> [Text]
    -> Cmd err [(Text, Double)]
    run cId' lId' _nt' tms' = runPGSQuery query
    run cId' lId' nt' tms' = runPGSQuery query
    ( Values fields (DPS.Only <$> tms')
    , cId'
    , lId'
    -- , ngramsTypeId nt'
    , ngramsTypeId nt'
    )
    query :: DPS.Query
    ......@@ -194,9 +194,9 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
    JOIN ngrams ng ON nng.ngrams_id = ng.id
    JOIN input_rows ir ON ir.terms = ng.terms
    WHERE nng.node1_id = ? -- CorpusId
    AND nng.node2_id = ?
    -- AND nng.ngrams_type = ? -- NgramsTypeId
    -- AND nn.category > 0
    AND nng.node2_id = ? -- ListId
    AND nng.ngrams_type = ? -- NgramsTypeId
    -- AND nn.category > 0 -- TODO
    GROUP BY ng.terms, nng.weight
    |]
    ......@@ -278,15 +278,32 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
    GROUP BY nng.node2_id, ng.terms
    |]
    ------------------------------------------------------------------------
    getNodesByNgramsOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
    -> Cmd err (Map Text (Set NodeId))
    getNodesByNgramsOnlyUser cId ls nt ngs =
    Map.unionsWith (<>)
    . map (fromListWith (<>) . map (second Set.singleton))
    . map (fromListWith (<>)
    . map (second Set.singleton))
    <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
    (splitEvery 1000 ngs)
    getNgramsByNodeOnlyUser :: NodeId
    -> [ListId]
    -> NgramsType
    -> [Text]
    -> Cmd err (Map NodeId (Set Text))
    getNgramsByNodeOnlyUser cId ls nt ngs =
    Map.unionsWith (<>)
    . map (fromListWith (<>)
    . map (second Set.singleton))
    . map (map swap)
    <$> mapM (selectNgramsOnlyByNodeUser cId ls nt)
    (splitEvery 1000 ngs)
    ------------------------------------------------------------------------
    selectNgramsOnlyByNodeUser :: CorpusId -> [ListId] -> NgramsType -> [Text]
    -> Cmd err [(Text, NodeId)]
    selectNgramsOnlyByNodeUser cId ls nt tms =
    ......@@ -319,7 +336,6 @@ queryNgramsOnlyByNodeUser = [sql|
    selectNgramsOnlyByNodeUser' :: CorpusId -> [ListId] -> NgramsType -> [Text]
    -> Cmd err [(Text, Int)]
    selectNgramsOnlyByNodeUser' cId ls nt tms =
    ......@@ -349,7 +365,6 @@ queryNgramsOnlyByNodeUser' = [sql|
    getNgramsByDocOnlyUser :: NodeId -> [ListId] -> NgramsType -> [Text]
    -> Cmd err (Map Text (Set NodeId))
    getNgramsByDocOnlyUser cId ls nt ngs =
    ......
    src/Gargantext/Database/Node/Document/Add.hs
    View file @ 51513857
    ......@@ -75,7 +75,6 @@ prepare pId ns = map (\nId -> InputData pId nId) ns
    ------------------------------------------------------------------------
    -- * Main Types used
    data InputData = InputData { inNode1_id :: NodeId
    , inNode2_id :: NodeId
    } deriving (Show, Generic, Typeable)
    ......
    src/Gargantext/Database/Node/Document/Insert.hs
    View file @ 51513857
    ......@@ -135,7 +135,6 @@ instance InsertDb HyperdataContact
    , (toField . toJSON) h
    ]
    -- | Debug SQL function
    --
    -- to print rendered query (Debug purpose) use @formatQuery@ function.
    ......
    src/Gargantext/Database/Schema/Ngrams.hs
    View file @ 51513857
    ......@@ -41,8 +41,12 @@ import Database.PostgreSQL.Simple.ToRow (toRow)
    import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
    import GHC.Generics (Generic)
    import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery)
    import Gargantext.Core.Types (TODO(..))
    import Gargantext.Prelude
    import Opaleye hiding (FromField)
    import Servant (FromHttpApiData, parseUrlPiece, Proxy(..))
    import Text.Read (read)
    import Data.Swagger (ToParamSchema, toParamSchema)
    import Prelude (Enum, Bounded, minBound, maxBound, Functor)
    import qualified Database.PostgreSQL.Simple as PGS
    ......@@ -94,7 +98,7 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
    -- ngrams in authors field of document has Authors Type
    -- ngrams in text (title or abstract) of documents has Terms Type
    data NgramsType = Authors | Institutes | Sources | NgramsTerms
    deriving (Eq, Show, Ord, Enum, Bounded, Generic)
    deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
    instance FromJSON NgramsType
    instance FromJSONKey NgramsType where
    ......@@ -115,6 +119,15 @@ instance FromField NgramsTypeId where
    if (n :: Int) > 0 then return $ NgramsTypeId n
    else mzero
    instance FromHttpApiData NgramsType where
    parseUrlPiece n = pure $ (read . cs) n
    instance ToParamSchema NgramsType where
    toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
    instance QueryRunnerColumnDefault (Nullable PGInt4) NgramsTypeId
    where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    ......
    src/Gargantext/Database/Schema/Node.hs
    View file @ 51513857
    ......@@ -530,13 +530,20 @@ arbitraryDashboard = HyperdataDashboard (Just "Preferences")
    ------------------------------------------------------------------------
    node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
    node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
    node nodeType name hyperData parentId userId =
    Node Nothing
    (pgInt4 typeId)
    (pgInt4 userId)
    (pgNodeId <$> parentId)
    (pgStrictText name)
    Nothing
    (pgJSONB $ cs $ encode hyperData)
    where
    typeId = nodeTypeId nodeType
    -------------------------------
    insertNodes :: [NodeWrite] -> Cmd err Int64
    insertNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
    insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
    insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
    insertNodesR ns = mkCmd $ \conn ->
    ......@@ -576,10 +583,10 @@ data Node' = Node' { _n_type :: NodeType
    } deriving (Show)
    mkNodes :: [NodeWrite] -> Cmd err Int64
    mkNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
    mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
    mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
    mkNodeR ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
    mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
    ------------------------------------------------------------------------
    ......
    src/Gargantext/Database/Schema/NodeNode.hs
    View file @ 51513857
    ......@@ -65,7 +65,7 @@ type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
    (Column (Nullable PGFloat8))
    (Column (Nullable PGInt4))
    type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
    type NodeNode = NodeNodePoly NodeId NodeId (Maybe Double) (Maybe Int)
    $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
    makeLenses ''NodeNodePoly
    ......@@ -102,8 +102,30 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
    instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    ------------------------------------------------------------------------
    -- | Basic NodeNode tools
    getNodeNode :: NodeId -> Cmd err [NodeNode]
    getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
    where
    selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
    selectNodeNode n' = proc () -> do
    ns <- queryNodeNodeTable -< ()
    restrict -< _nn_node1_id ns .== n'
    returnA -< ns
    -------------------------
    insertNodeNode :: [NodeNode] -> Cmd err Int64
    insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
    where
    ns' :: [NodeNodeWrite]
    ns' = map (\(NodeNode n1 n2 x y)
    -> NodeNode (pgNodeId n1)
    (pgNodeId n2)
    (pgDouble <$> x)
    (pgInt4 <$> y)
    ) ns
    -- | Favorite management
    nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
    nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
    ......@@ -131,13 +153,11 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
    ------------------------------------------------------------------------
    -- | TODO use UTCTime fast
    selectDocsDates :: CorpusId -> Cmd err [Text]
    selectDocsDates cId =
    map (head' "selectDocsDates" . splitOn "-")
    selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
    <$> catMaybes
    <$> map (view hyperdataDocument_publication_date)
    <$> selectDocs cId
    selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
    selectDocs cId = runOpaQuery (queryDocs cId)
    ......@@ -149,7 +169,6 @@ queryDocs cId = proc () -> do
    restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
    returnA -< view (node_hyperdata) n
    selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
    selectDocNodes cId = runOpaQuery (queryDocNodes cId)
    ......@@ -161,14 +180,12 @@ queryDocNodes cId = proc () -> do
    restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
    returnA -< n
    joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
    joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
    where
    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
    cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
    ------------------------------------------------------------------------
    -- | Trash management
    nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
    ......
    src/Gargantext/Database/Schema/NodeNodeNgrams.hs
    View file @ 51513857
    ......@@ -78,6 +78,8 @@ nodeNodeNgramsTable = Table "node_node_ngrams"
    }
    )
    ------------------------------------------------
    queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
    queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
    ......
    src/Gargantext/Database/Schema/NodesNgramsRepo.hs
    View file @ 51513857
    ......@@ -80,7 +80,7 @@ selectPatches = proc () -> do
    insertRepos :: [NgramsStatePatch] -> Cmd err Int64
    insertRepos ns = mkCmd $ \conn -> runInsertMany conn repoTable (toWrite ns)
    insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite ns) rCount Nothing
    where
    toWrite :: [NgramsStatePatch] -> [RepoDbWrite]
    toWrite = undefined
    ......
    src/Gargantext/Database/Schema/User.hs
    View file @ 51513857
    ......@@ -115,7 +115,9 @@ userTable = Table "auth_user" (pUser User { user_id = optional "id"
    -- TODO: on conflict, nice message
    insertUsers :: [UserWrite] -> Cmd err Int64
    insertUsers us = mkCmd $ \c -> runInsertMany c userTable us
    insertUsers us = mkCmd $ \c -> runInsert_ c insert
    where
    insert = Insert userTable us rCount Nothing
    gargantextUser :: Username -> UserWrite
    ......
    src/Gargantext/Database/Tree.hs
    View file @ 51513857
    ......@@ -108,7 +108,7 @@ dbTree rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
    FROM nodes AS c
    INNER JOIN tree AS s ON c.parent_id = s.id
    WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90)
    WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90,71)
    )
    SELECT * from tree;
    |] (Only rootId)
    ......
    src/Gargantext/Database/Types/Node.hs
    View file @ 51513857
    ......@@ -106,7 +106,6 @@ type Node json = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName U
    ------------------------------------------------------------------------
    instance FromHttpApiData NodeId where
    parseUrlPiece n = pure $ NodeId $ (read . cs) n
    ......
    src/Gargantext/Prelude/Utils.hs
    View file @ 51513857
    ......@@ -36,12 +36,11 @@ import Crypto.Argon2 as Crypto
    import Data.Either
    import Data.ByteString.Base64.URL as URL
    --------------------------------------------------------------------------
    shuffle :: MonadRandom m => [a] -> m [a]
    shuffle ns = SRS.shuffleM ns
    type FolderPath = FilePath
    type FileName = FilePath
    --------------------------------------------------------------------------
    sha :: Text -> Text
    sha = Text.pack
    . SHA.showDigest
    ......@@ -49,6 +48,7 @@ sha = Text.pack
    . Char.pack
    . Text.unpack
    --------------------------------------------------------------------------
    data NodeToHash = NodeToHash { nodeType :: NodeType
    , nodeId :: NodeId
    }
    ......@@ -58,6 +58,9 @@ secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
    type SecretKey = ByteString
    type FolderPath = FilePath
    type FileName = FilePath
    hashNode :: SecretKey -> NodeToHash -> ByteString
    hashNode sk (NodeToHash nt ni) = case hashResult of
    Left e -> panic (cs $ show e)
    ......
    src/Gargantext/Viz/Phylo/API.hs
    View file @ 51513857
    ......@@ -37,7 +37,7 @@ import Gargantext.Prelude
    import Gargantext.Viz.Phylo
    import Gargantext.Viz.Phylo.Main
    import Gargantext.Viz.Phylo.Example
    import Gargantext.API.Ngrams (TODO(..))
    import Gargantext.Core.Types (TODO(..))
    import Servant
    import Test.QuickCheck (elements)
    import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
    ......
    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