-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
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(..))
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
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
:<|> "rename" :> RenameApi
:<|> PostNodeApi -- TODO move to children POST
:<|> PostNodeAsync
+ :<|> FrameCalcUpload.API
:<|> ReqBody '[JSON] a :> Put '[JSON] Int
:<|> "update" :> Update.API
:<|> Delete '[JSON] Int
:<|> "ngrams" :> TableNgramsApi
:<|> "category" :> CatApi
+ :<|> "score" :> ScoreApi
:<|> "search" :> (Search.API Search.SearchResult)
:<|> "share" :> Share.API
:<|> "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"
) => 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
:<|> apiNgramsTableCorpus id'
:<|> catApi id'
+ :<|> scoreApi id'
:<|> Search.api id'
:<|> Share.api (RootId $ NodeId uId) id'
-- Pairing Tools
:<|> fileApi uId id'
:<|> fileAsyncApi uId id'
+ :<|> DocumentsFromWriteNodes.api uId id'
+ :<|> DocumentUpload.api uId id'
+
------------------------------------------------------------------------
data RenameNode = RenameNode { r_name :: Text }
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)
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