Skip to content

haskell-gargantext
haskell-gargantext
Unverified Commit 2ca441e5 authored by Nicolas Pouillard's avatar Nicolas Pouillard
Browse files
Options

Polymorphic NodeAPI, with specific instance for Corpus

parent a11db080
Hide whitespace changes
Inline Side-by-side
Showing with 78 additions and 28 deletions
src/Gargantext/API.hs
View file @ 2ca441e5
......@@ -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
View file @ 2ca441e5
......@@ -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
View file @ 2ca441e5
......@@ -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
View file @ 2ca441e5
......@@ -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/Flow.hs
View file @ 2ca441e5
......@@ -30,19 +30,19 @@ authors
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.Flow
(flow)
where
import System.FilePath (FilePath)
import GHC.Base ((>>))
import Data.Maybe (Maybe(..))
import Gargantext.Core.Types (NodePoly(..))
import Gargantext.Prelude
import Gargantext.Database.Bashql (runCmd', del)
import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot, mkCorpus, defaultCorpus)
import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus)
import Gargantext.Database.User (getUser, UserLight(..))
import Gargantext.Database.Node.Document.Import (insertDocuments)
import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS))
--flow :: FilePath -> IO ()
flow :: FilePath -> IO ()
flow fp = do
masterUser <- runCmd' (getUser "gargantua")
......@@ -71,7 +71,8 @@ flow fp = do
idsRepeat <- runCmd' $ insertDocuments masterUserId corpusId docs
printDebug "Docs IDs : " idsRepeat
runCmd' (del [corpusId])
_ <- runCmd' (del [corpusId])
pure ()
{-
--folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here")
......
src/Gargantext/Database/Node.hs
View file @ 2ca441e5
......@@ -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
View file @ 2ca441e5
......@@ -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
......
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