Fix haddock parse error
[gargantext.git] / src / Gargantext / API / Node.hs
index 84c675c441d289196985f7de3c4cfb0da1e57d66..18c4a7b77b746382439211da9a3752279628dfd8 100644 (file)
@@ -21,8 +21,6 @@ Node API
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
@@ -36,12 +34,8 @@ 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.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -53,6 +47,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,13 +58,15 @@ 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.NodeNode
 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.Legacy.LegacyAPI (PhyloAPI, phyloAPI)
-import qualified Gargantext.API.Node.DocumentsFromWriteNodes as DocumentsFromWriteNodes
+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
@@ -77,10 +74,6 @@ 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
@@ -269,10 +262,11 @@ instance ToJSON    NodesToCategory
 instance ToSchema  NodesToCategory
 
 catApi :: CorpusId -> GargServer CatApi
-catApi = putCat
-  where
-    putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
-    putCat cId cs' = nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
+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"
@@ -317,7 +311,7 @@ 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