Node API
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
-module Gargantext.API.Node
- where
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+-------------------------------------------------------------------
+module Gargantext.API.Node
+ ( module Gargantext.API.Node
+ , HyperdataCorpus(..)
+ , HyperdataResource(..)
+ , HyperdataUser(..)
+ , HyperdataDocument(..)
+ , HyperdataDocumentV3(..)
+ ) where
+-------------------------------------------------------------------
+
+import Control.Lens (prism')
import Control.Monad.IO.Class (liftIO)
-import Data.Aeson (Value())
-import Servant
--- import Servant.Multipart
+import Control.Monad ((>>))
--import System.IO (putStrLn, readFile)
-import Data.Text (Text())
---import Data.Text (Text(), pack)
-import Database.PostgreSQL.Simple (Connection)
-import Gargantext.Prelude
-import Gargantext.Types.Node
-import Gargantext.Database.Node (getNodesWithParentId
- , getNode, getNodesWith
- , deleteNode, deleteNodes)
-import Gargantext.Database.Facet (FacetDoc, getDocFacet)
+import Data.Aeson (FromJSON, ToJSON, Value())
+--import Data.Text (Text(), pack)
+import Data.Text (Text())
+import Data.Swagger
+import Data.Time (UTCTime)
+import Database.PostgreSQL.Simple (Connection)
+import GHC.Generics (Generic)
+import Servant
+-- import Servant.Multipart
+import Gargantext.Prelude
+import Gargantext.Database.Types.Node
+import Gargantext.Database.Node ( runCmd
+ , getNodesWithParentId
+ , getNode, getNodesWith
+ , deleteNode, deleteNodes, mk, JSONB)
+import qualified Gargantext.Database.Node.Update as U (update, Update(..))
+import Gargantext.Database.Facet (FacetDoc {-,getDocFacet-}
+ ,FacetChart)
+import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
+
+-- Graph
+import Gargantext.TextFlow
+import Gargantext.Viz.Graph (Graph)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Types.Main (Tree, NodeTree)
+import Gargantext.Text.Terms (TermType(..))
+
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+-------------------------------------------------------------------
-- | Node API Types management
-type Roots = Get '[JSON] [Node Value]
+type Roots = Get '[JSON] [Node Value]
+ :<|> Post '[JSON] Int -- TODO
+ :<|> Put '[JSON] Int -- TODO
+ :<|> Delete '[JSON] Int -- TODO
type NodesAPI = Delete '[JSON] Int
-type NodeAPI = Get '[JSON] (Node Value)
- :<|> Delete '[JSON] Int
- :<|> "children" :> QueryParam "type" NodeType
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+data RenameNode = RenameNode { r_name :: Text }
+ deriving (Generic)
+
+instance FromJSON RenameNode
+instance ToJSON RenameNode
+instance ToSchema RenameNode
+instance Arbitrary RenameNode where
+ arbitrary = elements [RenameNode "test"]
+
+------------------------------------------------------------------------
+
+data PostNode = PostNode { pn_name :: Text
+ , pn_typename :: NodeType}
+ deriving (Generic)
+
+instance FromJSON PostNode
+instance ToJSON PostNode
+instance ToSchema PostNode
+instance Arbitrary PostNode where
+ arbitrary = elements [PostNode "Node test" NodeCorpus]
+
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+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 Value]
-
-
- :<|> "facet" :> QueryParam "type" NodeType
- :> QueryParam "offset" Int
- :> QueryParam "limit" Int
- :> Get '[JSON] [FacetDoc]
-
+ :> Get '[JSON] [Node a]
+ :<|> "facet" :> Summary " Facet documents"
+ :> "documents" :> FacetDocAPI
+-- :<|> "facet" :<|> "sources" :<|> FacetSourcesAPI
+-- :<|> "facet" :<|> "authors" :<|> FacetAuthorsAPI
+-- :<|> "facet" :<|> "terms" :<|> FacetTermsAPI
+
+--data FacetFormat = Table | Chart
+--data FacetType = Doc | Term | Source | Author
+--data Facet = Facet Doc Format
+
+
+type FacetDocAPI = "table"
+ :> Summary " Table data"
+ :> QueryParam "offset" Int
+ :> QueryParam "limit" Int
+ :> Get '[JSON] [FacetDoc]
+
+ :<|> "chart"
+ :> Summary " Chart data"
+ :> QueryParam "from" UTCTime
+ :> QueryParam "to" UTCTime
+ :> Get '[JSON] [FacetChart]
-- Depending on the Type of the Node, we could post
-- New documents for a corpus
-- :<|> "query" :> Capture "string" Text :> Get '[JSON] Text
-
-- | Node API functions
roots :: Connection -> Server Roots
-roots conn = liftIO (getNodesWithParentId conn 0 Nothing)
-
-nodeAPI :: Connection -> NodeId -> Server NodeAPI
-nodeAPI conn id = liftIO (getNode conn id)
+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
+graphAPI :: Connection -> NodeId -> Server GraphAPI
+graphAPI _ _ = liftIO $ textFlow (Mono EN) (Contexts contextText)
+ -- TODO what do we get about the node? to replace contextText
+
+-- TODO(orphan): There should be a proper APIError data type with a case TreeError.
+instance HasTreeError ServantErr where
+ _TreeError = prism' mk (const Nothing) -- Note a prism
+ where
+ mk NoRoot = err404 { errBody = "Root node not found" }
+ mk EmptyRoot = err500 { errBody = "Root node should not be empty" }
+ mk TooManyRoots = err500 { errBody = "Too many root nodes" }
+
+type TreeAPI = Get '[JSON] (Tree NodeTree)
+treeAPI :: Connection -> NodeId -> Server TreeAPI
+treeAPI = treeDB
+
+-- 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
- :<|> getDocFacet' conn id
+ :<|> getNodesWith' conn id p
+ :<|> getFacet conn id
+ :<|> getChart conn id
-- :<|> upload
-- :<|> query
+-- | Check if the name is less than 255 char
+--rename :: Connection -> NodeId -> Rename -> Server NodeAPI
+rename :: Connection -> NodeId -> RenameNode -> Handler [Int]
+rename c nId (RenameNode name) = liftIO $ U.update (U.Rename nId name) c
nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
nodesAPI conn ids = deleteNodes' conn ids
+postNode :: Connection -> NodeId -> PostNode -> Handler [Int]
+postNode c pId (PostNode name nt) = liftIO $ mk c nt (Just pId) name
+
+putNode :: Connection -> NodeId -> Handler Int
+putNode = undefined -- TODO
+
deleteNodes' :: Connection -> [NodeId] -> Handler Int
-deleteNodes' conn ids = liftIO (deleteNodes conn ids)
+deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids)
deleteNode' :: Connection -> NodeId -> Handler Int
-deleteNode' conn id = liftIO (deleteNode conn id)
+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)
-getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
+
+getFacet :: Connection -> NodeId -> Maybe Int -> Maybe Int
-> Handler [FacetDoc]
-getDocFacet' conn id nodeType offset limit = liftIO (getDocFacet conn id nodeType offset limit)
+getFacet conn id offset limit = undefined -- liftIO (putStrLn ( "/facet" :: Text)) >> liftIO (getDocFacet conn NodeCorpus id (Just NodeDocument) offset limit)
+
+getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
+ -> Handler [FacetChart]
+getChart _ _ _ _ = undefined -- TODO
+
query :: Text -> Handler Text
query s = pure s