[DBFLOW] getViewDocument + uniqIdBdd (enables duplicatas from different Database...
[gargantext.git] / src / Gargantext / API / Node.hs
index 51f731f6cd26f0932ea047ab6e2d0704d461c0ef..24970debeaabdcf8a699e34793fb8232342ac061 100644 (file)
@@ -10,64 +10,215 @@ Portability : POSIX
 Node API
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators   #-}
+{-# 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      #-}
 
-import Control.Monad
+-------------------------------------------------------------------
+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 System.IO (putStrLn, readFile)
-import Data.Text (Text(), pack)
-import Database.PostgreSQL.Simple (Connection)
-import Gargantext.Prelude
-import Gargantext.Types.Main (Node, NodeId, NodeType)
-import Gargantext.Database.Node (getNodesWithParentId, getNode, getNodesWith)
+import Control.Monad ((>>))
+--import System.IO (putStrLn, readFile)
 
+import Data.Aeson (FromJSON, ToJSON, Value())
+--import Data.Text (Text(), pack)
+import Data.Text (Text())
+import Data.Swagger
+import Data.Time (UTCTime)
 
--- | Node API Types management
-type Roots = Get '[JSON] [Node Value]
+import Database.PostgreSQL.Simple (Connection)
 
-type NodeAPI   = Get '[JSON] (Node Value)
+import GHC.Generics (Generic)
+import Servant
+-- import Servant.Multipart
 
-                -- Example for Document Facet view, to populate the tabular:
-                -- http://localhost:8008/node/347476/children?type=Document&limit=3
-                -- /!\ FIXME : nodeType is case sensitive
-                -- /!\ see NodeTypes in Types/Main.hs
-             :<|> "children" :> QueryParam "type"   NodeType
+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]
+         :<|> Post   '[JSON] Int -- TODO
+         :<|> Put    '[JSON] Int -- TODO
+         :<|> Delete '[JSON] Int -- TODO
+
+type NodesAPI  = Delete '[JSON] Int
+
+
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+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]
-             
+                             :> 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
                 -- New map list terms
-             :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
+             -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
                 
                 -- To launch a query and update the corpus
-             :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
-
+             -- :<|> "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)
-              :<|> getNodesWith' conn id
-              :<|> upload
-              :<|> query
-
-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)
+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 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 (runCmd conn $ deleteNodes ids)
+
+deleteNode' :: Connection -> NodeId -> Handler Int
+deleteNode' conn id = liftIO (runCmd conn $ deleteNode id)
+
+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
+                        -> Handler [FacetDoc]
+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
@@ -76,18 +227,18 @@ query s = pure s
 
 -- | Upload files
 -- TODO Is it possible to adapt the function according to iValue input ?
-upload :: MultipartData -> Handler Text
-upload multipartData = do
-  liftIO $ do
-    putStrLn "Inputs:"
-    forM_ (inputs multipartData) $ \input ->
-      putStrLn $ "  " <> show (iName input)
-            <> " -> " <> show (iValue input)
-
-    forM_ (files multipartData) $ \file -> do
-      content <- readFile (fdFilePath file)
-      putStrLn $ "Content of " <> show (fdFileName file)
-              <> " at " <> fdFilePath file
-      putStrLn content
-  pure (pack "Data loaded")
+--upload :: MultipartData -> Handler Text
+--upload multipartData = do
+--  liftIO $ do
+--    putStrLn "Inputs:"
+--    forM_ (inputs multipartData) $ \input ->
+--      putStrLn $ "  " <> show (iName input)
+--            <> " -> " <> show (iValue input)
+--
+--    forM_ (files multipartData) $ \file -> do
+--      content <- readFile (fdFilePath file)
+--      putStrLn $ "Content of " <> show (fdFileName file)
+--              <> " at " <> fdFilePath file
+--      putStrLn content
+--  pure (pack "Data loaded")