Remove superfluous gfortran extra-libraries stanza
[gargantext.git] / src / Gargantext / API / Node.hs
index 482bc65bd6810c76d7e18fa078f03af768469959..673f63f0d151bf2cae9dff67c94d72a6a86b5d29 100644 (file)
@@ -31,49 +31,51 @@ module Gargantext.API.Node
   where
 
 import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson.TH (deriveJSON)
 import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
-import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-import Gargantext.API.Admin.Auth (withAccess, PathId(..))
-import Gargantext.API.Prelude
+import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Metrics
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
-import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Ngrams.Types (TabType(..))
+import Gargantext.API.Node.File
+import Gargantext.API.Node.FrameCalcUpload (FrameCalcUploadAPI, frameCalcUploadAPI)
 import Gargantext.API.Node.New
-import qualified Gargantext.API.Node.Share  as Share
-import qualified Gargantext.API.Node.Update as Update
-
-import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
+import Gargantext.API.Prelude
 import Gargantext.API.Table
 import Gargantext.Core.Types (NodeTableResult)
-import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Main (Tree, NodeTree)
+import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
-import Gargantext.Database.Admin.Types.Metrics (ChartMetrics)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
-import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
-import Gargantext.Database.Query.Table.Node.User
-import Gargantext.Database.Query.Tree (tree, TreeMode(..))
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude -- (Cmd, CmdM)
+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.Tree (tree, TreeMode(..))
 import Gargantext.Prelude
-import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
-import Gargantext.Viz.Types
-import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
+import Gargantext.Core.Viz.Phylo.Legacy.LegacyAPI (PhyloAPI, phyloAPI)
+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.Text.List.Learn as Learn
+import qualified Gargantext.Core.Text.List.Learn as Learn
 import qualified Data.Vector as Vec
 --}
 
@@ -85,7 +87,7 @@ type NodesAPI  = Delete '[JSON] Int
 -- Be careful: really delete nodes
 -- Access by admin only
 nodesAPI :: [NodeId] -> GargServer NodesAPI
-nodesAPI ids = deleteNodes ids
+nodesAPI = deleteNodes
 
 ------------------------------------------------------------------------
 -- | TODO-ACCESS: access by admin only.
@@ -122,7 +124,9 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "rename" :> RenameApi
              :<|> PostNodeApi -- TODO move to children POST
              :<|> PostNodeAsync
+             :<|> FrameCalcUploadAPI
              :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
+             :<|> "update"     :> Update.API
              :<|> Delete '[JSON] Int
              :<|> "children"  :> ChildrenApi a
 
@@ -131,14 +135,14 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "ngrams"     :> TableNgramsApi
 
              :<|> "category"   :> CatApi
-             :<|> "search"     :> SearchDocsAPI
+             :<|> "score"      :> ScoreApi
+             :<|> "search"     :> (Search.API Search.SearchResult)
              :<|> "share"      :> Share.API
 
              -- Pairing utilities
              :<|> "pairwith"   :> PairWith
              :<|> "pairs"      :> Pairs
              :<|> "pairing"    :> PairingApi
-             :<|> "searchPair" :> SearchPairsAPI
 
              -- VIZ
              :<|> "metrics"   :> ScatterAPI
@@ -147,7 +151,11 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "tree"      :> TreeApi
              :<|> "phylo"     :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
-             :<|> "update"     :> Update.API
+             :<|> "move"      :> MoveAPI
+             :<|> "unpublish" :> Share.Unpublish
+
+             :<|> "file"      :> FileApi
+             :<|> "async"     :> FileAsyncApi
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -186,6 +194,8 @@ nodeAPI :: forall proxy a.
        ( JSONB a
        , FromJSON a
        , ToJSON a
+       , MimeRender JSON a
+       , MimeUnrender JSON a
        ) => proxy a
          -> UserId
          -> NodeId
@@ -197,50 +207,44 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> rename        id'
            :<|> postNode  uId id'
            :<|> postNodeAsyncAPI  uId id'
+           :<|> frameCalcUploadAPI uId id'
            :<|> putNode       id'
+           :<|> Update.api  uId id'
            :<|> Action.deleteNode (RootId $ NodeId uId) id'
            :<|> getChildren   id' p
 
            -- TODO gather it
            :<|> tableApi             id'
            :<|> apiNgramsTableCorpus id'
-            
+
            :<|> catApi      id'
-           :<|> searchDocs  id'
-           :<|> Share.api   id'
+           :<|> scoreApi    id'
+           :<|> Search.api  id'
+           :<|> Share.api   (RootId $ NodeId uId) id'
            -- Pairing Tools
            :<|> pairWith    id'
            :<|> pairs       id'
            :<|> getPair     id'
-           :<|> searchPairs id'
 
+           -- VIZ
            :<|> scatterApi id'
            :<|> chartApi   id'
