Update README.md
[gargantext.git] / src / Gargantext / API / Node.hs
index 374e368688285734ad227541447b919ee7e0339f..e1ed44ee0e3cd8bf25108f533a549b91fb5749a6 100644 (file)
@@ -21,8 +21,6 @@ Node API
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
@@ -36,12 +34,9 @@ import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
-import Gargantext.API.Admin.Auth.Types (PathId(..))
 import Gargantext.API.Admin.Auth (withAccess)
+import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -53,6 +48,7 @@ import Gargantext.Core.Types (NodeTableResult)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
@@ -63,20 +59,22 @@ import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
 import Gargantext.Prelude
-import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Gargantext.API.Node.DocumentUpload as DocumentUpload
+import qualified Gargantext.API.Node.DocumentsFromWriteNodes as DocumentsFromWriteNodes
+import qualified Gargantext.API.Node.FrameCalcUpload as FrameCalcUpload
 import qualified Gargantext.API.Node.Share  as Share
 import qualified Gargantext.API.Node.Update as Update
 import qualified Gargantext.API.Search as Search
 import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
 
-{-
-import qualified Gargantext.Core.Text.List.Learn as Learn
-import qualified Data.Vector as Vec
---}
 
 -- | Admin NodesAPI
 -- TODO
@@ -123,6 +121,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "rename" :> RenameApi
              :<|> PostNodeApi -- TODO move to children POST
              :<|> PostNodeAsync
+             :<|> FrameCalcUpload.API
              :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
              :<|> "update"     :> Update.API
              :<|> Delete '[JSON] Int
@@ -133,6 +132,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "ngrams"     :> TableNgramsApi
 
              :<|> "category"   :> CatApi
+             :<|> "score"      :> ScoreApi
              :<|> "search"     :> (Search.API Search.SearchResult)
              :<|> "share"      :> Share.API
 
@@ -154,6 +154,9 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "file"      :> FileApi
              :<|> "async"     :> FileAsyncApi
 
+             :<|> "documents-from-write-nodes" :> DocumentsFromWriteNodes.API
+             :<|> DocumentUpload.API
+
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 type RenameApi = Summary " Rename Node"
@@ -194,16 +197,17 @@ nodeAPI :: forall proxy a.
        ) => proxy a
          -> UserId
          -> NodeId
-         -> GargServer (NodeAPI a)
+         -> ServerT (NodeAPI a) (GargM Env GargError)
 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
   where
-    nodeAPI' :: GargServer (NodeAPI a)
+    nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
     nodeAPI' =  getNodeWith   id' p
            :<|> rename        id'
            :<|> postNode  uId id'
            :<|> postNodeAsyncAPI  uId id'
+           :<|> FrameCalcUpload.api uId id'
            :<|> putNode       id'
-           :<|> Update.api  uId id'
+           :<|> Update.api uId id'
            :<|> Action.deleteNode (RootId $ NodeId uId) id'
            :<|> getChildren   id' p
 
@@ -212,6 +216,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> apiNgramsTableCorpus id'
 
            :<|> catApi      id'
+           :<|> scoreApi    id'
            :<|> Search.api  id'
            :<|> Share.api   (RootId $ NodeId uId) id'
            -- Pairing Tools
@@ -233,6 +238,9 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> fileApi uId id'
            :<|> fileAsyncApi uId id'
 
+           :<|> DocumentsFromWriteNodes.api uId id'
+           :<|> DocumentUpload.api uId id'
+
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }
@@ -255,10 +263,32 @@ instance ToJSON    NodesToCategory
 instance ToSchema  NodesToCategory
 
 catApi :: CorpusId -> GargServer CatApi
-catApi = putCat
+catApi cId cs' = do
+  ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
+  lId <- defaultList cId
+  _ <- updateChart cId (Just lId) Docs Nothing
+  pure ret
+
+------------------------------------------------------------------------
+type ScoreApi =  Summary " To Score NodeNodes"
+            :> ReqBody '[JSON] NodesToScore
+            :> Put     '[JSON] [Int]
+
+data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
+                                 , nts_score :: Int
+                                 }
+  deriving (Generic)
+
+-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  NodesToScore
+instance ToJSON    NodesToScore
+instance ToSchema  NodesToScore
+
+scoreApi :: CorpusId -> GargServer ScoreApi
+scoreApi = putScore
   where
-    putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
-    putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
+    putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
+    putScore cId cs' = nodeContextsScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
 
 ------------------------------------------------------------------------
 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
@@ -282,12 +312,15 @@ pairs cId = do
 type PairWith = Summary "Pair a Corpus with an Annuaire"
               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
               :> QueryParam "list_id"     ListId
-              :> Post '[JSON] Int
+              :> Post '[JSON] [Int]
 
 pairWith :: CorpusId -> GargServer PairWith
 pairWith cId aId lId = do
   r <- pairing cId aId lId
-  _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
+  _ <- insertNodeNode [ NodeNode { _nn_node1_id = cId
+                                 , _nn_node2_id = aId
+                                 , _nn_score = Nothing
+                                 , _nn_category = Nothing }]
   pure r