[MERGE]

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

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

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

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))
 

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]

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