diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs
index fc1ca7030214fb5429db410aaeb6e1261321ea0f..401d3041b05b0c537791c0d4c6f66248b6d06551 100644
--- a/src/Gargantext/API.hs
+++ b/src/Gargantext/API.hs
@@ -93,6 +93,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)
@@ -261,6 +262,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
@@ -362,6 +366,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
diff --git a/src/Gargantext/API/Export.hs b/src/Gargantext/API/Export.hs
new file mode 100644
index 0000000000000000000000000000000000000000..a4fbb2d73cbd14ef52e8c118645df543bc74e0ef
--- /dev/null
+++ b/src/Gargantext/API/Export.hs
@@ -0,0 +1,130 @@
+{-|
+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.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 Servant
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+-- Corpus Export
+data Corpus =
+ Corpus { _c_corpus :: [Document]
+ -- , _c_listVersion :: Int
+ , _c_hash :: Text
+ } deriving (Generic)
+
+-- | Document Export
+data Document =
+ Document { _d_document :: Node HyperdataDocument
+ , _d_ngrams :: [Text]
+ -- , _d_hash :: Text
+ } deriving (Generic)
+
+instance ToSchema Corpus where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_c_")
+
+instance ToSchema Document where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_d_")
+
+instance ToParamSchema Corpus where
+ toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance ToParamSchema Document 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 r = Map.intersectionWith (\a b -> Document a (Set.toList b)) ns ngs
+ pure $ Corpus (Map.elems r) "HASH_TODO"
+
+-- getCorpusNgrams :: CorpusId -> ListId ->
+-- Exports List
+-- Version number of the list
+
+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)
+
diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs
index f0f8063eb006ac6903fe41a8e00c027e5bc48cbf..e72524c0340302a1988c706d6ae2d14b9bca7402 100644
--- a/src/Gargantext/API/Ngrams.hs
+++ b/src/Gargantext/API/Ngrams.hs
@@ -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
diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs
index 464633d801a0b9bba049f95099a19cc2b9dbb57d..99e245f4005b7a5eae6e4520478b17980a565584 100644
--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -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
@@ -371,3 +370,4 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
-> Cmd err Int
putNode n h = fromIntegral <$> updateHyperdata n h
-------------------------------------------------------------
+
diff --git a/src/Gargantext/API/Orchestrator/Types.hs b/src/Gargantext/API/Orchestrator/Types.hs
index 2b53c58840f55867939cfcfaf595151fe6f5d400..5c4262597ec45fada26bd1f156b81776b094e624 100644
--- a/src/Gargantext/API/Orchestrator/Types.hs
+++ b/src/Gargantext/API/Orchestrator/Types.hs
@@ -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"
diff --git a/src/Gargantext/API/Types.hs b/src/Gargantext/API/Types.hs
index 215517cadbdadf7dd07be1ec774c1ff58e5af7ba..00583d389d5193d4d7095f462a6926b4a4527a93 100644
--- a/src/Gargantext/API/Types.hs
+++ b/src/Gargantext/API/Types.hs
@@ -76,17 +76,17 @@ instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
throwAll' = throwError
type GargServerC env err m =
- ( CmdM env err m
- , HasNodeError err
- , HasInvalidError err
- , HasTreeError err
- , HasServerError err
- , HasJoseError err
- , ToJSON err -- TODO this is arguable
- , Exception err
- , HasRepo env
- , HasSettings env
- , HasJobEnv env ScraperStatus ScraperStatus
+ ( CmdM env err m
+ , HasNodeError err
+ , HasInvalidError err
+ , HasTreeError err
+ , HasServerError err
+ , HasJoseError err
+ , ToJSON err -- TODO this is arguable
+ , Exception err
+ , HasRepo env
+ , HasSettings env
+ , HasJobEnv env ScraperStatus ScraperStatus
)
type GargServerT env err m api = GargServerC env err m => ServerT api m
@@ -94,12 +94,25 @@ 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
+ = GargNodeError NodeError
+ | GargTreeError TreeError
| GargInvalidError Validation
- | GargJoseError Jose.Error
- | GargServerError ServerError
+ | GargJoseError Jose.Error
+ | GargServerError ServerError
deriving (Show, Typeable)
makePrisms ''GargError
diff --git a/src/Gargantext/Core/Types.hs b/src/Gargantext/Core/Types.hs
index 5a9d8a16b6315117e9f529d5fd665b0bb310c6d2..7d527020cd57e6157f48583213d533cc3cbc993f 100644
--- a/src/Gargantext/Core/Types.hs
+++ b/src/Gargantext/Core/Types.hs
@@ -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
+
+
+
diff --git a/src/Gargantext/Core/Types/Main.hs b/src/Gargantext/Core/Types/Main.hs
index a84bbf2fe3cf74581223a83b7ef47071055a199f..0dcd16a30e39b735a8192828d0df3baff0ada0b0 100644
--- a/src/Gargantext/Core/Types/Main.hs
+++ b/src/Gargantext/Core/Types/Main.hs
@@ -52,8 +52,6 @@ instance ToSchema NodeTree where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_nt_")
------------------------------------------------------------------------
-
-
--data Classification = Favorites | MyClassifcation
type HashId = Text
diff --git a/src/Gargantext/Database/Metrics/NgramsByNode.hs b/src/Gargantext/Database/Metrics/NgramsByNode.hs
index 5b080823447286ba87241052e1f3c5de2525dd02..e36de812b5cac9a6f0a1dd3cddaa38f68c7f7020 100644
--- a/src/Gargantext/Database/Metrics/NgramsByNode.hs
+++ b/src/Gargantext/Database/Metrics/NgramsByNode.hs
@@ -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.unionsWith (<>)
+ . 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 =
diff --git a/src/Gargantext/Database/Schema/Ngrams.hs b/src/Gargantext/Database/Schema/Ngrams.hs
index d9f784774d161834681f27ca94ac7459193353ff..01272956bc244f7b720eab0e897e88cecaed1488 100644
--- a/src/Gargantext/Database/Schema/Ngrams.hs
+++ b/src/Gargantext/Database/Schema/Ngrams.hs
@@ -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
diff --git a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs
index dfe139128f1ff55a15756f3a73716631a0eb8585..705719bcecc8412cc6221453edf4be79e9a12def 100644
--- a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs
+++ b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs
@@ -78,6 +78,8 @@ nodeNodeNgramsTable = Table "node_node_ngrams"
}
)
+------------------------------------------------
+
queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Types/Node.hs
index 4212529cbff9ae04f09f1c7472e8d9f358ae23f3..e00e5cdc4dc4b528ec58ecb54550c22d2c1c81ad 100644
--- a/src/Gargantext/Database/Types/Node.hs
+++ b/src/Gargantext/Database/Types/Node.hs
@@ -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
diff --git a/src/Gargantext/Viz/Phylo/API.hs b/src/Gargantext/Viz/Phylo/API.hs
index 67b4d732791aa432e8a1dcc7537592786b723c63..5df248c11367ae389c51cf431e246bacaadde5a3 100644
--- a/src/Gargantext/Viz/Phylo/API.hs
+++ b/src/Gargantext/Viz/Phylo/API.hs
@@ -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)