Commit 871b48ee authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] refactor nodeApi.

parent 58cdb74f
...@@ -213,6 +213,7 @@ type GargAPI' = ...@@ -213,6 +213,7 @@ type GargAPI' =
-- Corpus endpoint -- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint" :<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI HyperdataCorpus :> Capture "id" Int :> NodeAPI HyperdataCorpus
-- Corpus endpoint -- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint" :<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI :> ReqBody '[JSON] [Int] :> NodesAPI
......
...@@ -69,17 +69,75 @@ import Gargantext.Text.Terms (TermType(..)) ...@@ -69,17 +69,75 @@ import Gargantext.Text.Terms (TermType(..))
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
------------------------------------------------------------------- -------------------------------------------------------------------
-- | Node API Types management -- | TODO : access by admin only
type NodesAPI = Delete '[JSON] Int
-- | Delete Nodes
-- Be careful: really delete nodes
-- Access by admin only
nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
nodesAPI conn ids = deleteNodes' conn ids
------------------------------------------------------------------------
-- | TODO: access by admin only
-- To manager the Users roots
type Roots = Get '[JSON] [Node Value] type Roots = Get '[JSON] [Node Value]
:<|> Post '[JSON] Int -- TODO :<|> Post '[JSON] Int -- TODO
:<|> Put '[JSON] Int -- TODO :<|> Put '[JSON] Int -- TODO
:<|> Delete '[JSON] Int -- TODO :<|> Delete '[JSON] Int -- TODO
type NodesAPI = Delete '[JSON] Int -- | TODO: access by admin only
roots :: Connection -> Server Roots
roots conn = liftIO (putStrLn ( "/user" :: Text) >> getNodesWithParentId 0 Nothing conn)
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
-------------------------------------------------------------------
-- | Node API Types management
-- TODO : access by users
type NodeAPI a = Get '[JSON] (Node a)
:<|> "rename" :> RenameApi
:<|> PostNodeApi
:<|> Put '[JSON] Int
:<|> Delete '[JSON] Int
:<|> "children" :> ChildrenApi a
:<|> "table" :> TableApi
:<|> "chart" :> ChartApi
:<|> "favorites" :> FavApi
:<|> "documents" :> DocsApi
type RenameApi = Summary " RenameNode Node"
:> ReqBody '[JSON] RenameNode
:> Put '[JSON] [Int]
type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
:> ReqBody '[JSON] PostNode
:> Post '[JSON] [Int]
type ChildrenApi a = Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [Node a]
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- 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 p
:<|> getTable conn id
:<|> getChart conn id
:<|> favApi conn id
:<|> delDocs conn id
-- :<|> upload
-- :<|> query
------------------------------------------------------------------------ ------------------------------------------------------------------------
data RenameNode = RenameNode { r_name :: Text } data RenameNode = RenameNode { r_name :: Text }
deriving (Generic) deriving (Generic)
...@@ -89,7 +147,6 @@ instance ToJSON RenameNode ...@@ -89,7 +147,6 @@ instance ToJSON RenameNode
instance ToSchema RenameNode instance ToSchema RenameNode
instance Arbitrary RenameNode where instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"] arbitrary = elements [RenameNode "test"]
------------------------------------------------------------------------ ------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text data PostNode = PostNode { pn_name :: Text
...@@ -103,7 +160,7 @@ instance Arbitrary PostNode where ...@@ -103,7 +160,7 @@ instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus] arbitrary = elements [PostNode "Node test" NodeCorpus]
------------------------------------------------------------------------ ------------------------------------------------------------------------
type DocsApi = Summary "Move to trash" type DocsApi = Summary "Docs : Move to trash"
:> ReqBody '[JSON] Documents :> ReqBody '[JSON] Documents
:> Delete '[JSON] [Int] :> Delete '[JSON] [Int]
...@@ -119,10 +176,10 @@ delDocs c cId ds = liftIO $ nodesToTrash c ...@@ -119,10 +176,10 @@ delDocs c cId ds = liftIO $ nodesToTrash c
$ map (\n -> (cId, n, True)) $ documents ds $ map (\n -> (cId, n, True)) $ documents ds
------------------------------------------------------------------------ ------------------------------------------------------------------------
type FavApi = Summary "Label as Favorites" type FavApi = Summary " Favorites label"
:> ReqBody '[JSON] Favorites :> ReqBody '[JSON] Favorites
:> Put '[JSON] [Int] :> Put '[JSON] [Int]
:<|> Summary "Unlabel as Favorites" :<|> Summary " Favorites unlabel"
:> ReqBody '[JSON] Favorites :> ReqBody '[JSON] Favorites
:> Delete '[JSON] [Int] :> Delete '[JSON] [Int]
...@@ -146,81 +203,40 @@ favApi :: Connection -> CorpusId -> (Favorites -> Handler [Int]) ...@@ -146,81 +203,40 @@ favApi :: Connection -> CorpusId -> (Favorites -> Handler [Int])
favApi c cId = putFav c cId :<|> delFav c cId favApi c cId = putFav c cId :<|> delFav c cId
------------------------------------------------------------------------ ------------------------------------------------------------------------
type NodeAPI a = Get '[JSON] (Node a)
:<|> "rename" :> Summary " RenameNode Node"
:> ReqBody '[JSON] RenameNode
:> Put '[JSON] [Int]
:<|> Summary " PostNode Node with ParentId as {id}"
:> ReqBody '[JSON] PostNode
:> Post '[JSON] [Int]
:<|> Put '[JSON] Int
:<|> Delete '[JSON] Int
:<|> "children" :> Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [Node a]
:<|> Summary " Tabs" :> FacetDocAPI
-- How TODO ?
:<|> "favorites" :> Summary " Favorites" :> FavApi
:<|> "documents" :> Summary " Documents" :> DocsApi
-- 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 p
:<|> getTable conn id
:<|> getChart conn id
:<|> favApi conn id
:<|> delDocs conn id
-- :<|> upload
-- :<|> query
--data FacetFormat = Table | Chart --data FacetFormat = Table | Chart
data FacetType = Docs | Terms | Sources | Authors | Trash data TabType = Docs | Terms | Sources | Authors | Trash
deriving (Generic, Enum, Bounded) deriving (Generic, Enum, Bounded)
instance FromHttpApiData FacetType instance FromHttpApiData TabType
where where
parseUrlPiece "Docs" = pure Docs parseUrlPiece "Docs" = pure Docs
parseUrlPiece "Terms" = pure Terms parseUrlPiece "Terms" = pure Terms
parseUrlPiece "Sources" = pure Sources parseUrlPiece "Sources" = pure Sources
parseUrlPiece "Authors" = pure Authors parseUrlPiece "Authors" = pure Authors
parseUrlPiece "Trash" = pure Trash parseUrlPiece "Trash" = pure Trash
parseUrlPiece _ = Left "Unexpected value of FacetType" parseUrlPiece _ = Left "Unexpected value of TabType"
instance ToParamSchema FacetType instance ToParamSchema TabType
instance ToJSON FacetType instance ToJSON TabType
instance FromJSON FacetType instance FromJSON TabType
instance ToSchema FacetType instance ToSchema TabType
instance Arbitrary FacetType instance Arbitrary TabType
where where
arbitrary = elements [minBound .. maxBound] arbitrary = elements [minBound .. maxBound]
------------------------------------------------------------------------ ------------------------------------------------------------------------
type FacetDocAPI = "table" type TableApi = Summary " Table API"
:> Summary " Table data" :> QueryParam "view" TabType
:> QueryParam "view" FacetType :> QueryParam "offset" Int
:> QueryParam "offset" Int :> QueryParam "limit" Int
:> QueryParam "limit" Int :> QueryParam "order" OrderBy
:> QueryParam "order" OrderBy :> Get '[JSON] [FacetDoc]
:> Get '[JSON] [FacetDoc]
type ChartApi = Summary " Chart API"
:<|> "chart" :> QueryParam "from" UTCTime
:> Summary " Chart data" :> QueryParam "to" UTCTime
:> QueryParam "from" UTCTime :> Get '[JSON] [FacetChart]
:> QueryParam "to" UTCTime
:> Get '[JSON] [FacetChart]
-- :<|> "favorites" :> Summary " Favorites" :> FavApi
-- :<|> "documents" :> Summary " Documents" :> DocsApi
-- Depending on the Type of the Node, we could post -- Depending on the Type of the Node, we could post
-- New documents for a corpus -- New documents for a corpus
...@@ -231,13 +247,6 @@ type FacetDocAPI = "table" ...@@ -231,13 +247,6 @@ type FacetDocAPI = "table"
-- :<|> "query" :> Capture "string" Text :> Get '[JSON] Text -- :<|> "query" :> Capture "string" Text :> Get '[JSON] Text
-- | Node API functions
roots :: Connection -> Server Roots
roots conn = liftIO (putStrLn ( "/user" :: Text) >> getNodesWithParentId 0 Nothing conn)
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
------------------------------------------------------------------------ ------------------------------------------------------------------------
type GraphAPI = Get '[JSON] Graph type GraphAPI = Get '[JSON] Graph
graphAPI :: Connection -> NodeId -> Server GraphAPI graphAPI :: Connection -> NodeId -> Server GraphAPI
...@@ -258,14 +267,10 @@ treeAPI = treeDB ...@@ -258,14 +267,10 @@ treeAPI = treeDB
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Check if the name is less than 255 char -- | Check if the name is less than 255 char
--rename :: Connection -> NodeId -> Rename -> Server NodeAPI
rename :: Connection -> NodeId -> RenameNode -> Handler [Int] rename :: Connection -> NodeId -> RenameNode -> Handler [Int]
rename c nId (RenameNode name) = liftIO $ U.update (U.Rename nId name) c rename c nId (RenameNode name) = liftIO $ U.update (U.Rename nId name) c
nodesAPI :: Connection -> [NodeId] -> Server NodesAPI getTable :: Connection -> NodeId -> Maybe TabType
nodesAPI conn ids = deleteNodes' conn ids
getTable :: Connection -> NodeId -> Maybe FacetType
-> Maybe Offset -> Maybe Limit -> Maybe Offset -> Maybe Limit
-> Maybe OrderBy -> Handler [FacetDoc] -> Maybe OrderBy -> Handler [FacetDoc]
getTable c cId ft o l order = liftIO $ case ft of getTable c cId ft o l order = liftIO $ case ft of
...@@ -294,7 +299,6 @@ getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType ...@@ -294,7 +299,6 @@ getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit) getNodesWith' conn id p nodeType offset limit = liftIO (getNodesWith conn id p nodeType offset limit)
query :: Text -> Handler Text query :: Text -> Handler Text
query s = pure s query s = pure s
......
...@@ -23,7 +23,7 @@ Portability : POSIX ...@@ -23,7 +23,7 @@ Portability : POSIX
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
module Gargantext.Database.Facet module Gargantext.Database.Facet
where where
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
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