-           :<|> getPie     id'
-           :<|> getTree    id'
+           :<|> pieApi     id'
+           :<|> treeApi    id'
            :<|> phyloAPI   id' uId
+           :<|> moveNode   (RootId $ NodeId uId) id'
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
-           :<|> Update.api  uId id'
+           :<|> Share.unPublish id'
 
-scatterApi :: NodeId -> GargServer ScatterAPI
-scatterApi id' =  getScatter id'
-
-chartApi :: NodeId -> GargServer ChartApi
-chartApi id' =  getChart id'
-           :<|> updateChart id'
+           :<|> fileApi uId id'
+           :<|> fileAsyncApi uId id'
 
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }
   deriving (Generic)
 
--- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
-instance FromJSON  RenameNode
-instance ToJSON    RenameNode
-instance ToSchema  RenameNode
-instance Arbitrary RenameNode where
-  arbitrary = elements [RenameNode "test"]
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
@@ -263,16 +267,37 @@ catApi = putCat
     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 
+------------------------------------------------------------------------
+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
+    putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
+    putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
+
 ------------------------------------------------------------------------
 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 -- Pairing utilities to move elsewhere
 type PairingApi = Summary " Pairing API"
-              :> QueryParam "view"   TabType
-              -- TODO change TabType -> DocType (CorpusId for pairing)
-              :> QueryParam "offset" Int
-              :> QueryParam "limit"  Int
-              :> QueryParam "order"  OrderBy
-              :> Get '[JSON] [FacetDoc]
+                :> QueryParam "view"   TabType
+                -- TODO change TabType -> DocType (CorpusId for pairing)
+                :> QueryParam "offset" Int
+                :> QueryParam "limit"  Int
+                :> QueryParam "order"  OrderBy
+                :> Get '[JSON] [FacetDoc]
 
 ----------
 type Pairs    = Summary "List of Pairs"
@@ -284,7 +309,7 @@ pairs cId = do
 
 type PairWith = Summary "Pair a Corpus with an Annuaire"
               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
-              :> "list"     :> Capture "list_id"     ListId
+              :> QueryParam "list_id"     ListId
               :> Post '[JSON] Int
 
 pairWith :: CorpusId -> GargServer PairWith
@@ -293,43 +318,20 @@ pairWith cId aId lId = do
   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
   pure r
 
-------------------------------------------------------------------------
-type ChartApi = Summary " Chart API"
-              :> QueryParam "from" UTCTime
-              :> QueryParam "to"   UTCTime
-              :> Get '[JSON] (ChartMetrics Histo)
-        :<|> Summary "SepGen IncExc chart update"
-                :> QueryParam  "list"       ListId
-                :> QueryParamR "ngramsType" TabType
-                :> QueryParam  "limit"      Int
-                :> Post '[JSON] ()
-
-type PieApi = Summary " Chart API"
-           :> QueryParam "from" UTCTime
-           :> QueryParam "to"   UTCTime
-           :> QueryParamR "ngramsType" TabType
-           :> Get '[JSON] (ChartMetrics Histo)
-
-type TreeApi = Summary " Tree API"
-           :> QueryParam "from" UTCTime
-           :> QueryParam "to"   UTCTime
-           :> QueryParamR "ngramsType" TabType
-           :> QueryParamR "listType"   ListType
-           :> Get '[JSON] (ChartMetrics [MyTree])
-
-                -- 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
 
 ------------------------------------------------------------------------
-type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
+type TreeAPI   = QueryParams "type" NodeType
+                  :> Get '[JSON] (Tree NodeTree)
+                  :<|> "first-level"
+                      :> QueryParams "type" NodeType
+                      :> Get '[JSON] (Tree NodeTree)
 
 treeAPI :: NodeId -> GargServer TreeAPI
-treeAPI = tree Advanced
+treeAPI id = tree TreeAdvanced id
+        :<|> tree TreeFirstLevel id
 
 ------------------------------------------------------------------------
--- | Check if the name is less than 255 char
+-- | TODO Check if the name is less than 255 char
 rename :: NodeId -> RenameNode -> Cmd err [Int]
 rename nId (RenameNode name') = U.update (U.Rename nId name')
 
@@ -338,6 +340,24 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
         -> a
         -> Cmd err Int
 putNode n h = fromIntegral <$> updateHyperdata n h
+
+-------------------------------------------------------------
+type MoveAPI  = Summary "Move Node endpoint"
+              :> Capture "parent_id" ParentId
+              :> Put '[JSON] [Int]
+
+moveNode :: User
+         -> NodeId
+         -> ParentId
+         -> Cmd err [Int]
+moveNode _u n p = update (Move n p)
 -------------------------------------------------------------
 
 
+$(deriveJSON (unPrefix "r_"       ) ''RenameNode )
+instance ToSchema  RenameNode
+instance Arbitrary RenameNode where
+  arbitrary = elements [RenameNode "test"]
+
+
+-------------------------------------------------------------