diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs
index ea1ac4e59d2a81cbfbf541cf3492dc5501b767ca..08b667222392689e63c3f92556d4bd3998855b3f 100644
--- a/src/Gargantext/API.hs
+++ b/src/Gargantext/API.hs
@@ -45,6 +45,7 @@ import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens
+import Data.Aeson (Value)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
@@ -70,7 +71,9 @@ import Gargantext.API.Node ( Roots , roots
, NodesAPI , nodesAPI
, GraphAPI , graphAPI
, TreeAPI , treeAPI
+ , HyperdataCorpus
)
+import Gargantext.Database.Types.Node ()
import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
--import Gargantext.API.Orchestrator
@@ -206,12 +209,12 @@ type GargAPI' =
-- Node endpoint
:<|> "node" :> Summary "Node endpoint"
- :> Capture "id" Int :> NodeAPI
+ :> Capture "id" Int :> NodeAPI Value
-- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint"
- :> Capture "id" Int :> NodeAPI
+ :> Capture "id" Int :> NodeAPI HyperdataCorpus
-- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint"
@@ -255,8 +258,8 @@ server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerFront
:<|> roots conn
- :<|> nodeAPI conn
- :<|> nodeAPI conn
+ :<|> nodeAPI conn (Proxy :: Proxy Value)
+ :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
:<|> nodesAPI conn
:<|> count -- TODO: undefined
:<|> search conn
diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs
index f4f3b76ecac24ebeff6ca07d0a9df342f059b21d..6f85f1091b1c05f0285f4067227cebc3f104c6e4 100644
--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -14,6 +14,7 @@ Node API
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -21,7 +22,13 @@ Node API
-------------------------------------------------------------------
module Gargantext.API.Node
- where
+ ( module Gargantext.API.Node
+ , HyperdataCorpus(..)
+ , HyperdataResource(..)
+ , HyperdataUser(..)
+ , HyperdataDocument(..)
+ , HyperdataDocumentV3(..)
+ ) where
-------------------------------------------------------------------
import Control.Lens (prism')
@@ -46,7 +53,7 @@ import Gargantext.Database.Types.Node
import Gargantext.Database.Node ( runCmd
, getNodesWithParentId
, getNode, getNodesWith
- , deleteNode, deleteNodes, mk)
+ , deleteNode, deleteNodes, mk, JSONB)
import qualified Gargantext.Database.Node.Update as U (update, Update(..))
import Gargantext.Database.Facet (FacetDoc, getDocFacet
,FacetChart)
@@ -96,7 +103,7 @@ instance Arbitrary PostNode where
------------------------------------------------------------------------
------------------------------------------------------------------------
-type NodeAPI = Get '[JSON] (Node Value)
+type NodeAPI a = Get '[JSON] (Node a)
:<|> "rename" :> Summary " RenameNode Node"
:> ReqBody '[JSON] RenameNode
:> Put '[JSON] [Int]
@@ -109,7 +116,7 @@ type NodeAPI = Get '[JSON] (Node Value)
:> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
- :> Get '[JSON] [Node Value]
+ :> Get '[JSON] [Node a]
:<|> "facet" :> Summary " Facet documents"
:> "documents" :> FacetDocAPI
-- :<|> "facet" :<|> "sources" :<|> FacetSourcesAPI
@@ -167,13 +174,15 @@ type TreeAPI = Get '[JSON] (Tree NodeTree)
treeAPI :: Connection -> NodeId -> Server TreeAPI
treeAPI = treeDB
-nodeAPI :: Connection -> NodeId -> Server NodeAPI
-nodeAPI conn id = liftIO (putStrLn ("/node" :: Text) >> getNode conn id )
+-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
+nodeAPI :: JSONB a => Connection -> proxy a -> NodeId -> Server (NodeAPI a)
+nodeAPI conn p id
+ = liftIO (getNode conn id p)
:<|> rename conn id
:<|> postNode conn id
:<|> putNode conn id
:<|> deleteNode' conn id
- :<|> getNodesWith' conn id
+ :<|> getNodesWith' conn id p
:<|> getFacet conn id
:<|> getChart conn id
-- :<|> upload
@@ -198,9 +207,9 @@ deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids)
deleteNode' :: Connection -> NodeId -> Handler Int
deleteNode' conn id = liftIO (runCmd conn $ deleteNode id)
-getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
- -> Handler [Node Value]
-getNodesWith' conn id nodeType offset limit = liftIO (getNodesWith conn id nodeType offset limit)
+getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
+ -> Maybe Int -> Maybe Int -> Handler [Node a]
+getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit)
getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
diff --git a/src/Gargantext/Database/Bashql.hs b/src/Gargantext/Database/Bashql.hs
index b27b256f60711fcef9b18bb43bef185d1c76e817..516903b729dfee248c976d14f01b7c2228711677 100644
--- a/src/Gargantext/Database/Bashql.hs
+++ b/src/Gargantext/Database/Bashql.hs
@@ -76,10 +76,8 @@ module Gargantext.Database.Bashql ( get
import Control.Monad.Reader -- (Reader, ask)
-import Safe (lastMay)
import Data.Text (Text)
import Data.Aeson
-import Data.Aeson.Types
import Data.List (concat, last)
import Gargantext.Core.Types
@@ -151,7 +149,7 @@ put u = mkCmd $ U.update u
-- jump NodeId
-- touch Dir
-type Name = Text
+-- type Name = Text
--mkCorpus :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
diff --git a/src/Gargantext/Database/Facet.hs b/src/Gargantext/Database/Facet.hs
index 234528432c0d53a99ec635f910847cc232829e84..5c99027e15a23d85593912c2d9270b2e65d64a85 100644
--- a/src/Gargantext/Database/Facet.hs
+++ b/src/Gargantext/Database/Facet.hs
@@ -219,7 +219,7 @@ leftJoin3''' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12
-- | Building the facet
selectDocFacet' :: NodeType -> ParentId -> Maybe NodeType -> Query FacetDocRead
selectDocFacet' _ pId _ = proc () -> do
- (n1,(nn,n2)) <- leftJoin3''' -< ()
+ (n1,(nn,_n2)) <- leftJoin3''' -< ()
restrict -< (.&&) (_node_parentId n1 .== (toNullable $ pgInt4 pId))
(_node_typename n1 .== (pgInt4 $ nodeTypeId NodeDocument))
diff --git a/src/Gargantext/Database/Node.hs b/src/Gargantext/Database/Node.hs
index 8e2a2d0f08759829c57ff93d0fdd18ec968c9057..a52ad28822b9d9ec77d18adcf80e9c481bcbf07c 100644
--- a/src/Gargantext/Database/Node.hs
+++ b/src/Gargantext/Database/Node.hs
@@ -13,6 +13,8 @@ Portability : POSIX
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -235,9 +237,9 @@ deleteNodes ns = mkCmd $ \conn ->
(\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
-getNodesWith :: Connection -> Int -> Maybe NodeType
- -> Maybe Offset -> Maybe Limit -> IO [Node Value]
-getNodesWith conn parentId nodeType maybeOffset maybeLimit =
+getNodesWith :: JSONB a => Connection -> Int -> proxy a -> Maybe NodeType
+ -> Maybe Offset -> Maybe Limit -> IO [Node a]
+getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
runQuery conn $ selectNodesWith
parentId nodeType maybeOffset maybeLimit
@@ -279,9 +281,10 @@ selectNodesWithType type_id = proc () -> do
restrict -< tn .== type_id
returnA -< row
+type JSONB = QueryRunnerColumnDefault PGJsonb
-getNode :: Connection -> Int -> IO (Node Value)
-getNode conn id = do
+getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
+getNode conn id _ = do
fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
@@ -467,6 +470,7 @@ childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a c
-- TODO: remove hardcoded userId (with Reader)
-- TODO: user Reader in the API and adapt this function
+userId :: Int
userId = 1
mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Types/Node.hs
index e992ed6690f2487e72badbfbc3329b328e26de32..9af223b6a68765c00e62e854c0a5a56aa1ea6215 100644
--- a/src/Gargantext/Database/Types/Node.hs
+++ b/src/Gargantext/Database/Types/Node.hs
@@ -157,6 +157,9 @@ instance ToJSON EventLevel
instance Arbitrary EventLevel where
arbitrary = elements [minBound..maxBound]
+instance ToSchema EventLevel where
+ declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+
------------------------------------------------------------------------
data Event = Event { event_level :: EventLevel
@@ -168,6 +171,9 @@ $(deriveJSON (unPrefix "event_") ''Event)
instance Arbitrary Event where
arbitrary = Event <$> arbitrary <*> arbitrary <*> arbitrary
+instance ToSchema Event where
+ declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+
------------------------------------------------------------------------
type Text' = Text
@@ -187,6 +193,9 @@ $(deriveJSON (unPrefix "resource_") ''Resource)
instance Arbitrary Resource where
arbitrary = Resource <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+instance ToSchema Resource where
+ declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+
------------------------------------------------------------------------
data Hyperdata a = Hyperdata { unHyperdata :: a}
@@ -335,10 +344,11 @@ instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) N
instance Arbitrary (NodePoly NodeId NodeTypeId (Maybe NodeUserId) NodeParentId NodeName UTCTime HyperdataDocument) where
arbitrary = elements [Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) ((hyperdataDocument))]
-
instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataDocument) where
arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataDocument]
+instance Arbitrary (NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime HyperdataCorpus) where
+ arbitrary = elements [Node 1 1 1 (Just 1) "name" (jour 2018 01 01) hyperdataCorpus]
------------------------------------------------------------------------
hyperdataDocument :: HyperdataDocument
@@ -352,6 +362,19 @@ hyperdataDocument = case decode docExample of
docExample :: ByteString
docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
+corpusExample :: ByteString
+corpusExample = "" -- TODO
+
+hyperdataCorpus :: HyperdataCorpus
+hyperdataCorpus = case decode corpusExample of
+ Just hp -> hp
+ Nothing -> HyperdataCorpus Nothing Nothing Nothing Nothing Nothing
+
+instance ToSchema HyperdataCorpus where
+ declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
+ L.& mapped.schema.description ?~ "a corpus"
+ L.& mapped.schema.example ?~ toJSON hyperdataCorpus
+
instance ToSchema HyperdataDocument where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
@@ -376,6 +399,18 @@ instance ToSchema (NodePoly NodeId NodeTypeId
UTCTime HyperdataDocument
)
+instance ToSchema (NodePoly NodeId NodeTypeId
+ (Maybe NodeUserId)
+ NodeParentId NodeName
+ UTCTime HyperdataCorpus
+ )
+
+instance ToSchema (NodePoly NodeId NodeTypeId
+ (NodeUserId)
+ (Maybe NodeParentId) NodeName
+ UTCTime HyperdataCorpus
+ )
+
instance ToSchema (NodePoly NodeId NodeTypeId
(Maybe NodeUserId)
NodeParentId NodeName